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 PACKED ARRAY [0..7] OF CHAR; -PAGEN: PACKED ARRAY [0..9] OF PAGE; -POFFSET: PACKED ARRAY [0..9] OF PYLENGTH,COPYSTART: PTRTYPE; (* For Copyc *) "COPYLINE,COPYOK: BOOLEAN; (* " *) "INFINITY: BOOLEAN; (OFFSET; -AUTOINDENT: BOOLEAN; (* Environment stuff follows *) -FILLING: BOOLEAN; -TOKDEF: BOOLEAN; -LMARGIN: 0..MA* for slashc *) "THEFILE: FILE; "TRANSLATE: ARRAY [CHAR] OF COMMANDS; "PAGEZERO: HEADER; "MSG: STRING; XSW; -RMARGIN: 0..MAXSW; -PARAMARGIN: 0..MAXSW; -RUNOFFCH: CHAR; -CREATED: DATEREC; -LASTUSED: DATEREC; -FILLER:"PROMPTLINE: STRING;  BLANKAREA: ARRAY [0..MAXSW] OF CHAR; "SAVETOP: STRING; (* Dumb terminal patch - for BLA PACKED ARRAY [0..891] OF CHAR) $END; $    VAR "CURSOR: 0..MAXBUFSIZE; "BUFCOUNT: 0..MAXBUFSIZE; (* Number ofNKCRT(1) *)  SCREEN: PACKED RECORD (* Screen Control Record *) ,PREFIX: CHAR; ,HEIGHT,WIDTH: 0..255; ,CANUPSCROLL,CANDOWNS valid characters in the EBUF *) "STUFFSTART: 0..MAXBUFSIZE; (* GETLEADING *) "LINESTART: 0..MAXBUFSIZE; (CROLL,SLOW: BOOLEAN; ,HASPREFIX: PACKED ARRAY [SCREENCOMMAND] OF BOOLEAN; ,CH: PACKED ARRAY [SCREENCOMMAND] OF CHAR *E* sets *) "BYTES,BLANKS: INTEGER; (* these *) "CH: CHAR; "DIRECTION: CHAR; ND; "KEYBRD: PACKED RECORD (* Keyboard Control Record *) ,PREFIX: CHAR; ,HASPREFIX: PACKED ARRAY [KEYCOMMAND] OF BOOLEAN; ,C (* '>' or '<' *) "REPEATFACTOR: INTEGER; "BUFSIZE: INTEGER; "SCREENWIDTH: INTEGER; (* Moved to var 26-Jan *) H: PACKED ARRAY [KEYCOMMAND] OF CHAR *END;   SEGMENT PROCEDURE NUM2; BEGIN END; SEGMENT PROCEDURE NUM3; BEGIN EN"SCREENHEIGHT: INTEGER; (* " " " " *) "COMMAND: COMMANDS; "LASTPAT: 0..MAXBUFSIZE; "EBUF: ^BUFRTYPE; "FD;  SEGMENT PROCEDURE NUM4; BEGIN END; SEGMENT PROCEDURE NUM5; BEGIN END;  SEGMENT PROCEDURE NUM6; BEGIN END; SEGMENILLIT: PACKED ARRAY[0..10] OF CHAR; "KIND: ARRAY [CHAR] OF INTEGER; (* for token find *) "LINE1PTR: 0..MAXBUFSIZE; "MIDDLE: IT PROCEDURE NUM7; BEGIN END;  SEGMENT PROCEDURE NUM8; BEGIN END; SEGMENT PROCEDURE NUM9; BEGIN END;   * EGER*);  BEGIN "IF A>B THEN MAX:=A ELSE MAX:=B  END;   FUNCTION GETCH(*:CHAR*);  VAR GCH: CHAR;  BEGIN "READ(KEYBOARD,GGIN "IF CH IN ['a'..'z'] THEN UCLC:=CHR(ORD(CH)-32) ELSE UCLC:=CH  END;   PROCEDURE PROMPT;  BEGIN "PROMPTLINE[1]:=DIRECTCH); "IF EOLN(KEYBOARD) THEN GCH:=CHR(EOL); "GETCH:=GCH;  END;   PROCEDURE CONTROL(*(WHAT: SCREENCOMMAND)*);  BEGIN "WITION; "SAVETOP:=PROMPTLINE; "CONTROL(WHOME); "CLEARLINE(0); "WRITE(PROMPTLINE)  END;   PROCEDURE CLEARSCREEN; H SCREEN DO $BEGIN &IF HASPREFIX[WHAT] THEN WRITE(PREFIX); &WRITE(CH[WHAT]); &WRITE(FILLIT); {So that the slower terminals c VAR I:INTEGER;  BEGIN "IF SCREENHAS(CLEARSCN) THEN $CONTROL(CLEARSCN) "ELSE $BEGIN &HOME; &ERASEOS(0,0) $END;  END; an keep up<--M. Bernard} $END  END;   FUNCTION SCREENHAS(*(WHAT: SCREENCOMMAND): BOOLEAN*);  BEGIN "SCREENHAS:=SCREEN.CH[  PROCEDURE CLEARLINE(*Y:INTEGER*);  VAR I: INTEGER;  BEGIN "IF SCREENHAS(CLEARLNE) THEN $CONTROL(CLEARLNE) "ELSE $BEGIWHAT]<>CHR(0);  END;   FUNCTION HASKEY(*(WHAT: KEYCOMMAND): BOOLEAN*);  BEGIN "HASKEY:=KEYBRD.CH[WHAT] <> CHR(0);  END; N &GOTOXY(0,Y); &ERASETOEOL(0,Y); $END;  END;   PROCEDURE PUTMSG;  BEGIN "CONTROL(WHOME); "CLEARLINE(0); "SAVETOP:=MS  FUNCTION MAPCRTCOMMAND(VAR KCH:CHAR): KEYCOMMAND;  VAR WHATITIS: KEYCOMMAND; $PREFIXREAD: BOOLEAN;  BEGIN "WITH KEYBRD DG; "WRITE(MSG);  END;   PROCEDURE HOME;  BEGIN "IF SCREENHAS(WHOME) THEN $CONTROL(WHOME) "ELSE $GOTOXY(0,0);  END; O "BEGIN $IF (KCH=PREFIX) AND (PREFIX <> CHR(0)) THEN &BEGIN (PREFIXREAD:=TRUE; (READ(KEYBOARD,KCH); &END $ELSE &PREFIXREAD:=FALSE; $WHATITIS:=BACKSPACEKEY; $WHILE (WHATITIS <> NOTLEGAL) AND NOT((CH[WHATITIS]=KCH) AND *(PREFIXREAD=HASPREFIX[WHATITIS])) DO &WHATITIS:=SUCC(WHATITIS); $MAPCRTCOMMAND:=WHATITIS; "END;  END;   FUNCTION MAPTOCOMMAND(* (CH:CHAR): COMMANDS *);  (* For now, only the vector keys go through the new keyboard record *)  VAR KCMD: KEYCOMMAND;  BEGIN "IF (CH=KEYBRD.PREFIX) AND (CH<>CHR(0)) THEN $BEGIN &KCMD:=MAPCRTCOMMAND(CH); &IF KCMD IN [UPKEY..RIGHTKEY] THEN (CASE KCMD OF *UPKEY: MAPTOCOMMAND:=UP; *DOWNKEY: MAPTOCOMMAND:=DOWN; *LEFTKEY: MAPTOCOMMAND:=LEFT; *RIGHTKEY: MAPTOCOMMAND:=RIGHT (END  FUNCTION MIN(* (A,B:INTEGER):INTEGER *);  BEGIN "IF A touit command. *) #    PROCEDURE NEXTCOMMAND; FORWARD;   PROCEDURE FIXDIRECTION;  BEGIN "IF COMMAND=FORWARDC THEN DIREC continue.'); &REPEAT UNTIL GETCH=' '; NEEDPROMPT:=TRUE $END;  END; TION:='>' ELSE DIRECTION:='<'; "HOME; WRITE(DIRECTION); (* Update prompt line *) "SHOWCURSOR; NEXTCOMMAND  END;   PROCEDURE COPY;  BEGIN "PROMPTLINE:=' Copy: B(uffer F(rom file '; "PROMPT; NEEDPROMPT:=TRUE; "REPEAT $CH:=UCLC(GETCH); "UNTIL CH IN ['B','F',CHR(ESC)]; "IF CH='B' THEN $BEGIN &IF NOT COPYOK OR ((BUFCOUNT+COPYLENGTH+10>COPYSTART) 8AND (COPYSTART>=BUFCOUNT)) (THEN ERROR('Invalid copy.',NONFATAL) (ELSE *IF BUFCOUNT+COPYLENGTH>=BUFSIZE THEN ERROR('No room',NONFATAL) *ELSE   PROCEDURE ERASETOEOL(*X,LINE:INTEGER*);  VAR I: INTEGER;  BEGIN  IF SCREENHAS(ERASEEOL) THEN CONTROL(ERASEEOL) "ELSE $BEGIN &IF LINE=SCREENHEIGHT THEN UNITWRITE(2,BLANKAREA,SCREENWIDTH-X) &ELSE UNITWRITE(2,BLANKAREA,SCREENWIDTH-X+1); &GOTOXY(O^X,LINE) $END;  END;   PROCEDURE BLANKCRT(*Y: INTEGER*);  BEGIN "IF SCREENHAS(ERASEEOS) THEN BEGIN GOTOXY(0,Y); CONTROL(ERASEEOS) END "ELSE $IF Y=1 THEN &BEGIN (CLEARSCREEN; (WRITELN(SAVETOP) &END $ELSE &BEGIN (GOTOXY(0,Y); (ERASEOS(0,Y); , UFCOUNT-CURSOR+1); .IF (COPYSTART>=CURSOR) AND (COPYSTART' ' THEN (BEGIN *I:=0; *WHILE (I' ' THEN (BEGIN *FOR I:=0 TO COUNT-1 DO ,IF NAME[I]=MNAME THEN SLO>NAME[I]) DO I:=I+1; *IF MNAME<>NAME[I] THEN ,ERROR('Not there.',NONFATAL) *ELSE ,BEGIN .CURSOR:=POFFSET[I]; .GETLEADING; T:=I; *NAME[SLOT]:=MNAME; *POFFSET[SLOT]:=CURSOR; *IF SLOT=COUNT THEN COUNT:=COUNT+1 (END; $END;  1:END;   PROCEDURE SE.CURSOR:=MAX(CURSOR,STUFFSTART); .CENTERCURSOR(TRASH,MIDDLE,FALSE) ,END; & END;  END;  END; (* jumpmarker *)  TSTUFF;  VAR CH: CHAR;  BEGIN "PROMPTLINE:=' Set: E(nvironment M(arker '; "PROMPT; NEEDPROMPT:=TRUE; "REPEAT $CH:=UCL BEGIN (* jump *) "PROMPTLINE:=' JUMP: B(eginning E(nd M(arker '; "PROMPT; "NEEDPROMPT:=TRUE; (* Need to redisplay EDIC(GETCH); $IF CH='E' THEN EXIT(EDITCORE) $ELSE $ IF CH='M' THEN SETMARKER &ELSE IF CH<>CHR(ESC) THEN ERRWAIT; "UNTIL CH INT: promptline! *) "REPEAT $CH:=UCLC(GETCH); $IF CH='B' THEN &BEGIN (CURSOR:=1; (GETLEADING; (CURSOR:=STUFFSTART; (CENTE ['E','M',CHR(ESC)]; "SHOWCURSOR; "NEXTCOMMAND;  END(* SETSTUFF *);   PROCEDURE VERIFY;  BEGIN "CENTERCURSOR(TRASH,MIDDLRCURSOR(TRASH,1,FALSE) &END $ELSE &IF CH='E' THEN (BEGIN *CURSOR:=BUFCOUNT-1; *CENTERCURSOR(TRASH,SCREENHEIGHT-1,FALSE); E,TRUE); SHOWCURSOR; "NEXTCOMMAND  END (* VERIFY *);   PROCEDURE XMACRO;  VAR "SAVEC,I: INTEGER; ,BEGIN .IF COPYLINE THEN 0BEGIN 2GETLEADING; 2CURSOR:=LINESTART 0END; .MOVERIGHT(EBUF^[CURSOR],EBUF^[CURSOR+COPYLENGTH],B(END &ELSE (IF CH='M' THEN JUMPMARKER (ELSE IF CH<>CHR(ESC) THEN ERRWAIT; "UNTIL (CH IN ['B','E','M',CHR(ESC)]); "NEXTCOMMA- ^[CURSOR],EBUF^[LASTPAT],BUFCOUNT-CURSOR) &ELSE (MOVELEFT(EBUF^[LASTPAT],EBUF^[CURSOR],BUFCOUNT-LASTPAT); &BUFCOUNT:=BUFCOUNTSEGMENT FUNCTION OUT: BOOLEAN;  LABEL 1,2;  VAR "SAVE: PTRTYPE; I: INTEGER; "BUF: PACKED ARRAY [0..1023] OF CHAR;  FN: -ABS(CURSOR-LASTPAT); &CURSOR:=LASTPAT; &CENTERCURSOR(TRASH,MIDDLE,TRUE); $END; "SHOWCURSOR; "NEXTCOMMAND;  END; STRING; BEGIN "OUT:=FALSE; "REPEAT $CLEARSCREEN; (* Dumb terminal patch *) $SAVETOP:='>Quit:'; $WRITELN(SAVETOP); $WRI"SAVE:PACKED ARRAY [0..MAXSTRING] OF CHAR; BEGIN "PROMPTLINE:=' eXchange: TEXT { a char} [ escapes; accepts]';  PROMPT; NEEDPROMPT:=TRUE; "SHOWCURSOR; "SAVEC:=CURSOR; I:=0; REPEAT $CH:=GETCH; $IF MAPTOCOMMAND(CH)=LEFT THEN &BEGIN (IF (CURSOR>SAVEC) THEN *BEGIN ,I:=I-1; CURSOR:=CURSOR-1; (* Decrement both ptrs *) ,EBUF^[CURSOR]:=SAVE[I]; (* Restore buffer *) ,WRITE(CHR(BS),EBUF^[CURSOR],CHR(BS)); *END &END $ELSE &IF CH=CHR(EOL) THEN BEGIN ERRWAIT; SHOWCURSOR END &ELSE (IO^F NOT (CH IN [CHR(ETX),CHR(ESC)]) AND (EBUF^[CURSOR]<>CHR(EOL)) THEN *BEGIN ,IF NOT (CH IN [' '..'~']) THEN CH:='?'; ,SAVE[I]:=EBUF^[CURSOR]; ,EBUF^[CURSOR]:=CH; ,I:=I+1; CURSOR:=CURSOR+1; ,WRITE(CH) *END;  UNTIL CH IN [CHR(ETX),CHR(ESC)]; "IF CH=CHR(ESC) THEN $BEGIN &CURSOR:=SAVEC; &MOVELEFT(SAVE[0],EBUF^[CURSOR],I); SHOWCURSOR; WRITE(SAVE:I); SHOWCURSOR $END;  NEXTCOMMAND;  END (* XMACRO *);   PROCEDURE ZAPIT;  BEGIN "IF ABS(LASTPAT-CURSOR)>80 THEN $BEGIN &PROMPTLINE:=  ' WARNING! You are about to zap more than 80 chars, do you wish to zap? (y/n)'; &PROMPT; &NEEDPROMPT:=TRUE; &IF UCLC(GETCH)<>'Y' THEN (BEGIN *SHOWCURSOR; *NEXTCOMMAND; *EXIT(ZAPIT) (END; $END; "IF OKTODEL(MIN(CURSOR,LASTPAT),MAX(CURSOR,LASTPAT)) THEN $BEGIN ©LINE:=FALSE; &READJUST(MIN(CURSOR,LASTPAT),-ABS(CURSOR-LASTPAT)); &IF CURSOR>LASTPAT THEN (MOVELEFT(EBUF. R(EOL),EBUF^[CURSOR+1022]); &MOVELEFT(EBUF^[CURSOR],BUF,1023+I); &FILLCHAR(BUF[1023+I],ABS(I)+1,CHR(0)); &IF BLOCKWRITE(THEFILE,BUF,2) <> 2 THEN GOTO 1; &CURSOR:=CURSOR+1023+I; $ WRITE('.'); END; "IF CURSOR 2 THEN GOTO 1; WRITE('.') ٜ$END; "CLOSE(THEFILE,LOCK); "WRITELN; "WRITELN('Your file is ',BUFCOUNT,' bytes long.'); "IF CH='U' THEN WITH USERINFO DO &BEGIN (SYMVID:=SYVID; SYMTID:='SYSTEM.WRK.TEXT'; GOTSYM:=TRUE; (OPENOLD(THEFILE,'*SYSTEM.WRK.CODE'); CLOSE(THEFILE,PURGE);TELN(' U(pdate the workfile and leave'); $WRITELN(' E(xit without updating'); $WRITELN(' R(eturn to the editor wit (GOTCODE:=FALSE; CODETID:=''; OUT:=TRUE; END $ELSE $ BEGIN hout updating'); $WRITELN(' W(rite to a file name and return'); CH:=UCLC(GETCH); "UNTIL CH IN ['U','E','R','W']; "IF % WRITE('Do you want to E(xit from or R(eturn to the editor? '); (REPEAT CH:=UCLC(GETCH) UNTIL CH IN ['E','R']; (OUT:= CH='CH='R' THEN GOTO 2; "IF CH='E' THEN BEGIN OUT:=TRUE; CLEARSCREEN; GOTO 2 END; "CLOSE(THEFILE); "IF CH='W' THEN $BEGIN &SAVEE'; (CURSOR:=SAVE; (* QW returns to the editor *)  END; "GOTO 2; (* SORRY ABOUT THAT EDSGER *) 1: ERROR('Writing out th:=CURSOR; BLANKCRT(1); &WRITE('Name of output file ( to return) -->'); &READLN(FN); &IF LENGTH(FN)=0 THEN GOTO 2; e file',NONFATAL); 2:END;  $ 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)]<>'.') THEN (FN:=CONCAT(FN,'.TEXT'); IF FN[LENGTH(FN)]='.' THEN DELETE(FN,LENGTH(FN),1); $END "ELSE $FN:='*SYSTEM.WRK.TEXT'; "BLANKCRT(1); WRITE('Writing'); OPENNEW(THEFILE,FN); PAGEZERO.LASTUSED:=THEDATE; "IF BLOCKWRITE(THEFILE,PAGEZERO,2) <> 2 THEN GOTO 1; "WRITE('.'); CURSOR:=1; "WHILE CURSOR < BUFCOUNT-1023 DO $BEGIN &I:=SCAN(-1022,=CH/ ..1023] OF CHAR; "F: FILE;   PROCEDURE PUTNUM;  BEGIN "MSG:='Syntax Error #'; PUTMSG; "WRITE(USERINFO.ERRNUM,'. Type ');  END;   BEGIN (* putsyntax *) "WITH USERINFO DO $BEGIN &OPENOLD(F,'*SYSTEM.SYNTAX'); &IF IORESULT<>0 THEN PUTNUM &ELSE (BEGIN *IF ERRNUM<=104 THEN BLK:=2 *ELSE ,IF ERRNUM<=126 THEN BLK:=4 ,ELSE .IF ERRNUM<=151 THEN BLK:=6 .ELSE 0IF ERRNUM<=185 THEN BLK:=8 0ELSE 1IF ERRNUM<=302 THEN BLK:=10 1ELSE BLK:=12; *IF BLOCKREAD(F,BUF,2,BLK)<>2 THEN PUTNUM *ELSE ,BEGIN .IF BUF[0]=CHR(DLE) THEN PTR:=2 ELSE PTR:=0; .D0:=ERRNUM DIV 100; (* convert error number to characters *) .D1:=(ERRNUM-O^D0*100) DIV 10; .D2:=ERRNUM MOD 10; .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,=':',BUF[PTR]); 0MOVELEFT(BUF[PTR],C[3-COLON],COLON); 0COLON:=COLON+PTR; 0PTR:=SCAN(MAXCHAR,=CHR(EOL),BUF[PTR])+PTR+3 .UNTIL (T=C) OR (BUF[PTR]=CHR(0)); .IF (T<>C) AND (BUF[PTR]=CHR(0)) THEN PUTNUM .ELSE 0BEGIN 2MOVELEFT(BUF[COLON+1],MSG[1],(PTR-COLON)-4); 2MSG[0]:=CHR(MIN(68,(PTR-COLON)-4)); (* R- required *) 2HOME; CLEARLINE(0); WRITE(MSG,'. Type '); 0END ,END *END(* if ioresult<>0 *); (SHOWCURSOR; (REPEAT UNTIL GETCH=' '; (ERRBLK:=0; ERRSYM:=0; ERRNUM:=0; (* Only yell once!!! *) &END(* with userinfo *)  END(* putsyntax *); "   SEGMENT PROCEDURE PUTSYNTAX;  VAR "D0,D1,D2,BLK,PTR,COLON: INTEGER; "T,C:PACKED ARRAY [0..2] OF CHAR; "BUF:PACKED ARRAY [00 PROCEDURE FIND;  VAR "THERE,FOUND,LASTPATTERN: BOOLEAN; "TRASH,COULDBE,PLENGTH,START,STOP,NEXTSTART: INTEGER; "NEXT,PTR: PTRCHAR THEN $BEGIN &ERROR('Your pattern is too long',NONFATAL); &IF NOT JUSTIN THEN REDISPLAY; &NEXTCOMMAND; EXIT(FIND) $ENDTYPE; "MODE: (LITERAL,TOKEN); "I: INTEGER; "DELIMITER: CHAR; "JUSTIN: BOOLEAN; "POSSIBLE,PAT: PTYPE; "USEOLD,VERIFY: BOOLE; "PLENGTH:=I-1;  END (* PARSESTRING *);   FUNCTION OK(PTR: PTRTYPE): BOOLEAN;  (* Compare PAT against the buffer *)  VARAN;   PROCEDURE NEXTCH;  BEGIN "CH:=GETCH; "IF CH=CHR(ESC) THEN &BEGIN (IF NOT JUSTIN THEN REDISPLAY; (SHOWCURSOR; NEXT I: INTEGER;  BEGIN "I:=0; "WHILE (I=PLENGTH THEN (* Possibly there *) (LOC:=SCAN(-PTR,=PAT[0 PROCEDURE PARSESTRING(VAR PATTERN: PTYPE; VAR PLENGTH: INTEGER);  VAR I,J: INTEGER;  BEGIN "SKIP; "IF CH IN ['A'..'Z','a'.],EBUF^[PTR]) &ELSE (LOC:=-PTR; &IF LOC=-PTR THEN (* Not there! *) (BEGIN *CHTHERE:=FALSE; THERE:=FALSE (END &ELSE (BEGI.'z','0'..'9',CHR(BS)] THEN $BEGIN &ERROR('Invalid delimiter.',NONFATAL); &IF NOT JUSTIN THEN REDISPLAY; &NEXTCOMMAND; &EXIN *PTR:=PTR+LOC; NEXT:=PTR-1; *IF EBUF^[PTR-1]=CHR(DLE) THEN BEGIN PTR:=NEXT; GOTO 1 END; *IF OK(PTR) THEN THERE:=TRUE ELSE PT(FIND); $END; "DELIMITER:=CH; "I:=0; "REPEAT $NEXTCH; $IF CH=CHR(BS) THEN &BEGIN (IF (PATTERN[I]<>CHR(EOL)) AND (I>0) TTR:=NEXT (END $END;  END;   PROCEDURE SCANFORWARD;  LABEL 1;  VAR "MAXSCAN,LOC: INTEGER; "CHTHERE: BOOLEAN;  BEGIN HEN (* Don't go overboard! *) *BEGIN ,WRITE(' ',CHR(BS)); ,I:=I-1 *END (ELSE CONTROL(RIGHTCURSOR); (* Make up for the NEXTCH wrote out *) &END $ELSE &BEGIN (PATTERN[I]:=CH; (I:=I+1 &END; "UNTIL (CH=DELIMITER) OR (I>=MAXSTRING); "IF I>=MAX1 H) DO NEXTSTART:=NEXTSTART+1; "IF NEXTSTART=TLENGTH THEN BEGIN STOP:=MAX(STOP,0); LASTPATTERN:=TRUE END;  END;   BEGIN(* go"IF INFINITY THEN WRITE('/') ELSE WRITE(REPEATFACTOR); "WRITE(']: '); "IF LORT THEN IF MODE=TOKEN THEN WRITE('L(it') ELSE WRI"CHTHERE:=TRUE; "THERE:=FALSE; "FILLCHAR(PAT[0],SIZEOF(PAT),' '); "MOVELEFT(TARGET[START],PAT[0],PLENGTH); "WHILE CHTHERE Aforit *) "FOUND:=FALSE; "NEXT:=PTR; "REPEAT $PTR:=NEXT; (* Set to next place to scan for *) $NEXTSTART:=0; (* Fool NEXTLINND NOT THERE DO #BEGIN $1: MAXSCAN:=(BUFCOUNT-PLENGTH)-PTR+1; $IF MAXSCAN>0 THEN (* still stuff to scan *) &LOC:=SCAN(MAXSCAE into giving us START and STOP for line 1 *) $IF MODE=LITERAL THEN NEXTLINE ELSE NEXTTOKEN; $PLENGTH:=STOP-START+1; $IF DIREN,=PAT[0],EBUF^[PTR]) $ELSE &LOC:=MAXSCAN; (* Dummy up 'not found' condition *) $IF LOC=MAXSCAN THEN &BEGIN CHTHERE:=FALSE; CTION='>' THEN SCANFORWARD ELSE SCANBACKWARD; $IF THERE THEN &BEGIN (COULDBE:=PTR; (FOUND:=TRUE; THERE:=FALSE END $ELSE &BEGIN (PTR:=LOC+PTR; NEXT:=PTR+1; (IF EBUF^[PTR-1]=CHR(DLE) THEN BEGIN PTR:=NEXT; GOTO 1 END; (IF O(WHILE (NOT LASTPATTERN) AND FOUND DO *BEGIN ,IF MODE=LITERAL THEN NEXTLINE ELSE NEXTTOKEN; ,PTR:=PTR+PLENGTH; ,SKIPKIND3(PK(PTR) THEN THERE:=TRUE ELSE PTR:=NEXT &END #END;  END;   PROCEDURE GOFORIT;   PROCEDURE NEXTLINE;  (* Given NEXTSTARTTR); (* Go past the junk on the next line *) ,PLENGTH:=STOP-START+1; (* For the new line *) ,FILLCHAR(PAT[0],SIZEOF(PAT),' ');, calculate the START and STOP for the next line *)  BEGIN "LASTPATTERN:=FALSE; "START:=NEXTSTART; "STOP:=MIN(TLENGTH-1,STAR ,MOVELEFT(TARGET[START],PAT[0],PLENGTH); ,IF PTR+PLENGTH > BUFCOUNT THEN .FOUND:=FALSE ,ELSE .IF NOT OK(PTR) THEN FOUND:=FT+SCAN(TLENGTH-START,=CHR(EOL),TARGET[START])); "IF STOP=TLENGTH-1 THEN BEGIN STOP:=MAX(STOP,0); LASTPATTERN:=TRUE END; "NEXTSALSE; *END; &END; $(* In token mode make sure the first and last characters 'of the target are on 'token boundaries' *) $IFTART:=STOP+1;  END;   PROCEDURE NEXTTOKEN;  (* Given NEXTSTART, calculate START and STOP *)  BEGIN "LASTPATTERN:=FALSE;  MODE=TOKEN THEN IF KIND[PAT[0]]=ORD('A') THEN IF FOUND THEN &BEGIN (IF ((COULDBE>2) AND (EBUF^[COULDBE-2]<>CHR(DLE))) OR +(C"START:=NEXTSTART; "(* Skip over leading kind3 characters *) "WHILE (TARGET[START] IN [CHR(SP),CHR(EOL),CHR(HT)]) AND (START<OULDBE<=2) THEN (* whew! *) *IF KIND[EBUF^[COULDBE]]=KIND[EBUF^[COULDBE-1]] THEN ,FOUND:=FALSE; (* False find... don't count iTLENGTH-1) DO $START:=START+1; "STOP:=START; "(* Get the next token *) "WHILE (KIND[TARGET[START]]=KIND[TARGET[STOP+1]]) ANDt. *) (IF (PTR+PLENGTH<=BUFCOUNT-1) AND +(KIND[EBUF^[PTR+PLENGTH-1]]=KIND[EBUF^[PTR+PLENGTH]]) THEN *FOUND:=FALSE; (* Anothe (STOP =>',REPEATFACTOR,TRUE) ELSE " PUTPROMPT(' Replace',' V(fy =>',REPEATFACTOR,TRUE); NEEDPROMPT:=TRUE; "NEXTCH; SKIP; "OPTIONS; "IF NOT USEOLD THEN $BEGIN &PARSESTRING(TARGET,TLENGTH); &TDEFINED:=TRUE $END; "IF COMMAND=REPLACEC THEN $BEGIN &NEXTCH; SKIP; &USEOLD:=FALSE; &OPTIONS; &IF NOT USEOLD THEN (BEGIN *PARSESTRING(SUBSTRINGTE('T(ok'); "WRITE(RIGHT)  END;  PROCEDURE REPLACEIT;  LABEL 1; BEGIN "IF VERIFY THEN $BEGIN &CENTERCURSOR(TRASH,MIDDLE,,SLENGTH); *SDEFINED:=TRUE (END $END; "HOME; "CLEARLINE(0); "IF ((COMMAND=FINDC) AND TDEFINED) NOT JUSTIN); PUTPROMPT(' Replace',' aborts, ''R'' replaces, '' '' doesn''t', 0REPEATFACTOR-I+2,FALSE); &SHOWCURSOR; OR ((COMMAND=REPLACEC) AND SDEFINED AND TDEFINED) THEN $BEGIN &I:=1; &FOUND:=TRUE; &PTR:=CURSOR; &WHILE ((I<=REPEATFA &CH:=GETCH; &IF CH=CHR(ESC) THEN (BEGIN *GETLEADING; CURSOR:=MAX(CURSOR,STUFFSTART); *NEXTCOMMAND; EXIT(FIND) (END; &IF CTOR) OR INFINITY) AND FOUND DO (BEGIN *GOFORIT; (* Find the target (handles token and literal mode) *) *I:=I+1; *IF FOUND T(CH<>'R') AND (CH<>'r') THEN GOTO 1; $END; $(* Replace TARGET with SUBSTRING *) &IF SLENGTH>CURSOR-LASTPAT THEN (IF SLENGTH-HEN ,BEGIN .CURSOR:=PTR+PLENGTH; LASTPAT:=COULDBE; (*Set up for next time*) .IF COMMAND=REPLACEC THEN REPLACEIT; .IF DIRECTI(CURSOR-LASTPAT)+BUFCOUNT>BUFSIZE-200 THEN ,BEGIN .ERROR('Buffer full. Aborting Replace',NONFATAL); .GETLEADING; CURSOR:=MAXON='<' THEN PTR:=COULDBE-1 ELSE PTR:=CURSOR; ,END; (END; &IF NOT FOUND THEN (IF NOT( INFINITY AND (I>2) ) THEN *ERROR('Patt(CURSOR,STUFFSTART); .NEXTCOMMAND; EXIT(FIND); ,END (ELSE *MOVERIGHT(EBUF^[CURSOR],EBUF^[LASTPAT+SLENGTH],BUFCOUNT-CURSOR) ern not in the file',NONFATAL) $END "ELSE $ERROR('No old pattern.',NONFATAL); "CENTERCURSOR(TRASH,MIDDLE,NOT JUSTIN); "GE&ELSE (IF SLENGTHCURSOR-LASTPAT THEN (READJUST(LASTPAT,SLENGTH-(CURSOR-LASTPAT)); &BUFCOUNT:=BUFCOUNT+SLENGTH-(CURSOR-LASTPAT); &CURSOR :=CURSOR +SLENGTH-(CURSOR-LASTPAT); &JUSTIN:=FALSE;  1:END;   BEGIN "JUSTIN:=TRUE; "3 COMMANDS);  BEGIN "TRANSLATE[CH]:=C; "IF CH IN ['A'..'Z'] THEN TRANSLATE[CHR(32+ORD(CH))]:=C; (* LC TOO *)  END;   PROCED; &END; "IF IORESULT<>0 THEN ERROR('Disk error',NONFATAL) ELSE $IF NOT DONE THEN ERROR('Buffer overflow.',NONFATAL);  END; URE DEFPROMPTS; (* DEFINES VARIABLE PROMPTLINES MAB 11/2/78*)  BEGIN "COMPROMPT:=  ' Edit: A(djst C(py D(lete F(ind I(nsrt J(  PROCEDURE LOADFROMSYSCOM;  (* A rather perverted procedure that takes the syscom^.crtcntrl record #and loads it into the mp R(place Q(uit X(chng Z(ap [E.6e]'; "INSERTPROMPT:= "' Insert: Text { a char, a line} [ accepts, escapScreen Control Record and the syscom^.crtinfo #record and loads it into the Keyboard Control Record *)  BEGIN  "WITH SYSCOMes]'; "DELETEPROMPT:= "' Delete: < > { to delete, to abort}'; "ADJUSTPROMPT:= "' Adjust: L(jus^ DO $BEGIN & &(* Miscellaneous stuff *) & &WITH SCREEN DO (BEGIN *PREFIX:=CRTCTRL.ESCAPE; *HEIGHT:=CRTINFO.HEIGHT-1; *t R(just C(enter { to leave}'; "IF (SCREENWIDTH+1)Edit:'); "WRITE('Reading'); "IF BLOCKREAD(THEFILE,PAGEZERO,2)<>2 THEN ERROR('Reading file',FATAL); "WRITE('.'); "PAGE:=1; "DONE:=FALSE; OVFLW:=FALSE; "WITH USERINFO DO $WHILE NOT (DONE OR OVFLW) DO &BEGIN (DONE:= BLOCKREAD(THEFILE,BUFFER,2)=0; (IF NOT DONE THEN *BEGIN ,WRITE('.'); ,NOTNULS:=SCAN(-1024,<>CHR(0),BSEGMENT PROCEDURE INITIALIZE;  LABEL 1;  VAR "BLOCK: ^BLOCKTYPE; "ONEWD: ^INTEGER; "DONE,OVFLW: BOOLEAN; "CH: CHAR; "I,QUFFER[1023])+1024; ,OVFLW:=NOTNULS+BUFCOUNT>=BUFSIZE-10; ,IF OVFLW THEN NOTNULS:=0; ,MOVELEFT(BUFFER[0],EBUF^[BUFCOUNT],NOTNUUIT,GAP,BLKS,PAGE,NOTNULS: INTEGER; "FILENAME: STRING; "BUFFER: PACKED ARRAY [0..1023] OF CHAR;   PROCEDURE MAP(CH:CHAR; C:LS); ,IF PAGE+PAGE=ERRBLK THEN CURSOR:=BUFCOUNT+ERRSYM; (* errblk>0 only *) ,BUFCOUNT:=BUFCOUNT+NOTNULS; ,PAGE:=PAGE+1; *END4 REEN.HASPREFIX[DOWNCURSOR]:=FALSE; & &SCREEN.CH[LEFTCURSOR]:=CRTCTRL.BACKSPACE; &SCREEN.HASPREFIX[LEFTCURSOR]:=CRTCTRL.PREFIXBRD.HASPREFIX[K] THEN MAP(KEYBRD.CH[K],C);  END;   BEGIN "WITH PAGEZERO DO $BEGIN & &(* Load Screen and Keyboard ControlED[1]; & &SCREEN.CH[RIGHTCURSOR]:=CRTCTRL.NDFS; &SCREEN.HASPREFIX[RIGHTCURSOR]:=CRTCTRL.PREFIXED[8]; & &(* ... and the keyb Records from SYSCOM *) & &LOADFROMSYSCOM; & & &(* Init the translate table *) & oard *) & &KEYBRD.CH[BACKSPACEKEY]:=CRTINFO.BACKSPACE; &KEYBRD.HASPREFIX[BACKSPACEKEY]:=CRTINFO.PREFIXED[12]; & &KEYBRD.CH[&FILLCHAR(TRANSLATE,SIZEOF(TRANSLATE),ILLEGAL); &MAP('A',ADJUSTC); MAP('C',COPYC); MAP('D',DELETEC); &MAP('F',FINDC); DC1KEY]:=CHR(DC1); (* Not in record *) &KEYBRD.HASPREFIX[DC1KEY]:=FALSE; & &KEYBRD.CH[EOFKEY]:=CRTINFO.EOF; &KEYBRD.HASPREFI MAP('I',INSERTC); MAP('J',JUMPC); &MAP('L',LISTC); MAP('M',MACRODEFC); MAP('P',PARAC); &MAP('Q',QUITC); MAP('R',RX[EOFKEY]:=CRTINFO.PREFIXED[9]; & &KEYBRD.CH[ETXKEY]:=CRTINFO.ETX; &KEYBRD.HASPREFIX[ETXKEY]:=CRTINFO.PREFIXED[13]; & &KEYBEPLACEC); MAP('S',SETC); &MAP('V',VERIFYC); MAP('X',XECUTEC); MAP('Z',ZAPC); &MAP(',',REVERSEC); MAP('>',FORWARDC); MAPRD.CH[ESCAPEKEY]:=CRTINFO.ALTMODE; &KEYBRD.HASPREFIX[ESCAPEKEY]:=CRTINFO.PREFIXED[10]; & &KEYBRD.CH[DELKEY]:=CRTINFO.LINEDEL;('.',FORWARDC); &MAP('+',FORWARDC); MAP('-',REVERSEC); MAP('?',DUMPC); &MAP('/',SLASHC); MAP('=',EQUALC); MAP('<',REVE &KEYBRD.HASPREFIX[DELKEY]:=CRTINFO.PREFIXED[11]; & &KEYBRD.CH[UPKEY]:=CRTINFO.UP; RSEC);  % &(* Arrows *) & &(* NEXTCOMMAND and GETNUM handle VT-52 style vector keys *) &WITH KEYBRD DO (BEGIN *MAPSPECI&KEYBRD.HASPREFIX[UPKEY]:=CRTINFO.PREFIXED[3]; & &KEYBRD.CH[DOWNKEY]:=CRTINFO.DOWN; &KEYBRD.HASPREFIX[DOWNKEY]:=CRTINFO.PREFAL(UPKEY,UP); MAPSPECIAL(DOWNKEY,DOWN); *MAPSPECIAL(LEFTKEY,LEFT); MAPSPECIAL(RIGHTKEY,RIGHT); (END; &MAP(CHR(EOL),ADVANCE); IXED[2]; & &KEYBRD.CH[LEFTKEY]:=CRTINFO.LEFT; &KEYBRD.HASPREFIX[LEFTKEY]:=CRTINFO.PREFIXED[1]; & &KEYBRD.CH[RIGHTKEY]:=CRTI(* CR IS ADVANCE *) &MAP(CHR(HT),TAB); &MAP(CHR(SP),SPACE);   &(* Digits *) & &FOR CH:='0' TO '9' DO MAP(CH,DIGIT);  NFO.RIGHT; &KEYBRD.HASPREFIX[RIGHTKEY]:=CRTINFO.PREFIXED[0]; & &BSPCE:=ORD(CRTINFO.BACKSPACE); {Went soft 11/2/78 M. Bernard &(* Variable buffer sizing... added 17-Jan-78 *) & &QUIT:=10512+ (* Sizeof(editcore)-Sizeof(initialize) *) ASPREFIX[ERASEEOL]:=CRTCTRL.PREFIXED[2]; & &SCREEN.CH[CLEARLNE]:=CRTCTRL.CLEARLINE; &SCREEN.HASPREFIX[CLEARLNE]:=CRTCTRL.PREF} & &{Now test to see that the essential keys have been given a 'value other than null. If not then assign them a default 'IXED[7]; & &SCREEN.CH[CLEARSCN]:=CRTCTRL.CLEARSCREEN; &SCREEN.HASPREFIX[CLEARSCN]:=CRTCTRL.PREFIXED[6]; & value. Hopefully, this will end up an INTERP change--M. Bernard} ' 'IF BSPCE=0 THEN BSPCE:=8; 'IF KEYBRD.CH[ETXKEY]=CHR(0) T&SCREEN.CH[UPCURSOR]:=CRTCTRL.RLF; &SCREEN.HASPREFIX[UPCURSOR]:=CRTCTRL.PREFIXED[0]; & &SCREEN.CH[DOWNCURSOR]:=CHR(LF); &SCHEN KEYBRD.CH[ETXKEY]:=CHR(3); ' &  END;  END; $  PROCEDURE MAPSPECIAL(K:KEYCOMMANDS;C:COMMANDS);  BEGIN "IF NOT KEY5 ,512; (* Slop! *) &MARK(EBUF); &BLKS:=0; &REPEAT (NEW(BLOCK); (BLKS:=BLKS+1; (GAP:=MEMAVAIL+MEMAVAIL &UNTIL ((GAPgh the Screen and Keyboard control )records *) &WITH SYSCOM^.CRTINFO DO (BEGIN *ESC:=ORD(ALTMODE); *BS:=ORD(CHARDEL); *DEL>0) AND (GAPE&MAP(CHR(BS),LEFT); (* Map backspace key for now *) &SYSCOM^.MISCINFO.NOBREAK := TRUE; &{Including the codit:'); &IF USERINFO.GOTSYM THEN (BEGIN *RESET(THEFILE,CONCAT(USERINFO.SYMVID,':',USERINFO.SYMTID)); *IF IORESULT<>0 THEN ERmmand prompt line} &DEFPROMPTS; &SDEFINED:=FALSE; TDEFINED:=FALSE; (* No substring or target *) &WITH PAGEZERO DO (IF NOT DEROR('Workfile lost.',FATAL) (END &ELSE (BEGIN *MSG:='No workfile is present. File? ( for no file ) '; *REPEAT ,WRITEFINED THEN *BEGIN ,FILLCHAR(BUF,1024,CHR(0)); ,CREATED:=THEDATE; LASTUSED:=THEDATE; ,TOKDEF:=TRUE; (* Default mode is T(oke(MSG); ,READLN(INPUT,FILENAME); ,IF LENGTH(FILENAME)=0 THEN .BEGIN 0FILLCHAR(PAGEZERO,SIZEOF(PAGEZERO),CHR(0)); GOTO 1; .ENn *) ,FILLING:=FALSE; AUTOINDENT:=TRUE; RUNOFFCH:='^'; ,LMARGIN:=0; PARAMARGIN:=5; RMARGIN:=SCREENWIDTH; * DEFINED:=TRUE; *D; ,FOR I:=1 TO LENGTH(FILENAME) DO FILENAME[I]:=UCLC(FILENAME[I]); ,IF ((POS('.TEXT',FILENAME)<>LENGTH(FILENAME)-4) OR END; $END(* WITH *); " " "(* Initialize the KIND array for token find *) " "FOR CH:=CHR(0) TO CHR(255) DO KIND[CH]:=ORD(CH/(LENGTH(FILENAME)<=4)) AND (FILENAME[LENGTH(FILENAME)]<>'.') THEN .FILENAME:=CONCAT(FILENAME,'.TEXT'); ,IF FILENAME[LENGTH(F); (* 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 CH:ILENAME)]='.' THEN .DELETE(FILENAME,LENGTH(FILENAME),1); ,OPENOLD(THEFILE,FILENAME); ,MSG:='Not present. File? '; *UNTIL IO='0' TO '9' DO KIND[CH]:=ORD('A'); "KIND[CHR(EOL)]:=ORD(' '); KIND[CHR(HT)] :=ORD(' '); FILLCHAR(BLANKAREA,SIZEOF(BLANKAREA),RESULT=0; (END; & & &(* Read in the file *) & &READFILE; &1: IF (EBUF^[BUFCOUNT-1]<>CHR(EOL)) OR (BUFCOUNT=1) THEN (BEGI' ');  SAVETOP:='';   END(* INITIALIZE *);  N *EBUF^[BUFCOUNT]:=CHR(EOL); *BUFCOUNT:=BUFCOUNT+1; (END; & & &(* Initialize everything else! *) & &DIRECTION:='>'; &LSL EL !!O^ASTPAT:=1; (* Init to the beginning of the buffer (for equalc) *) ©OK:=FALSE; &LINE1PTR:=1; &(* These do not yet go throu6 GIN "GETLEADING; THEREST:=BUFSIZE-(BUFCOUNT-CURSOR); "LMOVE:=BUFCOUNT-CURSOR+1; "MOVERIGHT(EBUF^[CURSOR],EBUF^[THEREST],LMOHECK is false. This function also warns the user if %s/he is getting too close to overflowing the buffer *)  BEGIN "CHECK:=TVE);  GETLEADING; (* Set blanks *) "IF THEREST-CURSOR=THEREST-MAXCHAR THEN &BEGIN (IF NOT WARNED THEN *BEGIN ,ERROR('Please finish up the insLANKS+32); 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; (THEREST:=THEREST-2; LMOVE:=LMOVE+2; (CURSOR:=SCAN(-MAXCHAR,=CHR(EOL),EBUF^[CURSOR-1])+CURSOR; &END; "MOVELEFT(EBUF^[THEREST],EBUF^[CURSOR],LMOVE); "READJUST(LEFTPART+1,CURSOR-(LEFTPART+1)); "BUFCOUNT:=BUFCOUNT+CURSOR-(LEFTPART+1)PROCEDURE INSERTIT;  CONST "FUDGEFACTOR=10;  VAR "THEREST,LEFTPART,SAVEBUFCOUNT: PTRTYPE; "CLEARED,WARNED,OK,NOTEXTYET,EXIT; "WITH PAGEZERO DO $IF FILLING AND NOT AUTOINDENT AND (CH=CHR(ETX)) THEN &BEGIN THEFIXER(CURSOR,1,FALSE); FIRSTLINE:=FALSE;PROMPT,FIRSTLINE: BOOLEAN; "SPACES,LMOVE,X,LINE,EOLDIST,RJUST: INTEGER; "CONTEXT: PACKED ARRAY [0..MAXSTRING] OF CHAR;   PR FINDXY(X,LINE) END; "UPSCREEN(FIRSTLINE,EXITPROMPT OR (CH=CHR(ESC)),LINE); "GETLEADING; "CURSOR:=MAX(CURSOR,STUFFSTART); "LOCEDURE SLAMRIGHT;  (* Move (slam) the portion of the EBUF^ to the right of (and including) #the cursor so that the last NUL iASTPAT:=LEFTPART+1; "COPYOK:=TRUE; COPYSTART:=LASTPAT; COPYLENGTH:=CURSOR-LASTPAT; "NEXTCOMMAND  END;  n the file (EBUF^[BUFCOUNT]) is now at #EBUF^[BUFSIZE]. THEREST points to the beginning of the right-justified #text. *)  BE FUNCTION CHECK(VALUE:INTEGER): BOOLEAN; "(* VALUE is the potential value of the cursor. If it is not in legal %range then C7 OINDENT THEN GETLEADING &ELSE (IF FILLING THEN *BEGIN ,GETLEADING; ,IF EBUF^[STUFFSTART]=CHR(EOL) THEN (* Empty line *) .B$ELSE BEGIN OK:=FALSE; EXIT(FIXUP) END; "CURSOR:=CURSOR-(BYTES-2); "EBUF^[LINESTART]:=CHR(DLE); EBUF^[LINESTART+1]:=CHR(32+BLLANKS:=PARAMARGIN ,ELSE BLANKS:=LMARGIN *END (ELSE BLANKS:=0; &IF CHECK(CURSOR+BLANKS+1) THEN (BEGIN *FILLCHAR(EBUF^[CURSANKS);  END;   PROCEDURE INSERTCH; "(* This procedure inserts a single character into the buffer. It also %handles all of OR+1],BLANKS,' '); *CURSOR:=CURSOR+BLANKS+1 (END; &NOTEXTYET:=TRUE; $END;  END;   PROCEDURE BACKUP;  (* If the CH is a the control codes (EOL,BS,DEL) and buffer over- and %under- flow conditions. INSERTCH is called by the CRT handler *)  BEGIN backspace then decrement cursor by 1. If this would #result in backing over an or a blank compression code, then fall #"REPEAT "OK:=TRUE; (* No errors that invalidate the current character have occured *) "CH:=GETCH; "IF MAPTOCOMMAND(CH)=LEFT into the code for a (also changing the CH to for communication #to the outer block) *)  VAR PTR: PTRTYPE; THEN CH:=CHR(BS); "IF ORD(CH) IN [SP,HT,EOL,BS,DEL,ETX,ESC,DC1] THEN $BEGIN &(* and are handled in the body of in BEGIN "IF CH=CHR(DC1) THEN " BEGIN GETLEADING; IF CHECK(LINESTART) THEN CURSOR:=LINESTART END "ELSE $IF (CH=CHR(BS)) AND sertit *) &IF ORD(CH) IN [SP,HT] THEN SPACEOVER &ELSE (IF ORD(CH)=EOL THEN ENDLINE (ELSE *IF ORD(CH) IN [DC1,BS,DEL] THEN Bertion',NONFATAL); PROMPT; ,GOTOXY(X,LINE); ,WARNED:=TRUE *END; (IF VALUE>THEREST-FUDGEFACTOR THEN *BEGIN ,ERROR('Buffer O'NOT( (EBUF^[CURSOR-2]=CHR(DLE)) OR (EBUF^[CURSOR-1]=CHR(EOL)) ) THEN &BEGIN (IF CURSOR or equivalent *) (CH:=CHR(DEL); (* Tell the CRT driver that the line has changed *)paces and tabs inserted into the buffer *)  BEGIN "IF CH=CHR(HT) THEN SPACES:=8-X+ORD(ODD(X) AND ODD(248)) ELSE SPACES:=1; "I (GETLEADING; (IF CHECK(LINESTART-1) THEN CURSOR:=LINESTART-1; (NOTEXTYET:=FALSE; (* thank you shawn! *) &END  END;   PRF CHECK(CURSOR+SPACES) THEN $BEGIN &FILLCHAR(EBUF^[CURSOR],SPACES,' '); &CURSOR:=CURSOR+SPACES $END  END;  OCEDURE FIXUP;  (* Convert the indentation spaces into blank compression codes, and move #the current line around accordingly  PROCEDURE FIXUP; FORWARD;   PROCEDURE ENDLINE;  (* First, if there was no text inserted on the current line, then convert *)  BEGIN "(* First compress the current line *) "EBUF^[CURSOR]:=CHR(EOL); (* Fool Getleading *) "GETLEADING; "IF BYTES >= #all of the spaces to blank compression codes. Then insert an into #the buffer followed by the appropriate number of sp2 THEN (* OK to put in # as it stands *) $MOVELEFT(EBUF^[STUFFSTART],EBUF^[LINESTART+2],CURSOR-STUFFSTART) "ELSE $IF CHaces for the #indentation. *)  BEGIN "WITH PAGEZERO DO $BEGIN &IF NOTEXTYET THEN FIXUP; &EBUF^[CURSOR]:=CHR(EOL); &IF AUTECK(CURSOR+2-BYTES) THEN &MOVERIGHT(EBUF^[STUFFSTART],EBUF^[STUFFSTART+2-BYTES],CURSOR-STUFFSTART) 8 ASETOEOL(RJUST,LINE); "WRITE(CHR(LF)); "IF LINE=SCREENHEIGHT THEN BEGIN EXITPROMPT:=TRUE; LINE:=SCREENHEIGHT-1 END; "WRITE(CORSOR:=CURSOR+3; "EBUF^[PTR]:=CHR(EOL); "EBUF^[PTR+1]:=CHR(DLE); "WITH PAGEZERO DO IF AUTOINDENT THEN $BEGIN NTEXT:EOLDIST); FIRSTLINE:=FALSE; (* Says that the whole screen has been affected. *)  END;   PROCEDURE WRITESP(CH:CHAR;HO&SAVE:=CURSOR; (* Set blanks to the indentation of the line above *) &CURSOR:=PTR; &GETLEADING; $ CURSOR:=SAVE $END "ELSEWMANY:INTEGER);  BEGIN "IF X+HOWMANY<=SCREENWIDTH THEN WRITE(CH:HOWMANY); "IF X+HOWMANY>=SCREENWIDTH THEN $BEGIN &GOTOXY(SC " BLANKS:=LMARGIN; "EBUF^[PTR+2]:=CHR(BLANKS+32); "CLEANSCREEN; "X:=BLANKS; "GOTOXY(X,LINE); WRITE(WORD:WLENGTH); "X:=X+REENWIDTH,LINE); &IF X+HOWMANY>SCREENWIDTH THEN (BEGIN WRITE('!'); GOTOXY(SCREENWIDTH,LINE) END $END; "X:=MIN(SCREENWIDTH,X+WLENGTH;  NOTEXTYET:=FALSE  END;   BEGIN (* INSERT *) "CLEARED:=FALSE; EOLDIST:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR]);HOWMANY)  END;  PROCEDURE CLEANSCREEN;  (* Code to, if possible, only erase the line, otherwise clear #the screen. Then ca "MOVELEFT(EBUF^[CURSOR],CONTEXT[0],EOLDIST); "RJUST:=SCREENWIDTH-EOLDIST; "SLAMRIGHT; "SAVEBUFCOUNT:=BUFCOUNT; "PROMPTLINEll popdown *)  BEGIN "FIRSTLINE:=FALSE; "IF CLEARED THEN $BEGIN &IF XSCREENHEIGHT THEN $BEGIN &LINE:=LINE-1; &WRITELN; OTOXY(X,LINE); "ERASETOEOL(X,LINE); "FIRSTLINE:=TRUE; IF EOLDIST<>0 THEN (* A context needs to be displayed *) $IF RJUST>X &EXITPROMPT:=TRUE $END; "IF EOLDIST<>0 THEN POPDOWN  END;   PROCEDURE POPOV;  (* When in filling mode, this procedure isTHEN (* and it will fit on the current line ... *) &BEGIN (GOTOXY(RJUST,LINE); WRITE(CONTEXT:EOLDIST); GOTOXY(X,LINE) &END $ called when a line is overflowed #(X >= rightmargin). The word is scanned off and "popped" down to the #next line. *)  VARELSE (* and it won't fit on the current line *) &BEGIN (FIRSTLINE:=FALSE; (ERASEOS(X,LINE);(* Clear the screen *) ACKUP; $END "ELSE $BEGIN (* A character to insert! *) &IF (CH<'!') OR (CH>'~') THEN CH:='?'; (* No non-printing characters * "WLENGTH: INTEGER; "SAVE,PTR: PTRTYPE; "WORD: PACKED ARRAY [0..MAXSW] OF CHAR;  BEGIN "IF NOTEXTYET THEN FIXUP; "PTR:=MAX) &IF NOTEXTYET THEN FIXUP; &IF CHECK(CURSOR+1) AND OK THEN (BEGIN *NOTEXTYET:=FALSE; *EBUF^[CURSOR]:=CH; (SCAN(-MAXCHAR,='-',EBUF^[CURSOR-1]), +SCAN(-MAXCHAR,=' ',EBUF^[CURSOR-1]))+CURSOR; "WLENGTH:=CURSOR-PTR; "WITH PAGEZERO DO I*CURSOR:=CURSOR+1 (END; $END; !UNTIL OK;  END;   PROCEDURE POPDOWN;  (* Displays CONTEXT, doing an implied scrollup if F WLENGTH>=RMARGIN-LMARGIN THEN $BEGIN &WRITESP(CH,1); &EXIT(POPOV) $END; "IF CH='-' THEN WRITE('-'); "GOTOXY(X-WLENGTH+1,nec. *)  BEGIN "IF CLEARED THEN ERASETOEOL(X,LINE) "ELSE BEGIN CLEARED:=TRUE; ERASEOS(X,LINE) END; GOTOXY(RJUST,LINE); "ERLINE); "ERASETOEOL(X-WLENGTH+1,LINE); "MOVERIGHT(EBUF^[PTR],EBUF^[PTR+3],WLENGTH); "MOVELEFT(EBUF^[PTR+3],WORD,WLENGTH); "CU9 :EOLDIST); GOTOXY(X,LINE) &END; "REPEAT $INSERTCH; $IF NOT (ORD(CH) IN [EOL,ETX,ESC,DEL,DC1]) THEN &BEGIN (IF TRANSLATE[CH]=LEFT THEN *BEGIN IF X<=SCREENWIDTH THEN WRITE(CHR(BS),' ',CHR(BS)); X:=X-1 END (ELSE *IF CH=CHR(HT) THEN WRITESP(' ',SPACES) *ELSE ,IF PAGEZERO.FILLING AND (X+1>=PAGEZERO.RMARGIN) THEN POPOV ,ELSE WRITESP(CH,1); (IF NOT PAGEZERO.FILLING AND (X=SCRO^EENWIDTH-8) AND (CH<>CHR(BS)) ( THEN WRITE(CHR(BELL)); (IF (EOLDIST<>0) AND +(X>=RJUST) AND FIRSTLINE THEN (*ran into conte xt *) *BEGIN ,POPDOWN; ,GOTOXY(X,LINE) *END; &END $ELSE (* ch in [eol,etx,esc,del,dc1] *) &BEGIN (IF CH=CHR(EOL) THEN *BEGIN ,CLEANSCREEN; ,X:=BLANKS; ,GOTOXY(X,LINE); *END (ELSE *IF CH=CHR(DEL) THEN ,BEGIN .IF LINE<=1 THEN (* Rubbed out all of what was on the screen *) 0BEGIN 2BUFCOUNT:=CURSOR+1; 2EBUF^[CURSOR]:=CHR(EOL); 2CENTERCURSOR(LINE,MIDDLE,TRUE); 2IF EOLDIST<>0 THEN POPDOWN; 2IF EXITPROMPT THEN BEGIN PROMPT; EXITPROMPT:=FALSE END 0END .ELSE 0BEGIN GOTOXY(0,LINE); CLEARED:=FALSE; 0 ERASETOEOL(0,LINE); LINE:=LINE-1 END; .GETLEADING; .X:=BLANKS-BYTES+CURSOR-LINESTART; .GOTOXY(X,LINE) ,END *ELSE ,IF CH=CHR(DC1) THEN .BEGIN 0X:=0; GOTOXY(X,LINE); ERASETOEOL(X,LINE) .END; &END; "UNTIL CH IN [CHR(ETX),CHR(ESC)]; "IF CH=CHR(ESC) THEN CURSOR:=LEFTPART+1; "BUFCOUNT:=SAVEBUFCOUNT; "WRAPUP;  END;   (*$S+*)  (**********************************************************************)  (*  *)  (* Screen Oriented Editor Written: October 11, 1978 *)  (* ------ ------(WRITELN; (IF LINE=SCREENHEIGHT THEN *BEGIN LINE:=SCREENHEIGHT-1; EXITPROMPT:=TRUE END; (GOTOXY(RJUST,LINE+1); WRITE(CONTEXT: ; FORWARD;  PROCEDURE ERASEOS(X,LINE:INTEGER); FORWARD;  PROCEDURE CLEARLINE(Y:INTEGER); FORWARD;  FUNCTION MAPTOCOMMAND(CH:RCE:MOVEIT *)  (*$I SOURCE:FIND *)  (*$I SOURCE:USER *)  (*$I SOURCE:MISC *)  (*$I SOURCE:UTIL *)  CHAR): COMMANDS; FORWARD;  FUNCTION UCLC(CH:CHAR): CHAR; FORWARD;  PROCEDURE PROMPT; FORWARD;  PROCEDURE REDISPLAY; FORWARD; BEGIN (* Segment procedure EDITOR *) "INITIALIZE; GETLEADING; CURSOR:=MAX(CURSOR,STUFFSTART); "REPEAT $CENTERCURSOR(TRASH,(-- ------ Update : November 16, 1978 *)  (* _________ *)  FUNCTION MIN(A,B:INTEGER): INTEGER; FORWARD;  FUNCTION MAX(A,B:INTEGER): INTEGER; FORWARD;   (* By Richard S. Kaufmann, / \ *)  (* IIS  FUNCTION SCREENHAS(WHAT: SCREENCOMMAND): BOOLEAN; FORWARD;  FUNCTION HASKEY(WHAT: KEYCOMMAND): BOOLEAN; FORWARD;  PROCEDUR | Version | *)  (* University of California, San Diego | E.6e | *)  (* La Jolla CA 92093 E CONTROL(WHAT: SCREENCOMMAND); FORWARD;  PROCEDURE PUTMSG; FORWARD;  PROCEDURE HOME; FORWARD;  PROCEDURE ERRWAIT; FORWARD;  \_________/ *)  (* *)  (*  PROCEDURE BLANKCRT(Y: INTEGER); FORWARD;  FUNCTION LEADBLANKS(PTR:PTRTYPE;VAR BYTES: INTEGER): INTEGER; FORWARD;  PROCEDURE This version specially modified for HAZELTINE terminals that *)  (* emit a DLE as control code for NDFS. This is not theCENTERCURSOR(VAR LINE: INTEGER; LINESUP: INTEGER; NEWSCREEN:BOOLEAN); "FORWARD;  PROCEDURE FINDXY(VAR INDENT,LINE: INTEGER); F standard *)  (* release editor. *) ORWARD;  PROCEDURE SHOWCURSOR; FORWARD;  FUNCTION GETNUM: INTEGER; FORWARD;  PROCEDURE GETLEADING; FORWARD;  FUNCTION OKTO (* *)  (* Copyright (c) 1978, by The Regents of the UniDEL(CURSOR,ANCHOR:PTRTYPE):BOOLEAN; FORWARD;  PROCEDURE LINEOUT(VAR PTR:PTRTYPE; BYTES,BLANKS,LINE: INTEGER); FORWARD;  PROCEDversity of *)  (* California at San Diego *)  (* URE UPSCREEN(FIRSTLINE,WHOLESCREEN:BOOLEAN; LINE: INTEGER); FORWARD;  PROCEDURE READJUST(CURSOR: PTRTYPE; DELTA: INTEGER); FORW *)  (**********************************************************************)   (*$IARD;  PROCEDURE THEFIXER(PARAPTR: PTRTYPE;RFAC: INTEGER;WHOLE: BOOLEAN); FORWARD;  SOURCE:HEAD *)   (* Forward declared procedures.. all procedures are in MISC and UTIL *)   PROCEDURE ERROR(S:STRING;HOWBA PROCEDURE GETNAME(MSG:STRING; VAR M:NAME); FORWARD;   (*$I SOURCE:INIT *)  (*$I SOURCE:OUT *)  (*$I SOURCE:COPD:ERRORTYPE); FORWARD;  PROCEDURE ERASETOEOL(X,LINE:INTEGER); FORWARD;  FUNCTION GETCH:CHAR; FORWARD;  PROCEDURE CLEARSCREENYFILE *)  (*$I SOURCE:ENVIRON *)  (*$I SOURCE:PUTSYNTAX *)  (*$I SOURCE:COMMAND *)  (*$I SOURCE:INSERTIT *)  (*$I SOU;  BEGIN (* Editcore *) "NEXTCOMMAND; "WHILE COMMAND<>QUITC DO COMMANDER  END;  PROCEDURE NEXTCOMMAND;  BEGIN "IF NEEDPROMPT THEN $BEGIN &PROMPTLINE:=COMPROMPT; {Made variable for screens of short width. SCREENHEIGHT DIV 2)+1,TRUE); $NEEDPROMPT:=TRUE; $IF USERINFO.ERRBLK>0 THEN PUTSYNTAX; $REPEAT &HOME; CLEARLINE(0); &EDITCORMAB} &PROMPT; &NEEDPROMPT:=FALSE; &SHOWCURSOR $END;  CH:=GETCH; "COMMAND:=MAPTOCOMMAND(CH);  END(* NEXTCOMMAND *);  E; &IF COMMAND=SETC THEN ENVIRONMENT $ ELSE IF COMMAND=COPYC THEN COPYFILE $UNTIL COMMAND=QUITC; "UNTIL OUT; "SYSCOM^.MISC PROCEDURE COMMANDER;  BEGIN "INFINITY:=FALSE; "IF COMMAND=SLASHC THEN $BEGIN REPEATFACTOR:=1; INFINITY:=TRUE; NEXTCOMMAND INFO.NOBREAK := FALSE (* 28 SEPT 77*)  END;   BEGIN END. END "ELSE $IF COMMAND=DIGIT THEN REPEATFACTOR:=GETNUM ELSE REPEATFACTOR:=1; "CASE COMMAND OF $ILLEGAL: BEGIN ERRWAIT; SHOWCURSOR; NEXTCOMMAND END; $REVERSEC,FORWARDC: FIXDIRECTION; $COPYC: COPY; $DUMPC: DUMP; $FINDC: FIND; $INSERTC: INSERTIT; $JSL EL O^UMPC: JUMP; $LISTC: NEXTCOMMAND; (* NOT YET, DEPENDS ON TERAK PAN *) $MACRODEFC: DEFMACRO; $QUITC: ; (* EXIT HANDLED IN OUTER BLOCK *) $REPLACEC: FIND; $SETC: SETSTUFF; $VERIFYC: VERIFY; $XECUTEC: XMACRO; $ZAPC: ZAPIT; $EQUALC: BEGIN &CURSOR:=LASTPAT; &GETLEADING; &CURSOR:=MAX(CURSOR,STUFFSTART); &CENTERCURSOR(TRASH,MIDDLE,FALSE); &SHOWCURSOR; NEXTCOMMAND $END;  $ADJUSTC,DELETEC,PARAC,UP,DOWN,LEFT,RIGHT,ADVANCE,TAB,SPACE: MOVEIT "END (* BIG LONG CASE STATEMENT *);  END (* COMMANDER *);<  BEGIN "IF INDELETE THEN $BEGIN &IF LINE>=SCREENHEIGHT THEN (BEGIN *CENTERCURSOR(LINE,2,TRUE); *IF ABS(CURSOR-ANCHOR) > ABS(DIST) THEN CLEAR(0,1,MAX(X-1,0),LINE) (END &ELSE (BEGIN *CENTERCURSOR(LINE,SCREENHEIGHT-1,TRUE); *GOTOXY(X,LINE); *IF ABS(CURSOR-ANCHOR) > ABS(DIST) THEN WRITE(CHR(11)) (END; " DOFFSCREEN:=TRUE; $END "ELSE $IF (COMMAND=PARAC) AND ((DIRECTION='<') OR (LINE MOD SCREENHEIGHT=OLDLINE)) &THEN CENTERCURSOR(LINE,OLDLINE,TRUE) &ELSE CENTERCURSOR(LINE,MIDDLE,TRUE); "IF EXITPROMPT AND (COMMAND<>QUITC) THEN $BEGIN &PROMPT; EXITPROMPT:=FALSE $END; "OLDLINE:=LINE; OLDX:=X;  END;   PROCEDURE UPROCEDURE MOVEIT;  VAR "SCROLLMARK,X,LINE,I: INTEGER; "EXITPROMPT: BOOLEAN; (* Prompt after leaving Moveit! *) "OLDLINE,OLDXPMOVE;  VAR I:INTEGER;  BEGIN "I:=1; "GETLEADING; "(* FIND THE LINE FIRST *) "WHILE (I<=REPEATFACTOR) AND (LINESTART>1) DO: INTEGER; "NEWDIST,DIST: INTEGER; "DOFFSCREEN,ATEND,INREPLACE,INDELETE: BOOLEAN; "PTR,ANCHOR,OLDCURSOR: PTRTYPE;   PROCED $BEGIN &CURSOR:=LINESTART-1; (* LAST CHAR OF LINE ABOVE *) &GETLEADING; &LINE:=LINE-1; I:=I+1; $END; "(* If possible setURE SCROLLUP(BOTTOMLINE:PTRTYPE; HOWMANY: INTEGER);  (* bottomline is the "linestart" of the line to be scrolled up *)  VAR  the cursor at the same x coord we came from. Otherwise, "PTR: PTRTYPE; "I: INTEGER;  BEGIN "(* DISPLAY THE NEXT LINE ON THE BOTTOM OF THE SCREEN *) "I:=0; "PTR:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[LINE1PTR])+LINE1PTR+1; "WHILE (I=HOWMANY) OR (BOTTOMLINE>=BUFCOUNT-1); "EXITPROMPT:=TRUE;  END(* SCROLLUP *);   PROCEDURE CLEAR(X1,Y1,X2,Y2: INTEGER); FORWARD;   PROCEDURE CENTER; = INESTART, (* same col *) 7SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR (* eol *) 6) 3) /);  IF LINE<1 THEN CENTER;  END(CURSOR-REPEATFACTOR,1)); "IF LINE<1 THEN CENTER; "FINDXY(X,LINE);  END (* LEFTMOVE *);   PROCEDURE RIGHTMOVE;  VAR * UPALINE *);   PROCEDURE DOWNMOVE;  VAR "I: INTEGER; "NEXTEOL: PTRTYPE;  BEGIN "I:=1; "NEXTEOL:=SCAN(MAXCHAR,=CHR(EOL"EOLPTR: PTRTYPE;  BEGIN "EOLPTR:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR; "WHILE (EOLPTRSCREENHEIGHT THEN $IF (LINE-SCREENHEIGHT>=SCREENHEIGHT) OR (INDELE,=CHR(EOL),EBUF^[CURSOR])+CURSOR $END; "IF LINE>SCREENHEIGHT THEN $IF (LINE-SCREENHEIGHT>=SCREENHEIGHT) OR (INDELETE) THEN &TE) THEN &CENTER $ELSE &SCROLLUP(SCROLLMARK,LINE-SCREENHEIGHT); "GETLEADING; CENTER $ELSE &SCROLLUP(SCROLLMARK,LINE-SCREENHEIGHT); "CURSOR:=MIN(BUFCOUNT-1,CURSOR+REPEATFACTOR); "FINDXY(X,LINE);  END(*"(* If possible set the cursor at the same x coord we came from. Otherwise, %set it either to the end of the buffer, the begi RIGHTMOVE *);   PROCEDURE LINEMOVE(REPEATFACTOR: INTEGER);  VAR I: INTEGER;  BEGIN "I:=1; "IF DIRECTION='<' THEN $BEGINnning of text %on that line, or the end of the text on that line *) "CURSOR:=MIN(BUFCOUNT-1, (* End of the buffer *) 1MA &WHILE (I<=REPEATFACTOR) AND (CURSOR>1) DO (BEGIN *IF EBUF^[CURSOR]=CHR(EOL) THEN CURSOR:=CURSOR-1; (* NULL LINE CASE *) *X(STUFFSTART, (* Not in the indentation *) 5MIN(X-BLANKS+BYTES+LINESTART (* Where it wants to be *) 8,SCAN(MAXCHAR,=CHR(EOLCURSOR:=SCAN(-MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR; (* 1 UP *) *IF CURSOR>=1 THEN BEGIN LINE:=LINE-1; I:=I+1 END; (END; ),EBUF^[CURSOR])+CURSOR 8) 5) .);  END(* DOWNMOVE *);   PROCEDURE LEFTMOVE;  BEGIN "GETLEADING; (* SET LINESTART AND S&CURSOR:=MAX(1,CURSOR); (* BACK INTO REALITY *) &ATEND:= (CURSOR=1); &IF LINE<1 THEN CENTER $END "ELSE $BEGIN (* DIRECTIONTUFFSTART *) "WHILE (STUFFSTART>CURSOR-REPEATFACTOR) AND (CURSOR>REPEATFACTOR) DO $BEGIN &REPEATFACTOR:=REPEATFACTOR-(CURSOR-='>' *) &WHILE (I<=REPEATFACTOR) AND (CURSOR +2-STUFFSTART); *BUFCOUNT:=BUFCOUNT+LINESTART+2-STUFFSTART; & END; &EBUF^[LINESTART]:=CHR(DLE); &X:=BLANKS+DELTA; $END; "LTA+REPEATFACTOR; MODE:=RELATIVE .END ,ELSE .IF COMMAND IN [LISTC,REPLACEC,COPYC] THEN 0BEGIN 2GETLEADING; 2LLENGTH:=SCAN(*1 DOWN *) *IF CURSOR=BUFCOUNT-1); &IF LINE>SCREENHEIGHT THEN (IF (LINE-SCREENHEIGHT>=SCREENHEIGHT) OR (COMMAND=PARAC) +OR I"LINEOUT(LINESTART,BYTES,BLANKS,LINE); GOTOXY(X,LINE);  END(* DOIT *);   BEGIN (* adjusting *) "WITH PAGEZERO DO $BEGIN NREPLACE OR INDELETE *THEN ,CENTER *ELSE SCROLLUP(SCROLLMARK,LINE-SCREENHEIGHT); &CURSOR:=MIN(CURSOR,BUFCOUNT-1) $END; "G&SAVEDIR:=DIRECTION; EXITPROMPT:=FALSE; INDELETE:=FALSE; LASTPAT:=CURSOR; &INREPLACE:=TRUE; &PROMPTLINE:=ADJUSTPROMPT; &PROMPETLEADING; "CURSOR:=STUFFSTART; (* FORCED TO BEGINNING OF STUFF *) "X:=BLANKS;  END(* LINEMOVE *);   PROCEDURE JUMPBEGIN; T; NEEDPROMPT:=TRUE; &MODE:=RELATIVE; &SHOWCURSOR; &FINDXY(X,LINE); &TDELTA:=0; &REPEAT (CH:=GETCH; (COMMAND:=MAPTOCOMMAN BEGIN "CURSOR:=1; CENTERCURSOR(TRASH,1,FALSE)  END;   PROCEDURE JUMPEND;  BEGIN "CURSOR:=BUFCOUNT-1; CENTERCURSOR(TRASHD(CH); (INFINITY:=FALSE; (IF COMMAND=SLASHC THEN *BEGIN ,REPEATFACTOR:=1; INFINITY:=TRUE; CH:=GETCH; COMMAND:=TRANSLATE[CH] ,SCREENHEIGHT,FALSE)  END;   PROCEDURE ADJUSTING;  LABEL 1;  TYPE "MODES=(RELATIVE,LEFTJ,RIGHTJ,CENTER);  VAR *END (ELSE *IF COMMAND=DIGIT THEN REPEATFACTOR:=GETNUM ELSE REPEATFACTOR:=1; (IF COMMAND IN [UP,DOWN] THEN *BEGIN ,IF COMM"LLENGTH,TDELTA,I: INTEGER; "SAVEDIR: CHAR;  MODE: MODES;   PROCEDURE DOIT(DELTA:INTEGER);  VAR "EOLDIST: INTEGER; "TAND=UP THEN DIRECTION:='<' ELSE DIRECTION:='>'; ,I:=1; ,ATEND:=FALSE; ,WHILE NOT ATEND AND ((I<=REPEATFACTOR) OR INFINITY) DO: PACKED ARRAY [0..MAXSTRING] OF CHAR;  BEGIN "GETLEADING; (* Set linestart, stuffstart, and blanks *) "IF BLANKS+DELTA<0 THE .BEGIN 0I:=I+1; 0LINEMOVE(1); 0IF NOT ATEND THEN 2BEGIN 4IF MODE=RELATIVE THEN DOIT(TDELTA) 4ELSE 6BEGIN 8LLENGTH:=SCAN DELTA:=-BLANKS; "IF (EBUF^[LINESTART]=CHR(DLE)) AND (STUFFSTART-LINESTART=2) THEN $X:=ORD(EBUF^[LINESTART+1])+DELTA-32 "ELSN(MAXCHAR,=CHR(EOL),EBUF^[STUFFSTART]); 8CASE MODE OF :LEFTJ: DOIT(LMARGIN-BLANKS); E $BEGIN &IF STUFFSTART-LINESTART>2 THEN (MOVELEFT(EBUF^[STUFFSTART],EBUF^[LINESTART+2],BUFCOUNT-STUFFSTART) &ELSE (BEGIN :RIGHTJ: DOIT((RMARGIN-LLENGTH+1)-BLANKS); :CENTER: :DOIT(((RMARGIN-LMARGIN+1)-LLENGTH) DIV 2-BLANKS+LMARGIN) 8END (* case **IF BUFCOUNT>BUFSIZE-100 THEN ,BEGIN .ERROR('Buffer overflow',NONFATAL); .EXIT(ADJUSTING) ,END *ELSE ,MOVERIGHT(EBUF^[STUF) 6END (* else *) 2END; (* if not atend *) .END (* while ... *) *END (ELSE *IF COMMAND=LEFT THEN ,BEGIN .DOIT(-REPEATFACFSTART],EBUF^[LINESTART+2],BUFCOUNT-STUFFSTART); (END; &IF LINESTART+2<>STUFFSTART THEN (BEGIN *READJUST(LINESTART,LINESTARTTOR); TDELTA:=TDELTA-REPEATFACTOR; MODE:=RELATIVE ,END *ELSE ,IF COMMAND=RIGHT THEN .BEGIN 0DOIT(REPEATFACTOR); TDELTA:=TDE? T: LEFTMOVE; &RIGHT: RIGHTMOVE; &SPACE: IF DIRECTION='<' THEN LEFTMOVE ELSE RIGHTMOVE; &UP: UPMOVE; &DOWN: DOWNMOVE; &ADVANsumed to be before (X2,Y2). This #procedure takes these co-ordinates and clears (writes blanks) over #the screen between themCE: LINEMOVE(REPEATFACTOR); &PARAC: (IF REPEATFACTOR>1000 THEN ERROR('Too many',NONFATAL) (ELSE LINEMOVE(SCREENHEIGHT*REPEAT (inclusive) *)  VAR XX,I: INTEGER;  BEGIN "GOTOXY(X1,Y1); "XX:=X1; "FOR I:=Y1 TO Y2-1 DO BEGIN IF I<>0 THEN ERASETOEOL(XXFACTOR); &TAB: BEGIN -IF REPEATFACTOR >= 4096 THEN /ERROR('Integer Overflow',NONFATAL) -ELSE /BEGIN ,I); XX:=0; WRITELN END; "IF Y1<>Y2 THEN FOR I:=0 TO X2 DO WRITE(' ') "ELSE FOR I:=X1 TO X2 DO WRITE(' ')  END;   PROCEDUR1REPEATFACTOR:=TABBY; 1IF DIRECTION='<' THEN LEFTMOVE ELSE RIGHTMOVE; 1SAVEX:=X+1; 1WHILE (X<>SAVEX) AND (X MOD 8<>0) DO 3BE RESOLVESCREEN;  VAR "X1,X2,Y1,Y2,SAVE: INTEGER; "C1,C2: PTRTYPE;  BEGIN "X1:=X; Y1:=LINE; "X2:=OLDX; Y2:=OLDLINE; "IMAXCHAR,=CHR(EOL),EBUF^[STUFFSTART]); 2IF COMMAND=LISTC THEN 4BEGIN MODE:=LEFTJ; DOIT(LMARGIN-BLANKS) END 2ELSE 4IF COMMAND=EGIN 5SAVEX:=X; REPEATFACTOR:=1; 5IF DIRECTION='>' THEN RIGHTMOVE ELSE LEFTMOVE / END /END +END $END; $IF EXITPROMPT OREPLACEC THEN 6BEGIN MODE:=RIGHTJ; DOIT((RMARGIN-LLENGTH+1)-BLANKS) END 4ELSE (* COMMAND=COPYC *) 6BEGIN 8MODE:=CENTER; 8DOR (COMMAND=PARAC) THEN GOTOXY(X,LINE) $ELSE &IF LINE=OLDLINE THEN &BEGIN (IF X=OLDX+1 THEN *GOTOXY(X,LINE) {Kludge for HAZIT(((RMARGIN-LMARGIN+1)-LLENGTH) DIV 2-BLANKS+LMARGIN) 6END 0END .ELSE ,IF CH<>CHR(ETX) THEN BEGIN ERRWAIT; SHOWCURSOR END; ELTINE terminals that used DLEs} (ELSE *IF X=OLDX-1 THEN WRITE(CHR(BS)) *ELSE GOTOXY(X,LINE) &END &ELSE (IF X=OLDX THEN *&1: UNTIL CH=CHR(ETX); &DIRECTION:=SAVEDIR; $END;  END;   FUNCTION TABBY: INTEGER;  BEGIN "IF REPEATFACTOR > 0 THEN BEGIN ,IF LINE=OLDLINE+1 THEN WRITE(CHR(LF)) ,ELSE IF LINE=OLDLINE-1 THEN CONTROL(UPCURSOR) ,ELSE GOTOXY(X,LINE); *END (ELS$IF DIRECTION = '>' THEN &TABBY:=8*(REPEATFACTOR-1)+ 8-X+ORD(ODD(X) AND ODD(248)) $ELSE &BEGIN (IF X=0 THEN TABBY:=REPEATFE *GOTOXY(X,LINE); $REPEATFACTOR:=1; $NEXTCOMMAND "UNTIL NOT (COMMAND IN [UP,DOWN,LEFT,RIGHT,ADVANCE,SPACE,TAB]); "IF EXITPACTOR*8 (ELSE TABBY:=8*(REPEATFACTOR-1)+X-ORD(ODD(X-1) AND ODD(248)) " END "ELSE TABBY:=0  END;  PROCEDURE MOVING;  VAROMPT THEN PROMPT; "SHOWCURSOR;  END (* MOVING *);   PROCEDURE PUTITBACK(C1,C2: PTRTYPE);  VAR "PTR: PTRTYPE; "INDENT,LOR "SAVEX: INTEGER;  BEGIN "INDELETE:=FALSE; "INREPLACE:=FALSE; "EXITPROMPT:=FALSE; "IF INFINITY THEN $BEGIN &CASE COMMANFF: INTEGER;  BEGIN "PTR:=C1; "WHILE PTR<=C2 DO $BEGIN &IF EBUF^[PTR]=CHR(EOL) THEN (BEGIN *PTR:=PTR+1; WRITELN; D OF (UP,LEFT: JUMPBEGIN; (DOWN,RIGHT: JUMPEND; (SPACE,ADVANCE,TAB: IF DIRECTION='<' THEN JUMPBEGIN ELSE JUMPEND &END; &NEE*INDENT:=LEADBLANKS(PTR,LOFF); *IF (PTR0) THEN ,WRITE(' ':INDENT); *PTR:=PTR+LOFF (END &ELSE (BEGIN WRITDPROMPT:=TRUE; &NEXTCOMMAND; &EXIT(MOVEIT) $END; "FINDXY(X,LINE); "REPEAT $OLDX:=X; OLDLINE:=LINE; $CASE COMMAND OF &LEFE(EBUF^[PTR]); PTR:=PTR+1 END; $END;  END;   PROCEDURE CLEAR(*X1,Y1,X2,Y2: INTEGER*);  (* Screen co-ordinate (X1,Y1) is as@ SOR=STUFFSTART); "PROMPTLINE:=DELETEPROMPT; "PROMPT; NEEDPROMPT:=TRUE; "SHOWCURSOR; "FINDXY(X,LINE); "STARTLINE:=LINE; "RE (CURSOR:=SAVE $END "ELSE $BEGIN ©LINE:=FALSE; COPYOK:=TRUE; ©START:=MIN(CURSOR,ANCHOR); ©LENGTH:=ABS(CURSOR-PEAT $OLDCURSOR:=CURSOR; $DIST:=NEWDIST; $OLDX:=X; OLDLINE:=LINE; $CH:=GETCH; $COMMAND:=TRANSLATE[CH]; $IF COMMAND=DIGIT TANCHOR); &CURSOR:=ANCHOR; " END; "1:INDELETE:=FALSE; "OK:=(LINE=STARTLINE) AND NOT DOFFSCREEN; "UPSCREEN(OK,NOT OK,LINE); HEN REPEATFACTOR:=GETNUM ELSE REPEATFACTOR:=1; $IF COMMAND IN [REVERSEC..DIGIT,ADVANCE,SPACE] THEN &BEGIN (CASE COMMAND OF *"NEXTCOMMAND;  END;   BEGIN "IF COMMAND=DELETEC THEN $DELETING "ELSE $IF COMMAND=ADJUSTC THEN &BEGIN ADJUSTING; NEXTCOLEFT: LEFTMOVE; *RIGHT: RIGHTMOVE; *SPACE: IF DIRECTION='<' THEN LEFTMOVE ELSE RIGHTMOVE; *UP: UPMOVE; *DOWN: DOWNMOVE; MMAND END $ELSE MOVING;  END;   *ADVANCE: LINEMOVE(REPEATFACTOR); *REVERSEC,FORWARDC: ,BEGIN .IF COMMAND=REVERSEC THEN 0DIRECTION:='<' .ELSE 0DIRECTION:='>'; .GOTOXY(0,0); WRITE(DIRECTION); GOTOXY(X,LINE) ,END; *TAB: ,BEGIN .IF REPEATFACTOR>=4096 THEN ERROR('Integer Ovflw',NONFATAL) .ELSE 0BEGIN 2REPEATFACTOR:=TABBY; 2IF DIRECTION='<' THEN LEFTMOVE ELSE RIGHTMOVE 0END ,END (END; (NEWDIST:=CURSF NEWDIST>DIST THEN $BEGIN C1:=CURSOR-1; C2:=OLDCURSOR; X1:=X1-1 END "ELSE $IF NEWDISTCHR(ESC)) AND (CH<>CHR(ETX)) THEN (BEGIN ERRWAIT; GOTOXY(X,LINE) END "UNTI=CURSOR; X2:=X2-1 END $ELSE &EXIT(RESOLVESCREEN); "IF (Y1>Y2) OR ((Y1=Y2) AND (X1>X2)) THEN $BEGIN L (CH IN [CHR(ETX),CHR(ESC)]); "IF CH=CHR(ETX) THEN $BEGIN &GETLEADING; (* Indentation fixup *) &IF ATBOT AND (CURSOR=STUFF&SAVE:=C1; C1:=C2; C2:=SAVE; &SAVE:=Y1; Y1:=Y2; Y2:=SAVE; &SAVE:=X1; X1:=X2; X2:=SAVE $END; "IF ABS(NEWDIST)>ABS(DIST) THENSTART) THEN (BEGIN CURSOR:=LINESTART; SAVE:=ANCHOR; ANCHOR:=ATBOL END; &IF OKTODEL(CURSOR,ANCHOR) THEN (BEGIN *READJUST(MIN( $CLEAR(X1,Y1,X2,Y2) "ELSE $BEGIN &GOTOXY(X1,Y1); &PUTITBACK(C1,C2) $END; "GOTOXY(X,LINE)  END;   PROCEDURE DELETING;CURSOR,ANCHOR),-ABS(CURSOR-ANCHOR)); *COPYLINE:=(CURSOR=LINESTART) AND ATBOT; *IF ANCHOR MAXIDLENGTH) OR (IDLENGTH <= 0) THEN "BEGIN " WRITE( 'Illegal volume name. Do you want to mark it anyway? ' ); $IF NOT YES THEN $ EXIT( PROGRAM ); "END; $ $IF (ORD( BUFFER[ 1, 2 ] ) <> DUPDIRLASTBLK) 'OR (ORD( BUFFER[ 1, 3 ] ) <> 0 ) THEN $BEGIN &WRITE( 'A duplicate directory is not being maintained on ' ); &FOR N := FIRSTIDCHAR TO (FIRSTIDCHAR - 1 + IDLENGTH) DO (WRITE( BUFFER[ 1, N ] ); &WRITELN( ': .'); &IF ORD( BUFFER[ 1, 2 ] ) = 6 THEN &BEGIN (WRITELN('WARNING! It appeaPROGRAM DUPLICATEDIRECTORYMARKER;  "(*) This utility marks DLASTBLK as 10 so that a duplicate (*) "(*) directory will be mairs that blocks 6 - 9 are not free for use.' ); (WRITE( ' Are you sure that they are free? ' ); &END &ELSE (WRITE( ' Are yountained by the operating system. (*) " "CONST (DIRBLOX = 4; {size of a directory in blocks} (BLOCKBYTES = 511; {size of a b sure that blocks 6 - 9 are free for use? ' ); &IF YES THEN &BEGIN (WRITE( ' Do you want the directories to be marked? ' ); lock in bytes minus 1}  (FIRSTIDCHAR = 7; {location of first character in volume id} (MAXIDLENGTH = 7;  (DUPDIRLA(IF YES THEN (BEGIN *BUFFER[ 1, 2 ] := CHR( DUPDIRLASTBLK ); *BUFFER[ 1, 3 ] := CHR(0); STBLK = 10;  "VAR 'UNITID : STRING[1]; 'DRIVENUM : INTEGER; 'BUFFER : PACKED ARRAY [ 1 .. DIRBLOX, 0 .. BLOCKBYTES ] OF CH*UNITWRITE( DRIVENUM, BUFFER, SIZEOF(BUFFER), 6, 0 ); *UNITWRITE( DRIVENUM, BUFFER, SIZEOF(BUFFER), 2, 0 ); *WRITE( ' DirectAR; 'IDLENGTH, N : INTEGER; '  FUNCTION YES: BOOLEAN; "VAR CH : CHAR;  BEGIN "UNITREAD( 1, CH, 1, 0, 0 ); "WRITELN;  ories are now marked as duplicate. ' ); (END; &END; $END $ELSE $BEGIN &WRITE( ' A duplicate directory is already being maiO^ YES := (CH = 'Y');  END; '  BEGIN { of Duplicate Directory Marker } " "PAGE(OUTPUT); "WRITELN;  WRITELN( 'Duplicate Directory Marker { July 13, 1978 } ' ); "WRITELN; " "REPEAT $WRITE( ' Enter drive # of user''s disk [4 or 5]: ' ); $READLN( UNITID ); $WRITELN; $IF LENGTH( UNITID ) > 0 THEN &DRIVENUM := ORD( UNITID[1] ) - ORD('0') $ELSE &EXIT( PROGRAM ); B ntained on ' ); &FOR N := FIRSTIDCHAR TO (FIRSTIDCHAR - 1 + IDLENGTH) DO (WRITE( BUFFER[ 1, N ] ); &WRITELN( ': .'); &WRITE( ' Mark not done. ' ); $END; " "WRITE( 'Type to exit. ' ); "READLN;   END.  PROGRAM DUPLICATEDIRECTORYCOPIER;  "(*) This utility will copy the duplicate directory (*) "(*) in blocks 6 - 9 into the standard directory in (*) "(*) blocks 2 - 5. It will also mark DLASTBLK as 10 (*)  (*) so as to maintain the duplicate directory. (*) " " "CONST (DIRBLOX = 4; {size of a directory in blocks} (BLOCKBYTES = 511; {size of a block in bytes minus 1}  (FIRSTIDCHAR = 7; {location of first character in volume id} (MAXIDLENGTH = 7;  (DUPDIRLASTBLK = 10;  "VAR 'UNITID : STRING[1]; 'DRIVENUM : INTEGER; 'BUFFER : PACKED ARRAY [ 1 .. DIRBLOX, 0 .. BLOCKBYTES ] OF CHAR; 'IDLENGTH, O^N : INTEGER; '  FUNCTION YES: BOOLEAN; "VAR CH : CHAR;  BEGIN "UNITREAD( 1, CH, 1, 0, 0 ); "WRITELN;  YES := (CH = 'Y');  END; '  BEGIN { of Duplicate Directory Copier } " "PAGE(OUTPUT); "WRITELN; "WRITELN( 'Duplicate Directory Copier { July 12, 1978 } ' );  WRITELN; " "REPEAT $WRITE( ' Enter drive # of user''s disk [4 or 5]: ' ); $READLN( UNITID ); $IF LENGTH( UNITID ) > 0 THEN &DRIVENUM := ORD( UNITID[1] ) - ORD('0') $ELSE &EXIT( PROGRAM ); "UNTIL DRIVENUM IN [4,5]; " "UNITREAD( DRIVENUM, BUFFER, SIZEOF(BUFFER), 6, 0 ); "IDLENGTH := ORD( BUFFER[ 1, 6 ] ); " "IF (IDLENGTH > MAXIDLENGTH) OR (IDLENGTH <= 0) THEN " WRITE( 'Illegal volume name. Do you want to copy anyway? ' ) " "ELSE "BEGIN $WRITE( 'Are you sure you want to zap the directory of ' ); $FOR N := FIRSTIDCHAR TO (FIRSTIDCHAR - 1 + IDLENGTH) DO &WRITE( BUFFER[ 1, N ] ); $WRITC Systems. *)  (********************************************************************)   (* YALOE * YALOE * YALOE * YALOE * YALOE * YALOE * YALOE * YALOE * * This text editor is based on the command structure * of the RT-11 system text editor. Initially structured * and writted by Richard Kaufmann and Greg Davidson. * Later modified, enhanced, and quickened by KeithE( ': {blocks 2-5}? ' ); "END; " "IF YES THEN "BEGIN $IF ORD( BUFFER[ 1, 2 ] ) <> DUPDIRLASTBLK THEN $BEGIN $ WRITELN( 'A duplicate directory has not been maintained on this disk. ' ); $ WRITE( ' Are you sure you want to copy the directory? ' )O^; &IF NOT YES THEN (EXIT( PROGRAM ) &ELSE &BEGIN (BUFFER[ 1, 2 ] := CHR( DUPDIRLASTBLK ); (BUFFER[ 1, 3 ] := CHR(0); (UNITWRITE( DRIVENUM, BUFFER, SIZEOF(BUFFER), 6, 0 ); &END; $END; $UNITWRITE( DRIVENUM, BUFFER, SIZEOF(BUFFER), 2, 0 ); $WRITE( ' Directory copy is complete. ' ); "END  ELSE $WRITE( ' Directory copy aborted. ' );  "WRITE( 'Type to exit. ' );  READLN;   END.   SEGMENT PROCEDURE EDITOR(INN,OWWT: FIBP); (********************************************************************)  (* Copyright (c) 1978 Regents of the University of California. *)  (* Permission to copy or distribute this software or documen-  *)  (* tation in hard or soft copy granted only by written license *)  (* obtained from the Institute for Information D EGER; BUFSIZE,BUFEND: INTEGER; EQUALLENGTH: INTEGER; ESC: CHAR; CTRLU: INTEGER; BACK,ACR: CHAR; EXEC: ^COMARRAY; B NPAGES := NPAGES -1; CURSOR := CURSOR +1023; NEXT := NEXT +1024; I := SCAN(-1024,<>CHR(0),BUF^[CURSOR]); UF: ^BUFCHUNK; MACROS: ARRAY[0..MAXMAC] OF RECORD LGTH: INTEGER; EXEC: ^COMARRAY END; OPTION: PACKED RECOR CURSOR := CURSOR +I +1; (* POINT AT FIRST NUL *) IF NPAGES > 0 THEN MOVELEFT(BUF^[NEXT],BUF^[CURSOR],1024); END; D LISTSIZE: 0..100; ONOFF: BOOLEAN END; IOFILE: FILE; FUNCTION COMMAND: BOOLEAN; FORWARD; 1: (* THIS IS WHERE THE WOUND IS CLOSED AND HEALED *) CLOSE(IOFILE); MOVELEFT(BUF^[STASHEDAT],BUF^[CURSOR],STASHSIZE); FUNCTION MIN(A,B:INTEGER): INTEGER; BEGIN IF A>B THEN MIN := B ELSE MIN := A END; FUNCTION NEWFIN: BOOLEAN; (* TRUE IF ERROR  ENDPOS := STASHSIZE +CURSOR; BUF^[ENDPOS] := CHR(0); CURSOR := STASHCURSOR; END; END; PROCEDURE INITIALIZE; VAR OCCURS *) LABEL 1; VAR NBLOCKS,STASHSIZE,STASHEDAT: INTEGER; STASHCURSOR,NPAGES,I,NEXT: INTEGER; DIDDLED: BOOLEAN; BEGBUFMAKER: ^BUFCHUNK; SPACEMAKER: ^COMARRAY; HERE: ^INTEGER; LIMIT: INTEGER; TEST: BOOLEAN; BEGIN WRITE(OUTPUT,'YALOE:'IN NEWFIN := FALSE; IF BLOCKREAD(IOFILE,I,0,2) = 0 THEN BEGIN (* OK *) STASHCURSOR := CURSOR; STASHSIZE := ENDPOS - ); IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN WRITE(OUTPUT, ' - ? for details'); WRITELN(OUTPUT);  Shillington. * Released continuously from early June 1977. * Latest fixes by Roger Sumner for I.3 8-AUG-77 * 11-AUG-77 KeitCURSOR; STASHEDAT := BUFEND-STASHSIZE; IF (STASHEDAT > CURSOR) THEN (* THERE IS ROOM *) MOVERIGHT(BUF^[CURSOR],BUF^[Sh Shillington backspacing changes * 13-SEP-77 kas & rts ALPHA lock and backspace fix TASHEDAT],STASHSIZE) ELSE BEGIN WRITELN(OUTPUT,'not enough space'); NEWFIN := TRUE; GOTO 1; END; D * 24-SEP-77 rts removes alpha lock...put into 1.3b interp * 7-OCT-77 Made a non-system program...RSK dynasty takes over * 9IDDLED := FALSE; IF ODD(CURSOR) THEN BEGIN DIDDLED := TRUE; CURSOR := CURSOR +1; END; NBLOCKS := (STASHE-FEB-78 Bugs about heap remain...I.4 out the door anyway * system works ok with dirty fix in writedir! * YALOE * YALDAT - CURSOR) DIV 512; NBLOCKS := BLOCKREAD(IOFILE,BUF^[CURSOR],NBLOCKS); IF (NOT EOF(IOFILE)) OR (IORESULT <> 0) OR (ODOE * YALOE * YALOE * YALOE * YALOE * YALOE * YALOE *) CONST RET = 13; TAB = 9; CTRLX = (*030o*) 24; DC1 = (*021o*) 17D(NBLOCKS)) THEN BEGIN CLOSE(IOFILE); WRITELN(OUTPUT,'not enough space'); CURSOR := STASHCURSOR; ; EXECSIZE = 1000; MAXMAC = 9; (* CHANGING THIS HAS IMPACT ON THE CODE... *) SHIFT = 15; TYPE FILEBUF = PACKED ARRAY[0.. NEWFIN := TRUE; GOTO 1; END; NPAGES := NBLOCKS DIV 2; IF DIDDLED THEN (* UGH *) BEGIN CURSOR := CU1023] OF CHAR; COMARRAY = PACKED ARRAY[0..99] OF CHAR; BUFCHUNK = PACKED ARRAY[0..999] OF CHAR; VAR I,J,ENDPOS,CURSOR: INTRSOR -1; MOVELEFT(BUF^[CURSOR+1],BUF^[CURSOR],NPAGES*1024); END; NEXT := CURSOR; WHILE NPAGES > 0 DO BEGIN E 0; OPTION.ONOFF := FALSE; BUFEND := BUFSIZE; I := 0; ACR := CHR(RET); BACK := SYSCOM^.CRTCTRL.BACKSPACE; ESC := SY CLOSE(IOFILE,LOCK); CURSOR := STASHCURSOR; END; PROCEDURE CLOSETHEWORLD(VAR CH: CHAR); VAR LTITLE : STRING[29]; EXSCOM^.CRTINFO.ALTMODE; CTRLU := ORD(SYSCOM^.CRTINFO.LINEDEL); WITH USERINFO DO IF GOTSYM THEN BEGIN OPENOLD(IOFILE,COITSET: SET OF 'A'..'z'; BEGIN EXITSET := ['E','e','U','u','R','r']; REPEAT IF NOT (CH IN EXITSET) THEN BEGIN CLEARNCAT(SYMVID,':',SYMTID)); IF NEWFIN THEN BEGIN WRITELN(OUTPUT,'Lost workfile source'); GOTSYM := FALSE END SCREEN; PL:='Quit: U(pdate work file, E(xit without update, R(eturn to editor'; PROMPT; READ(INPUT,CH); WRITELN(OUTP ELSE BEGIN WRITE(OUTPUT,'Workfile '); IF LENGTH(WORKTID) > 0 THEN WRITE(OUTPUT,WORKTID,' '); UT) END; IF (CH='U') OR (CH='u') THEN WITH USERINFO DO BEGIN LTITLE := '*SYSTEM.WRK.TEXT'; OPENNEW(IOFILE,LTITL WRITELN(OUTPUT,'read in'); END END ELSE BEGIN ENDPOS := 0; BUF^[0] := CHR(0); WRITELN(OUTPUT,'No workfile E); NEWOUTLOOK; (*IF WE GET HERE THEN FILE IS LOCKED ON DISK OK*) SYMVID := SYVID; SYMTID := 'SYSTEM.WRK.TEXT'; GOTSYM := TRUEto read'); END; CURSOR := 0; EQUALLENGTH := 0; END; PROCEDURE NEWOUTLOOK; VAR I:INTEGER; STASHCURSOR: INTEGER; ; LTITLE := '*SYSTEM.WRK.CODE'; OPENOLD(IOFILE,LTITLE); CLOSE(IOFILE,PURGE); GOTCODE := FALSE; CODETID := '' END UNTIL  P: ^INTEGER; COM: ^FILEBUF; BEGIN STASHCURSOR := CURSOR; MARK(P); NEW(COM); FILLCHAR(COM^[0],1024,CHR(CH IN EXITSET; END; PROCEDURE PROMPTS; VAR HERE: ^INTEGER; BEGIN MARK(HERE); CLEARSCREEN; 0)); CURSOR := 0; IF BLOCKWRITE(IOFILE,COM^,2) = 2 THEN WHILE (CURSOR + 1023) < ENDPOS DO BEGIN I := SCAN(-102 WRITELN(OUTPUT,'Yet Another Line Oriented Editor.'); WRITELN(OUTPUT); WRITELN(OUTPUT, 'Advance Beginning Change Delete2, = CHR(RET), BUF^[CURSOR +1022]); MOVELEFT(BUF^[CURSOR],COM^,1023+I); FILLCHAR(COM^[1023+I],ABS(I)+1,CHR(0));  Get Insert Jump'); WRITELN(OUTPUT,'Kill List Macro Now '); WRITELN(OUTPUT,'Quit 2 THEN BEGIN RELEASE(P); WRITELN(OUTPUT, 'Output file error: Help'); CLOSE(IOFILE); EXIT(CO TEST := ((LIMIT - ORD(HERE))<5000) AND ((LIMIT - ORD(HERE))>0); IF NOT TEST THEN BEGIN NEW(BUFMAKER); BUFSIZE := BUMMAND); END; CURSOR := CURSOR+1023+I; END; IF (CURSOR < ENDPOS) THEN BEGIN FILLCHAR(BUF^[ENDPOS],1024-FSIZE +SIZEOF(BUFCHUNK) END; UNTIL TEST; IF BUFSIZE < 0 THEN BUFSIZE := 32000; "NEW(EXEC); FOR I := 1 TO 9 DO NEW(S(ENDPOS-CURSOR),CHR(0)); MOVELEFT(BUF^[CURSOR],COM^,1024); IF BLOCKWRITE(IOFILE,COM^,2) <>2 THEN BEGIN PACEMAKER); (* CREATE SPACE FOR BASIC COMMAND *) FOR I := 0 TO MAXMAC DO MACROS[I].EXEC := NIL; CURSOR := 0; ENDPOS :=  RELEASE(P); WRITELN(OUTPUT,'Output file error. HELP!'); CLOSE(IOFILE); EXIT(COMMAND); END; END; RELEASE(P); F can) to cancel command input.'); WRITELN(OUTPUT); WRITELN(OUTPUT,'The macros you have defined are:'); WRITE(OUTPUT,' - '); BEGIN WRITELN(OUTPUT,CRTESC,UP); WRITE(OUTPUT,CRTESC,EEOL); END; WHILE (I > 0) AND (EXEC^[I] <> ACR)  FOR I := 0 TO MAXMAC DO IF MACROS[I].EXEC <> NIL THEN WRITE(OUTPUT,I,' - '); WRITELN(OUTPUT); WRITE(OUTPUT,'YouDO I := PRED(I); IF I <> 0 THEN I := SUCC(I) ELSE WRITE(OUTPUT,'*') END ELSE IF (CH < ' ') THEN BEGIN r text buffer is ',BUFSIZE,' bytes, ',ENDPOS); WRITELN(OUTPUT,' of which are filled, leaving ',BUFSIZE-ENDPOS); WRITE(OUTPUT IF ORD(CH) IN [RET,TAB,DC1] THEN BEGIN 1: EXEC^[I] := CH; I := SUCC(I); IF ONEESC THEN WRITE(OUTPUT,'$') ELSE IF O,'Your ''save'' text is ',BUFSIZE-BUFEND,' bytes'); END; PROCEDURE INCOMMAND; LABEL 1,2; VAR ONEESC,WARNED: BOOLEAN; CH: CHARRD(CH) = DC1 THEN WRITE(OUTPUT,CHR(7)) ELSE WRITE(OUTPUT,CH) END; IF CH = CHR(CTRLX) THEN BEGIN I := 0; WRI; FACTOR,T: INTEGER; CHDEL: CHAR; CRTESC,UP,EEOL: CHAR; SLOW,WASBS: BOOLEAN; CONTROLS: SET OF CHAR; BEGIN TELN(OUTPUT); EXIT(INCOMMAND) END END ELSE IF (CH <> CHDEL) AND WASBS THEN BEGIN IF SLOW THEN WRITE FILLCHAR(EXEC^,EXECSIZE,ESC); FACTOR := 0; WITH SYSCOM^,CRTCTRL,MISCINFO DO BEGIN SLOW := (BACKSPACE = CHR(0)); (OUTPUT,'%'); WRITE(OUTPUT,CH); EXEC^[I] := CH; I := SUCC(I) END ELSE IF (CH <> CHDEL) AND (CH >= ' ') AND(* NO CONTROL *) CHDEL := CRTINFO.CHARDEL; CRTESC := ESCAPE; UP := RLF; EEOL := ERASEEOL END; WASB (CH <> CHR(CTRLU)) THEN BEGIN WRITE(OUTPUT,CH); EXEC^[I] := CH; I := SUCC(I) END; WASBS := (S := FALSE; CH := ' '; I := 0; WARNED := FALSE; ONEESC := FALSE; READ(KEYBOARD,CH); IF EOLN(KEYBOARD) THEN CH := ACRCH = CHDEL); IF I >= (EXECSIZE - 80 (*WARNING*)) THEN IF I > (EXECSIZE - 2) THEN REPEAT ; WHILE (CH <> ESC) OR NOT ONEESC DO BEGIN IF CH = CHR(SHIFT) THEN IF SYSCOM^.MISCINFO.HAS8510A THEN (*KAS 8/15*)  WRITELN(OUTPUT,'Command buffer full. Type or (^X).'); READ(KEYBOARD,CH); IF CH=CHR(CTRLX) THEN BEGIN I := 0;  IF FACTOR = 128 THEN FACTOR := 0 ELSE FACTOR := 128; ONEESC := (CH = ESC); IF ONEESC THEN GOTO 1; IF CH = C EXIT(INCOMMAND) END ELSE IF CH = ESC THEN BEGIN READ(KEYBOARD,CH); IF CH = ESC THEN EXIT(INCOMMAND); END; UHDEL THEN IF (I > 0) THEN BEGIN I := PRED(I); IF SLOW THEN IF WASBS THEN WRITE(OUTPUT,EXEC^[I]) ELSE WRINTIL FALSE ELSE IF NOT WARNED AND (CH = ACR) THEN BEGIN WRITELN(OUTPUT,'please finish',CHR(7)(* BELL *)); WARNED:=TTE(OUTPUT,'%',EXEC^[I]) ELSE IF EXEC^[I] = CHR(TAB) THEN FOR T := 1 TO 8 DO WRITE(OUTPUT,BACK) ELSE WRITE(OUTPUTRUE; END; READ(KEYBOARD,CH); IF EOLN(KEYBOARD) THEN CH := ACR; IF CH >= ' ' THEN CH := CHR(ORD(CH)+FACTOR) date> Read Save Unsave Verify'); WRITELN(OUTPUT,'Write eXchange ?elp'); WRITELN(OUTPUT,'Ctrl-X (,BACK,' ',BACK); END; IF (CH = CHR(CTRLU)) THEN BEGIN IF SLOW THEN WRITELN(OUTPUT,' BUFEND) THEN BEGIN WRITELN(OUTPUT,'''save'' area deleted.'); BUFEND := BUFSIZE; END;  END; WRITELN(OUTPUT,'$'); I:=I-1; END; FUNCTION COMMAND(*: BOOLEAN *); VAR RCOUNT:INTEGER; THISCH: CHAR; NEG:BARDEND := TRUE; CURSOR := 0; EXIT(FINDIT) END END ELSE BEGIN CURSOR := CURSOR + SCAN(ENDPOS-CURSOROOLEAN; NUMBER: SET OF '0'..'9'; PROCEDURE SYNTAX(ERRCH: CHAR); BEGIN WRITELN(OUTPUT,ERRCH,' : IS IN ERROR, COMMAND STOP+1,=FIRST,BUF^[CURSOR]); IF CURSOR >= ENDPOS THEN BEGIN HARDEND := TRUE; CURSOR := ENDPOS; EXIT(FINPED.'); EXIT(COMMAND); END; PROCEDURE LINEPLACE(VAR PTR: INTEGER; N: INTEGER); VAR I: INTEGER; BEGIN PTR := CURSOR; (* A DIT) END END; MOVELEFT(BUF^[CURSOR],QUESTION[1],SIZE); FOUND := (QUESTION = PATTERN); CURSOR := CURSOR +NICE PLACE TO START *) IF (N <= 0) THEN (* LOOK BACK *) BEGIN REPEAT PTR := PTR -1;  DIR UNTIL FOUND END (* FINDIT *); BEGIN IF RCOUNT < 0 THEN BEGIN RCOUNT := -RCOUNT; DIR := -1 END  I := SCAN(-(PTR+1),=ACR,BUF^[PTR]); PTR := PTR +I; N := SUCC(N); UNTIL (N > 0) OR (PTR < 0); PTR := SUCC ELSE DIR := 1; J := J+1; SIZE := 0; FIRST := EXEC^[J]; WHILE EXEC^[J +SIZE] <> ESC DO SIZE := SIZE +1; IF SIZE >= SI(PTR); END ELSE REPEAT I := SCAN(ENDPOS-PTR-1,=ACR,BUF^[PTR]); PTR := PTR+I+1; N := N -1; UNTIL (N=0) OR (PTR = ZEOF(PATTERN) THEN BEGIN WRITELN(OUTPUT,'Find too long'); EXIT(COMMAND) END; MOVELEFT(EXEC^[J],PATTERN[1],SIZE); PATTERNENDPOS); END; PROCEDURE DELETESTUFF; VAR COUNT: INTEGER; BEGIN IF (RCOUNT = 0) THEN BEGIN LINEPLACE(COUNT,0); [0] := CHR(SIZE); QUESTION[0] := CHR(SIZE); HARDEND := FALSE; FOUND := FALSE; REPEAT FINDIT;  RCOUNT := COUNT - CURSOR; END; COUNT:=CURSOR+RCOUNT; IF RCOUNT<0 THEN BEGIN IF COUNT<0 THEN COUNT := 0; M RCOUNT := RCOUNT -1 UNTIL (RCOUNT <= 0) OR HARDEND; IF HARDEND THEN BEGIN WRITELN(OUTPUT,PATTERN,' not found')OVELEFT(BUF^[CURSOR],BUF^[COUNT],ENDPOS-CURSOR+1); ENDPOS:=ENDPOS-(CURSOR-COUNT); CURSOR:=COUNT; END ELSE IF (CO; EXIT(COMMAND) END; IF DIR < 0 THEN CURSOR := CURSOR +1 ELSE CURSOR := CURSOR +SIZE -1; J := J +SIZE; EQUALLEUNT >= ENDPOS) OR (COUNT < 0) THEN BEGIN ENDPOS := CURSOR; BUF^[CURSOR] := CHR(0); END ELSE BEGIN MOVELNGTH := SIZE END (* GETTER *); PROCEDURE INSERTTEXT; VAR SIZEOVER: BOOLEAN; LENGTH,TEMP: INTEGER; BEGIN SIZEOVER := FALSE;EFT(BUF^[COUNT],BUF^[CURSOR],ENDPOS-COUNT+1); ENDPOS:=ENDPOS-(COUNT-CURSOR); END; END; PROCEDURE GETTER; VAR DIR,SIZE J := J+1; LENGTH := SCAN(I-J,=(ESC),EXEC^[J]); TEMP := ENDPOS+LENGTH; IF (TEMP > BUFSIZE) THEN BEGIN WRITELN(OH UM := ORD(EXEC^[J])-ORD('0'); IF (MACROS[MACNUM].EXEC = NIL) THEN BEGIN WRITELN(OUTPUT,'ILLEGAL MACRO...Try again'); EXIT(COMMAND) END; IF (MACNUM<0) OR (MACNUM > MAXMAC) THEN SYNTAX('#'); EXEC := MACROS[MACNUM].EXEC; I := MACRO MOVELEFT(BUF^[CURSOR],BUF^[POSITION],(ENDPOS-CURSOR+1)); ENDPOS := ENDPOS - (CURSOR - POSITION); CURSOR := CURS[MACNUM].LGTH; WHILE RCOUNT > 0 DO BEGIN RCOUNT := RCOUNT -1; IF COMMAND THEN BEGIN COMMAND := TRUE; ESOR - (CURSOR - POSITION); END ELSE BEGIN MOVELEFT(BUF^[POSITION],BUF^[CURSOR],(ENDPOS-POSITION+1)); ENDPOXIT(COMMAND) END; ERROR := (JMAXEND (* INSERT NEW TEXT *); PROCEDURE JUMP; BEGIN IF RCOUNT = 0 THEN LINEPLACE(CURSOR,0) ELSE CURSOR := CURSOR + RCOUNT; IMAC) THEN SYNTAX('#'); IF MACROS[RCOUNT].EXEC = NIL THEN NEW(MACROS[RCOUNT].EXEC); STOPCH := EXEC^[J+1]; LGTH := SCAN(I-J,F (CURSOR<0) AND (RCOUNT<0) THEN CURSOR := 0 ELSE IF (CURSOR<0) OR (CURSOR>ENDPOS) THEN CURSOR := ENDPOS; END; PROCEDURE =STOPCH,EXEC^[J+2]); IF (LGTH = (I-J)) OR (LGTH > SIZEOF(COMARRAY)) OR (LGTH = 0) THEN BEGIN WRITELN(OUTPUT,'Error iKILL; VAR POSITION:INTEGER; BEGIN LINEPLACE(POSITION,RCOUNT); IF RCOUNT<=0 THEN BEGIN n macro definition'); EXIT(COMMAND); END; MOVELEFT(EXEC^[J+2],MACROS[RCOUNT].EXEC^[0],LGTH);  FILLCHAR(MACROS[RCOUNT].EXEC^[LGTH+1],SIZEOF(COMARRAY)-LGTH,ESC); MACROS[RCOUNT].LGTH := LGTH; J := J+LGTH+2; END (* DEFINE MACRO *); PROCEDURE NOWEXECUTEMACRO; VAR SAVE: RECORD EXEC: ^COMARRAY; I,J: INTEGER END; MACNUM: INTEGER; ERROR: BOOLEAN; BEGIN J := J +1; SAVE.EXEC := EXEC; SAVE.I := I; SAVE.J := J; IF EXEC^[J] = ESC THEN MACNUM := 1 ELSE MACNI THEN BEGIN IF NEWFIN THEN EXIT(COMMAND) END ELSE BEGIN WRITELN(OUTPUT,'File: ',TITLE,' is in error. Not rea (TITLE[LGTH] <> ']') AND (POS('.TEXT',TITLE) = 0) THEN TITLE := CONCAT(TITLE,'.TEXT'); IF (TITLE[LGTH] = '.') THEN Dd'); EXIT(COMMAND); END; END END ELSE BEGIN WRITELN(OUTPUT,'File name error.'); EXIT(CELETE(TITLE,LGTH,1); OPENNEW(IOFILE,TITLE); IF IORESULT = 0 THEN NEWOUTLOOK ELSE BEGIN WRITELN(OUTPUT,COOMMAND); END; J := J +LGTH; END; PROCEDURE SAVE; VAR POS,DELTA: INTEGER; BEGIN LINEPLACE(POS,RCOUNT); NCAT('File: ',TITLE,' is in error. Write not done.')); EXIT(COMMAND); END; END ELSE BEGIN WRITELN(OUTPUT,'Illega IF RCOUNT <= 0 THEN DELTA := CURSOR -POS ELSE DELTA := POS -CURSOR; BUFEND := BUFSIZE -DELTA; IF BUFEND <= ENDPOl title'); EXIT(COMMAND); END; J := J +LGTH; END; BEGIN (*COMMAND*) COMMAND := FALSE; NUMBER := ['0'..'9']; J := S THEN BEGIN BUFEND := BUFSIZE; WRITELN(OUTPUT,'Not enough room to save in'); EXIT(COMMAND); END; IF0; WHILE (J 3200)); THISCH := EXEC^[J]; END(* IN NUMBER *) ELSE RCOUNT PROCEDURE OPTIONMOD; BEGIN WITH OPTION DO BEGIN ONOFF := NOT ONOFF; IF ONOFF THEN WITH SYSCOM^.CRTINFO DO HSIZE) < BUFEND) THEN BEGIN MOVERIGHT(BUF^[CURSOR],BUF^[STASHEDAT],STASHSIZE); MOVELEFT(BUF^[BUFEND],BUF^[CURSOR],DELTA);IF RCOUNT > 1 THEN LISTSIZE := RCOUNT ELSE LISTSIZE := HEIGHT DIV 2 -1 END END; PROCEDURE READFILE; VAR LGTH ENDPOS := ENDPOS +DELTA; BUF^[ENDPOS] := CHR(0) END ELSE BEGIN WRITELN(OUTPUT,'not enough space'); EXIT(COMMAND) : INTEGER; TITLE: STRING[40]; BEGIN J := J +1; LGTH := SCAN(30,=ESC,EXEC^[J]); IF (LGTH <= 30) AND (LGTH > 0) THEN BEND END (* ~=0 *) END (* UNSAVE *); PROCEDURE VIEW; BEGIN RCOUNT := 0; LIST; RCOUNT := 1; LIST END; EGIN TITLE[0] := CHR(LGTH); MOVELEFT(EXEC^[J],TITLE[1],LGTH); OPENOLD(IOFILE,TITLE); IF IORESULT = 0 THEPROCEDURE WRITEFILE; VAR LGTH: INTEGER; TITLE: STRING[40]; BEGIN J := J +1; LGTH := SCAN(30,=ESC,EXEC^[J]); IF (LGTH >N BEGIN IF NEWFIN THEN EXIT(COMMAND) END ELSE BEGIN OPENOLD(IOFILE,CONCAT(TITLE,'.TEXT')); IF IORESULT = 0  0) AND (LGTH <= 30) THEN BEGIN TITLE[0] := CHR(LGTH); MOVELEFT(EXEC^[J],TITLE[1],LGTH); IF (TITLE[LGTH] <> '.') ANDJ T := -RCOUNT; IF (J >= I) THEN EXIT(COMMAND); IF (THISCH IN ['?','A'..'Z','a'..'z']) THEN CASE THISCH OF '?'  : PROMPTS; 'a','A':LINEPLACE(CURSOR,RCOUNT); 'b','B':CURSOR:=0; (*DA END*) 'c','C':BEGIN DELETESTUFF; INSERTTEXT END;  'd','D':DELETESTUFF; 'e','E':CLEARSCREEN; 'G','F','f','g':GETTER; 'H','h':WRITELN(OUTPUT,'Unimplemented'); 'I','i': INSERTTEXT; 'J','j':JUMP; 'K','k':KILL; 'L','l':LIST; 'M','m': MACRODEFINITION; 'N','n': NOWEXECUTEMACRO;  'O','o': OPTIONMOD; 'p','t','y','z', 'P','T','Y','Z': SYNTAX(THISCH); 'Q','q': BEGIN THISCH := EXEC^[J+1]; CLOSETHEWORLD(THISCH); COMMAND := (THISCH IN ['E','e','U','u']); EXIT(COMMAND) END; 'R','r':READFILE; 'S','s':SAVE; 'U','u':UNSAVE; 'V','v':VIEW; 'W','w':WRITEFILE; 'X','x':BEGIN KILL; INSERTTEXT END END ELSE SYNTAX(THISCH); J:=J+1; END (* WHILE J <= I *); IF OPTION.ONOFF THEN BEGIN CLEARSCREEN; RCOUNT := -OPTION.LISTSIZ (*$S+*)  (**********************************************************************)  (* E; LIST; WRITE(OUTPUT,CHR(10 (* LF *))); RCOUNT := OPTION.LISTSIZE; LIST END; END (* COMMAND *); BE *)  (* Screen Oriented Editor Written: October 11, 1978 *)  (* ------ ------GIN (*EDITOR*) INITIALIZE; REPEAT WRITE(KEYBOARD,'*'); (*CLEARS ^F AND ^S FLAGS!*) (* this line is for the havaheart -- ------ Update : November 16, 1978 *)  (* _________ *)command * MOVELEFT(EXEC^,BUF^[ENDPOS+1],MIN(I,BUFEND-ENDPOS)); * which some day may be implemented *) INCOMMAND   (* By Richard S. Kaufmann, / \ *)  (* IIS := 1; IF (THISCH IN ['=','/']) THEN IF (RCOUNT <> 1) THEN SYNTAX(THISCH) ELSE BEGIN IF (THISCH = '=') THEN RCOUNUNTIL COMMAND; END; BEGIN (* JUST A DUMMY *) END. T := -EQUALLENGTH ELSE (* = '/' *) RCOUNT := 32700; J := J +1; THISCH := EXEC^[J] END; IF NEG THEN RCOUNO^K  FUNCTION SCREENHAS(WHAT: SCREENCOMMAND): BOOLEAN; FORWARD;  FUNCTION HASKEY(WHAT: KEYCOMMAND): BOOLEAN; FORWARD;  PROCEDURE; &IF COMMAND=SETC THEN ENVIRONMENT $ ELSE IF COMMAND=COPYC THEN COPYFILE $UNTIL COMMAND=QUITC; "UNTIL OUT; "SYSCOM^.MISC | Version | *)  (* University of California, San Diego | E.6e | *)  (* La Jolla CA 92093 E CONTROL(WHAT: SCREENCOMMAND); FORWARD;  PROCEDURE PUTMSG; FORWARD;  PROCEDURE HOME; FORWARD;  PROCEDURE ERRWAIT; FORWARD;  \_________/ *)  (* *)  (*  PROCEDURE BLANKCRT(Y: INTEGER); FORWARD;  FUNCTION LEADBLANKS(PTR:PTRTYPE;VAR BYTES: INTEGER): INTEGER; FORWARD;  PROCEDURE This version specially modified for HAZELTINE terminals that *)  (* emit a DLE as control code for NDFS. This is not theCENTERCURSOR(VAR LINE: INTEGER; LINESUP: INTEGER; NEWSCREEN:BOOLEAN); "FORWARD;  PROCEDURE FINDXY(VAR INDENT,LINE: INTEGER); F standard *)  (* release editor. *) ORWARD;  PROCEDURE SHOWCURSOR; FORWARD;  FUNCTION GETNUM: INTEGER; FORWARD;  PROCEDURE GETLEADING; FORWARD;  FUNCTION OKTO (* *)  (* Copyright (c) 1978, by The Regents of the UniDEL(CURSOR,ANCHOR:PTRTYPE):BOOLEAN; FORWARD;  PROCEDURE LINEOUT(VAR PTR:PTRTYPE; BYTES,BLANKS,LINE: INTEGER); FORWARD;  PROCEDversity of *)  (* California at San Diego *)  (* URE UPSCREEN(FIRSTLINE,WHOLESCREEN:BOOLEAN; LINE: INTEGER); FORWARD;  PROCEDURE READJUST(CURSOR: PTRTYPE; DELTA: INTEGER); FORW *)  (**********************************************************************)   (*$IARD;  PROCEDURE THEFIXER(PARAPTR: PTRTYPE;RFAC: INTEGER;WHOLE: BOOLEAN); FORWARD;  SOURCE:HEAD *)   (* Forward declared procedures.. all procedures are in MISC and UTIL *)   PROCEDURE ERROR(S:STRING;HOWBA PROCEDURE GETNAME(MSG:STRING; VAR M:NAME); FORWARD;   (*$I SOURCE:INIT *)  (*$I SOURCE:OUT *)  (*$I SOURCE:COPD:ERRORTYPE); FORWARD;  PROCEDURE ERASETOEOL(X,LINE:INTEGER); FORWARD;  FUNCTION GETCH:CHAR; FORWARD;  PROCEDURE CLEARSCREENYFILE *)  (*$I SOURCE:ENVIRON *)  (*$I SOURCE:PUTSYNTAX *)  (*$I SOURCE:COMMAND *)  (*$I SOURCE:INSERTIT *)  (*$I SOU; FORWARD;  PROCEDURE ERASEOS(X,LINE:INTEGER); FORWARD;  PROCEDURE CLEARLINE(Y:INTEGER); FORWARD;  FUNCTION MAPTOCOMMAND(CH:RCE:MOVEIT *)  (*$I SOURCE:FIND *)  (*$I SOURCE:USER *)  (*$I SOURCE:MISC *)  (*$I SOURCE:UTIL *)  CHAR): COMMANDS; FORWARD;  FUNCTION UCLC(CH:CHAR): CHAR; FORWARD;  PROCEDURE PROMPT; FORWARD;  PROCEDURE REDISPLAY; FORWARD; BEGIN (* Segment procedure EDITOR *) "INITIALIZE; GETLEADING; CURSOR:=MAX(CURSOR,STUFFSTART); "REPEAT $CENTERCURSOR(TRASH,(  FUNCTION MIN(A,B:INTEGER): INTEGER; FORWARD;  FUNCTION MAX(A,B:INTEGER): INTEGER; FORWARD; SCREENHEIGHT DIV 2)+1,TRUE); $NEEDPROMPT:=TRUE; $IF USERINFO.ERRBLK>0 THEN PUTSYNTAX; $REPEAT &HOME; CLEARLINE(0); &EDITCORL [J]; NEG := (THISCH = '-'); IF THISCH IN ['+','-'] THEN BEGIN J := J +1; THISCH := EXEC^[J] END; E; LIST; WRITE(OUTPUT,CHR(10 (* LF *))); RCOUNT := OPTION.LISTSIZE; LIST END; END (* COMMAND *); BE IF (THISCH IN NUMBER) THEN BEGIN RCOUNT := 0; REPEAT RCOUNT := (RCOUNT*10) + ORD(EXEC^[J])-ORD('0'); J :=GIN (*EDITOR*) INITIALIZE; REPEAT WRITE(KEYBOARD,'*'); (*CLEARS ^F AND ^S FLAGS!*) (* this line is for the havaheart  SUCC(J) UNTIL ((NOT (EXEC^[J] IN NUMBER)) OR (RCOUNT > 3200)); THISCH := EXEC^[J]; END(* IN NUMBER *) ELSE RCOUNT command * MOVELEFT(EXEC^,BUF^[ENDPOS+1],MIN(I,BUFEND-ENDPOS)); * which some day may be implemented *) INCOMMAND := 1; IF (THISCH IN ['=','/']) THEN IF (RCOUNT <> 1) THEN SYNTAX(THISCH) ELSE BEGIN IF (THISCH = '=') THEN RCOUNUNTIL COMMAND; END; BEGIN (* JUST A DUMMY *) END. INFO.NOBREAK := FALSE (* 28 SEPT 77*)  END;   BEGIN END. T := -EQUALLENGTH ELSE (* = '/' *) RCOUNT := 32700; J := J +1; THISCH := EXEC^[J] END; IF NEG THEN RCOUNT := -RCOUNT; IF (J >= I) THEN EXIT(COMMAND); IF (THISCH IN ['?','A'..'Z','a'..'z']) THEN CASE THISCH OF '?' PROCEDURE WRITEFILE; VAR LGTH: INTEGER; TITLE: STRING[40]; BEGIN J := J +1; LGTH := SCAN(30,=ESC,EXEC^[J]); IF (LGTH >: PROMPTS; 'a','A':LINEPLACE(CURSOR,RCOUNT); 'b','B':CURSOR:=0; (*DA END*) 'c','C':BEGIN DELETESTUFF; INSERTTEXT END;  0) AND (LGTH <= 30) THEN BEGIN TITLE[0] := CHR(LGTH); MOVELEFT(EXEC^[J],TITLE[1],LGTH); IF (TITLE[LGTH] <> '.') AND 'd','D':DELETESTUFF; 'e','E':CLEARSCREEN; 'G','F','f','g':GETTER; 'H','h':WRITELN(OUTPUT,'Unimplemented'); 'I','i' (TITLE[LGTH] <> ']') AND (POS('.TEXT',TITLE) = 0) THEN TITLE := CONCAT(TITLE,'.TEXT'); IF (TITLE[LGTH] = '.') THEN D: INSERTTEXT; 'J','j':JUMP; 'K','k':KILL; 'L','l':LIST; 'M','m': MACRODEFINITION; 'N','n': NOWEXECUTEMACRO; ELETE(TITLE,LGTH,1); OPENNEW(IOFILE,TITLE); IF IORESULT = 0 THEN NEWOUTLOOK ELSE BEGIN WRITELN(OUTPUT,CO 'O','o': OPTIONMOD; 'p','t','y','z', 'P','T','Y','Z': SYNTAX(THISCH); 'Q','q': BEGIN THISCH := EXEC^[J+1]; CNCAT('File: ',TITLE,' is in error. Write not done.')); EXIT(COMMAND); END; END ELSE BEGIN WRITELN(OUTPUT,'IllegaLOSETHEWORLD(THISCH); COMMAND := (THISCH IN ['E','e','U','u']); EXIT(COMMAND) END; 'R','r':READFILE; 'S','s':SAVl title'); EXIT(COMMAND); END; J := J +LGTH; END; BEGIN (*COMMAND*) COMMAND := FALSE; NUMBER := ['0'..'9']; J := E; 'U','u':UNSAVE; 'V','v':VIEW; 'W','w':WRITEFILE; 'X','x':BEGIN KILL; INSERTTEXT END END ELSE SYNTAX(THISCH0; WHILE (J