					      (*

 (c) Copyright Hewlett-Packard Company, 1985,1991.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$copyright 'COPYRIGHT (C) 1985,1991 BY HEWLETT-PACKARD CO.'$
$debug off$
$heap_dispose off$
$ovflcheck off$
$iocheck off$
$range off$
$REF 50$
$MODCAL$
$UCSD$

PROGRAM EDTR(input, output, keyboard);

module edit1;
$SEARCH 'INIT:CONVERT'$
import
  sysglobals,
  sysdevs,
  ci,
  misc,
  fs,
  convert_text;

export

CONST
  (* Unless otherwise noted all constants are upper bounds from zero. *)

  editversion   = '[3.25]';
  editdate      = '28-Oct-91';
  MAXBUFSIZE    = 8388607; (* 2^23-1  *)
  MAXSW         = 132; (* Maximum allowable SCREENWIDTH *)
  MAXSTRING     = 127;
  MAXCHAR       = pagesize-1;
  MAXPAGE       = mmaxint;
 {pagesize      = 1024; }

  (* The following ASCII characters are hard-wired in *)
  HT            = 9;
  SP            = 32;
  DC1           = 17;
  RUBOUT        = 127;

TYPE
  EPTRTYPE      = 0..MAXBUFSIZE;
  BUFRTYPE      = PACKED ARRAY [0..maxint] OF CHAR;
  BLOCKTYPE     = PACKED ARRAY [0..FBLKSIZE] OF CHAR;
  ERRORTYPE     = (FATAL,NONFATAL);
 {pagebuftype   =  packed array[0..pagesize-1] of char; }
  PAGE          = 0..MAXPAGE;
  NAME          = PACKED ARRAY [1..8] OF CHAR;
  PTYPE         = PACKED ARRAY [0..MAXSTRING] OF CHAR;
  COMMANDS      =
	   (ILLEGAL,ADJUSTC,COPYC,DELETEC,FINDC,INSERTC,JUMPC,LISTC,MACRODEFC,
	    PARAC,QUITC,REPLACEC,SETC,VERIFYC,XECUTEC,ZAPC,REVERSEC,FORWARDC,UP,
	    DOWN,LEFT,RIGHT,TABB,DIGIT,DUMPC,ADVANCE,SPACE,EQUALC,SLASHC);

  CTYPE         = (FSS,GOHOME,ETOEOL,ETOEOS,USS);
  SCREENCOMMAND  =(WHOME,ERASEEOS,ERASEEOL,CLEARLNE,CLEARSCN,UPCURSOR,
		   DOWNCURSOR,LEFTCURSOR,RIGHTCURSOR);
  KEYCOMMAND    = (BACKSPACEKEY,DC1KEY,EOFKEY,ETXKEY,ESCAPEKEY,DELKEY,UPKEY,
		   DOWNKEY,LEFTKEY,RIGHTKEY,NOTLEGAL);

  HEADER        =    (* Page Zero layout changed 22-JUN-78 *)
    RECORD CASE BOOLEAN OF
      TRUE: (BUF: pagebuftype);
      FALSE:(dummy1: char;   {needed to get alignment compatibility}
	     DEFINED:    BOOLEAN; (* New file nulls => false *)
	     COUNT:      shortint;  (* The count of valid markers *)
	     NAME:       ARRAY [0..9] OF NAME;
	     POFFSET:    PACKED ARRAY [0..29] OF byte;
	     dummy2: char;
	     AUTOINDENT: BOOLEAN; (* Environment stuff follows *)
	     dummy3: char;
	     FILLING:    BOOLEAN;
	     dummy4: char;
	     TOKDEF:     BOOLEAN;
	     LMARGIN:    0..MAXSW;
	     RMARGIN:    0..MAXSW;
	     PARAMARGIN: 0..MAXSW;
	     dummy5:char;
	     RUNOFFCH:   CHAR;
	     CREATED:    DATEREC;
	     LASTUSED:   DATEREC;
	     newmarkers: boolean;
	     ignorecase: boolean;
	     FILLER:     PACKED ARRAY [0..887] OF CHAR)
    END;

    {crtword=packed record                              defined in KBD
	     upperbyte,character:char;
	 end;
    }
    scrtype=packed array[0..0] of crtword;
    scrptr=^scrtype;



VAR
  tempior       : integer;
  generrmsg     : string80;
  efilename     : fid;                  (* 'No file present' filename  dst 01/80 *)
  efilekind     : filekind;             (* file type of last file read in *)
  CURSOR        : 0..MAXBUFSIZE;
  BUFCOUNT      : 0..MAXBUFSIZE;        (* Number of valid characters in the EBUF *)
  STUFFSTART    : 0..MAXBUFSIZE;        (* GETLEADING            *)
  LINESTART     : EPTRTYPE;             (*            sets       *)
  BYTES         : INTEGER;              (*                 these *)
  BLANKS        : INTEGER;              (*                 these *)
  CH            : CHAR;
  DIRECTION     : CHAR;                 (* '>' or '<' *)
  REPEATFACTOR  : INTEGER;
  BUFSIZE       : INTEGER;
  SCREENWID     : INTEGER;              (* Moved to var 26-Jan *)
  SCREENHITE    : INTEGER;              (*   "    "  "    "    *)
  ECOMMAND      : COMMANDS;
  LASTPAT       : 0..MAXBUFSIZE;
  EBUF          : ^BUFRTYPE;
  KIND          : ARRAY [CHAR] OF INTEGER;      (* for token find *)
  LINE1PTR      : 0..MAXBUFSIZE;
  MIDDLE        : INTEGER;              (* Middle line on the screen *)
  NEEDPROMPT    : boolean;
  prompt2flag   : boolean;              {  7 Apr 80 - MCh: second prompt line }
  recovering    : boolean;              { 19 May 80 - MCh: recover text after error }
  updated       : boolean;              (*  WAH to decide if need  update 4/14/80 *)
  bufovflw      : boolean;              { used if buffer overflow on reading input}
  inreaderror   : boolean;              { used if error on reading input }
  out           : boolean;              { result of procedure do_out }
  ETXX          : INTEGER;
  BSS           : INTEGER;
  DELL          : INTEGER;
  ESCC          : INTEGER;
  BSPCE         : INTEGER;              (* Moved from CONST 30-Jan-78 BSPCE: 11/2/78*)
  ADJUSTPROMPT  : STRING80;             { MCh }
  INSERTPROMPT  : STRING80;             { MCh }
  DELETEPROMPT  : STRING80;             { MCh }
  COMPROMPT     : STRING80;             { MCh }
  prompt2       : STRING80;             {Promptline  11/2/78 M. Bernard}
  TRASH         : INTEGER;              (* Totally without redeeming social value *)
  TARGET        : PTYPE;
  SUBSTRING     : PTYPE;
  SLENGTH       : INTEGER;              (* Length of target and substring *)
  TLENGTH       : INTEGER;
  SDEFINED      : BOOLEAN;              (* Whether the strings are valid *)
  TDEFINED      : BOOLEAN;
  COPYLENGTH    : EPTRTYPE;             (* For Copyc *)
  COPYSTART     : EPTRTYPE;             (* For Copyc *)
  COPYLINE      : BOOLEAN;              (*    "       WAH 1/18/80*)
  COPYOK        : BOOLEAN;              (*    "       WAH 1/18/80*)
  iflag         : BOOLEAN;              (*    "       WAH 1/18/80*)
  INFINITY      : BOOLEAN;              (* for slashc *)
  TRANSLATE     : ARRAY [CHAR] OF COMMANDS;
  PAGEZERO      : HEADER;
  MSG           : STRING80;
  PROMPTLINE    : STRING80;
  BLANKAREA     : ARRAY [0..MAXSW] OF CHAR;
  SAVETOP       : STRING80;             (* Dumb terminal patch - for BLANKCRT(1) *)
  SCREENN       : PACKED RECORD         (* Screen Control Record *)
		    PREFIX: CHAR;
		    HEIGHT,WIDTH: byte;
		    CANUPSCROLL,CANDOWNSCROLL,SLOW: BOOLEAN;
		    HASPREFIX: PACKED ARRAY [SCREENCOMMAND] OF BOOLEAN;
		    CH:        PACKED ARRAY [SCREENCOMMAND] OF CHAR
		  END;
  KEYBRD        : PACKED RECORD         (* Keyboard Control Record *)
		    PREFIX: CHAR;
		    HASPREFIX: PACKED ARRAY [KEYCOMMAND] OF BOOLEAN;
		    CH:        PACKED ARRAY [KEYCOMMAND] OF CHAR
		  END;
screenm         : scrptr;
tscreenwidth    : integer;
tscreenheight   : integer;
tscreensize     : integer;
vstr            : vid;
pstr            : fid;
nstr            : tid;

entkey          : string[6];            { 3.0 ITF fixes 4/6/84}
exckey          : string[6];            { 3.0 ITF fixes 4/6/84}
esckey          : string[6];            { 3.0 ITF fixes 4/6/84}

function fatalifstreaming : errortype;
function oktostop : boolean;
procedure initialize;
procedure do_out;
PROCEDURE ERROR(S:STRING80;HOWBAD:ERRORTYPE);
PROCEDURE ERASETOEOL(X,LINE:INTEGER);
FUNCTION  GETCH:CHAR;
PROCEDURE ECLEARSCREEN;
PROCEDURE EERASEOS(X,LINE:INTEGER);
PROCEDURE ECLEARLINE(Y:INTEGER);
FUNCTION  MAPTOCOMMAND(CH:CHAR): COMMANDS;
FUNCTION  UCLC(CH:CHAR): CHAR;
PROCEDURE EPROMPT;
PROCEDURE REDISPLAY;
FUNCTION  MIN(A,B:INTEGER): INTEGER;
FUNCTION  MAX(A,B:INTEGER): INTEGER;
FUNCTION  SCREENHAS(WHAT: SCREENCOMMAND): BOOLEAN;
PROCEDURE CONTROL(WHAT: SCREENCOMMAND);
PROCEDURE PUTMSG;
PROCEDURE HOME;
PROCEDURE ERRWAIT;
PROCEDURE BLANKCRT(Y: INTEGER);
FUNCTION  LEADBLANKS(PTR:EPTRTYPE;VAR BYTES: INTEGER): INTEGER;
PROCEDURE CENTERCURSOR(VAR LINE: INTEGER; LINESUP: INTEGER; NEWSCREEN:BOOLEAN);

PROCEDURE FINDXY(VAR INDENT,LINE: INTEGER);
PROCEDURE actualXY(VAR INDENT,LINE: INTEGER);  { NEW FOR 3.0 bug #7 }
PROCEDURE SHOWCURSOR;
FUNCTION  GETNUM: INTEGER;
PROCEDURE GETLEADING;
FUNCTION  OKTODEL(CURSOR,ANCHOR:EPTRTYPE):BOOLEAN;
PROCEDURE LINEOUT(VAR PTR:EPTRTYPE; BYTES,BLANKS,LINE: INTEGER);
PROCEDURE UPSCREEN(FIRSTLINE,WHOLESCREEN:BOOLEAN; LINE: INTEGER);
PROCEDURE READJUST(CURSOR: EPTRTYPE; DELTA: INTEGER);
PROCEDURE THEFIXER(PARAPTR: EPTRTYPE;RFAC: INTEGER;WHOLE: BOOLEAN);
PROCEDURE GETNAME(MSG:STRING80; VAR M:NAME);
PROCEDURE ENVIRONMENT;
PROCEDURE COPYFILE;
procedure dodownscroll;
procedure doupscroll;
procedure movetobuf(cursor,anchor: eptrtype);

implement

function fatalifstreaming : errortype;
begin
  if streaming then
    fatalifstreaming := fatal
  else
    fatalifstreaming := nonfatal;
end;

function oktostop : boolean;
begin
  eclearscreen;
  writeln(output);
  fgotoxy(output,0,9);
  writeln('Are you sure you want to STOP without updating?');
  writeln('     Type Yes  to STOP Without Update');
  writeln('     Type No   to Return to Editor');
  repeat
    ch := uclc(getch);
  until ch in ['Y','N'];
  oktostop := ch = 'Y';
end;

procedure dodownscroll;
begin
  moveright(screenm^[tscreenwidth{1,0}],
	    screenm^[tscreenwidth*2{2,0}],
	    (tscreensize-2*tscreenwidth)*2);
end;

procedure doupscroll;
var i:integer;
begin
  moveleft(screenm^[tscreenwidth*2{2,0}],
	    screenm^[tscreenwidth{1,0}],
	    (tscreensize-2*tscreenwidth)*2);
  for i:=0 to tscreenwidth-1 do
    screenm^[(tscreenheight-1)*tscreenwidth+i].wholeword := ord(' ');
end;

PROCEDURE INITIALIZE;
LABEL 1;
VAR
  BLOCK: ^BLOCKTYPE;
  CH: CHAR;
  I,QUIT,GAP,BLKS: INTEGER;
  workopenfailed: boolean;
  THEFILE: text;

PROCEDURE MAP(CH:CHAR; C:COMMANDS);
BEGIN
  TRANSLATE[CH]:=C;
  IF CH IN ['A'..'Z'] THEN
    TRANSLATE[CHR(32+ORD(CH))] := C; (* LC TOO *)
END;

PROCEDURE DEFPROMPTS; (* DEFINES VARIABLE PROMPTLINES MAB 11/2/78*)
BEGIN
  { 7 Apr 80 - MCh: added 'prompt2' for second prompt line }
  COMPROMPT:=
' Edit: Adjst  Cpy  Dlete  Find  Insrt  Jmp  Rplace  Quit  Xchng  Zap ?';
  prompt2 :=
' Edit: Margin  Page  Set environment  Verify ?                     ';
  prompt2:=prompt2+editversion;
  INSERTPROMPT:=
  ' Insert: Text <bs>, <clr ln>   [<'+exckey+'> accepts, <'
	  +esckey+'> escapes]';                         { 3.0 ITF fix }
  DELETEPROMPT:=
  ' Delete: < > <Moving commands> [<'+exckey+'> deletes, <'
	  +esckey+'> aborts]';                          { 3.0 ITF fix }
  ADJUSTPROMPT:=
  ' Adjust: Ljust Rjust Center <arrow keys> [<'+exckey+'> to leave]';
							{ 3.0 ITF fix }
  IF (SCREENWID+1)<STRLEN(COMPROMPT) THEN
  BEGIN
    INSERTPROMPT:=' Insrt:<bs><clr ln> <'+exckey+'> accepts,<'
		    +esckey+'> aborts';                 { 3.0 ITF fix }
    DELETEPROMPT:=' Del: <arrow keys> <'+exckey+'> deletes,<'
		    +esckey+'> aborts';                 { 3.0 ITF fix }
    ADJUSTPROMPT:=' Adjst: Lft Rt Ctr <arrow keys> <'+exckey+'> leaves';
							{ 3.0 ITF fix }
    COMPROMPT:=   ' Edit: Adj Cpy Del Find Insrt Jmp Rpl Quit Xch ?';
    prompt2:=  ' Edit: Mrgn Page Set Vrfy Zap ? ';
    prompt2:=prompt2+editversion;
  END;
END;

PROCEDURE READFILE;
var  pages,
     NOTNULS: integer;
     pagebuffer: pagebuftype;
     OVFLW, DONE: BOOLEAN;
     readerror  : BOOLEAN;
BEGIN
  readerror := false;
  ECLEARSCREEN;          (* Dumb terminal patch *)
  WRITE(output,'Reading');
  WITH USERINFO^, fibp(addr(THEFILE))^ do
   begin
     if fkind = textfile then
       begin
	 am := amtable^[untypedfile];             {FORCE NO INTERPRETATION OF BITS}
	 fleof := fleof + (-fleof) mod pagesize;  {to allow reading 1.0 text files}
	 freadbytes(THEFILE, PAGEZERO, pagesize);
	 if ioresult <> ord(inoerror) then
	   begin
	     tempior := ioresult;
	     readerror := true;
	     fillchar(PAGEZERO, pagesize, chr(0));
	   end
	 else
	   WRITE(output,'.');
       end
     else fillchar(PAGEZERO, pagesize, chr(0));
   pages := 0;
   ovflw := false;      done := false;
   if not readerror then
     repeat
      if fkind = textfile
	then if fpos >= fleof then done := true
	     else freadbytes (THEFILE, pagebuffer, pagesize)
	else if eof(THEFILE) then done := true
	     else any_to_UCSD(THEFILE, pagebuffer);
      if ioresult <> ord(inoerror) then
	begin
	  tempior := ioresult;
	  readerror := true;
	end
      else
	if not done then
	  begin
	    pages:=pages+1;
	    WRITE(output,'.');
	    IF pages*2 = ERRBLK THEN CURSOR:=BUFCOUNT+ERRSYM; (* errblk > 0 only *)
	    NOTNULS:=SCAN(-pagesize,<>CHR(0),pagebuffer[maxchar])+pagesize;
	    OVFLW := NOTNULS+BUFCOUNT>=BUFSIZE-10;
	    IF NOT OVFLW THEN
	      BEGIN
		moveleft(pagebuffer, EBUF^[BUFCOUNT], NOTNULS);
		BUFCOUNT:=BUFCOUNT+NOTNULS;
	      END;
	  end;
     until done or ovflw or readerror;
   end;
  if readerror then
    begin
      getioerrmsg(generrmsg,tempior);
      error(generrmsg,fatalifstreaming);
    end
  else
    IF ovflw THEN ERROR('Buffer overflow.',fatalifstreaming);
  bufovflw:=ovflw;  { set global overflow flag }
  inreaderror := readerror;
  close (thefile)   { no need to keep it open }
END;   { readfile }

PROCEDURE LOADFROMSYSCOM;
(* A rather perverted procedure that takes the syscom^.crtcntrl record
   and loads it into the Screen Control Record and the syscom^.crtinfo
   record and loads it into the Keyboard Control Record *)
BEGIN

  WITH SYSCOM^ DO
    BEGIN

      (* Miscellaneous stuff *)

      WITH SCREENN DO
	BEGIN
	  PREFIX:=CRTCTRL.ESCAPE;
	  HEIGHT:=CRTINFO.HEIGHT-2;{WAH 4/17/80}
	  WIDTH:=CRTINFO.WIDTH-1; { jws 11/25/80  kluge for chipmunk screen }
	  CANUPSCROLL:=TRUE; CANDOWNSCROLL:=syscom^.miscinfo.candownscroll;
	END;

      KEYBRD.PREFIX := CRTINFO.PREFIX;

      (* The screen ... *)

	  SCREENN.CH[ERASEEOS]          := CRTCTRL.ERASEEOS;
	  SCREENN.HASPREFIX[ERASEEOS]   := CRTCTRL.PREFIXED[3];

	  SCREENN.CH[ERASEEOL]          := CRTCTRL.ERASEEOL;
	  SCREENN.HASPREFIX[ERASEEOL]   := CRTCTRL.PREFIXED[2];

      with screenn, crtctrl do
	begin
	  CH[WHOME]                     := HOME;
	  HASPREFIX[WHOME]              := PREFIXED[4];

	  CH[CLEARLNE]                  := CLEARLINE;
	  HASPREFIX[CLEARLNE]           := PREFIXED[7];

	  CH[CLEARSCN]                  := CLEARSCREEN;
	  HASPREFIX[CLEARSCN]           := PREFIXED[6];

	  CH[UPCURSOR]                  := RLF;
	  HASPREFIX[UPCURSOR]           := PREFIXED[0];

	  CH[DOWNCURSOR]                := CHR(LF);
	  HASPREFIX[DOWNCURSOR]         := FALSE;

	  CH[LEFTCURSOR]                := BACKSPACE;
	  HASPREFIX[LEFTCURSOR]         := PREFIXED[1];

	  CH[RIGHTCURSOR]               := NDFS;
	  HASPREFIX[RIGHTCURSOR]        := PREFIXED[8];
	end;

      (* ... and the keyboard *)

      with keybrd, crtinfo do
	begin
	  CH[BACKSPACEKEY]              := BACKSPACE;
	  HASPREFIX[BACKSPACEKEY]       := PREFIXED[12];

	  CH[DC1KEY]                    := CHR(DC1); (* Not in record *)
	  HASPREFIX[DC1KEY]             := FALSE;

	  CH[EOFKEY]                    := EOF;
	  HASPREFIX[EOFKEY]             := PREFIXED[9];

	  CH[ETXKEY]                    := ETX;
	  HASPREFIX[ETXKEY]             := PREFIXED[13];

	  CH[ESCAPEKEY]                 := ALTMODE;
	  HASPREFIX[ESCAPEKEY]          := PREFIXED[10];

	  CH[DELKEY]                    := LINEDEL;
	  HASPREFIX[DELKEY]             := PREFIXED[11];

	  CH[UPKEY]                     := UP;
	  HASPREFIX[UPKEY]              := PREFIXED[3];

	  CH[DOWNKEY]                   := DOWN;
	  HASPREFIX[DOWNKEY]            := PREFIXED[2];

	  CH[LEFTKEY]                   := LEFT;
	  HASPREFIX[LEFTKEY]            := PREFIXED[1];

	  CH[RIGHTKEY]                  := RIGHT;
	  HASPREFIX[RIGHTKEY]           := PREFIXED[0];
	end;

      BSPCE:=ORD(CRTINFO.BACKSPACE);  {Went soft 11/2/78 M. Bernard}

      {Now test to see that the essential keys have been given a
       value other than null.  If not then assign them a default
       value.  Hopefully, this will end up an INTERP change--M. Bernard}

       IF BSPCE = 0 THEN BSPCE := 8;
       IF KEYBRD.CH[ETXKEY]=CHR(0) THEN KEYBRD.CH[ETXKEY]:=CHR(3);


    END;
END;

PROCEDURE MAPSPECIAL(K:KEYCOMMAND;C:COMMANDS);
BEGIN
  IF NOT KEYBRD.HASPREFIX[K] THEN MAP(KEYBRD.CH[K],C);
END;

BEGIN    { MAIN BODY OF INITIALIZE }
  bufovflw      := false;
  inreaderror   := false;
  out           := false;
  updated := false;  {no file updates yet WAH 4/14/80}

  if kbdtype=itfkbd then begin                   { 3.0 ITF fix 4/6/84}
    entkey:='ret';                               { 3.0 ITF fix 4/6/84 }
    exckey:='sel';                               { 3.0 ITF fix 4/6/84 }
    esckey:='esc';                               { 3.0 ITF fix 4/6/84 }
  end                                            { 3.0 ITF fix 4/6/84 }
  else begin                                     { 3.0 ITF fix 4/6/84 }
    entkey:='ent';                               { 3.0 ITF fix 4/6/84 }
    exckey:='exc';                               { 3.0 ITF fix 4/6/84 }
    esckey:='sh-exc';                            { 3.0 ITF fix 4/6/84 }
  end;                                           { 3.0 ITF fix 4/6/84 }

  WITH PAGEZERO DO
    BEGIN

      (* Load Screen and Keyboard Control Records from SYSCOM *)

      LOADFROMSYSCOM;


      (* Init the translate table *)

      for ch:= chr(0) to chr(255) do
	 translate[ch]:=illegal;

      MAP('A',ADJUSTC);   MAP('C',COPYC);     MAP('D',DELETEC);
      MAP('F',FINDC);     MAP('I',INSERTC);   MAP('J',JUMPC);
      MAP('L',LISTC);     MAP('M',MACRODEFC); MAP('P',PARAC);
      MAP('Q',QUITC);     MAP('R',REPLACEC);  MAP('S',SETC);
      MAP('V',VERIFYC);   MAP('X',XECUTEC);   MAP('Z',ZAPC);
      MAP(',',REVERSEC);  MAP('>',FORWARDC);  MAP('.',FORWARDC);
      MAP('+',FORWARDC);  MAP('-',REVERSEC);  MAP('?',DUMPC);
      MAP('/',SLASHC);    MAP('=',EQUALC);    MAP('<',REVERSEC);


      (* Arrows *)

      (* NEXTCOMMAND and GETNUM handle VT-52 style vector keys *)
      if syscom^.crtctrl.escape=chr(0) then
      WITH syscom^ DO
	BEGIN
	  MAP(crtinfo.up,UP); MAP(crtinfo.DOWN,DOWN);
	  MAP(crtinfo.LEFT,LEFT); MAP(crtinfo.RIGHT,RIGHT);
	END;
      map(syscom^.crtinfo.chardel, left);
      MAP(EOL,ADVANCE); (* CR IS ADVANCE *)
      MAP(CHR(HT),TABB);
      MAP(CHR(SP),SPACE);


      (* Digits *)

      FOR CH:='0' TO '9' DO MAP(CH,DIGIT);

      (* Variable buffer sizing... added 17-Jan-78 *)

      blks:=(memavail div pagesize)-5;  {the 5 pages is a guess for stack size}
      newwords(ebuf, blks*(pagesize div 2));
      bufsize:=blks*pagesize-1;

      (* Open the workfile *)

      setstrlen(efilename,0);
      EBUF^[0]:=EOL;
      BUFCOUNT:=1;
      CURSOR:=1;
      ECLEARSCREEN;
      DIRECTION:='>';   {must be initialized now for display in ERROR}
      writeln;
      WRITELN(output,'Editor  [Rev.  ',
		     str(editversion,2,strlen(editversion)-2),
		     ' ',editdate,']');
      writeln;
      writeln('Copyright Hewlett-Packard Company, 1982, 1991.');
      writeln('           All rights reserved.');
      writeln;
      workopenfailed:=false;
      IF (USERINFO^.GOTSYM) or (userinfo^.errnum<>0) THEN
	BEGIN
	  if userinfo^.errnum = 0 then
	    RESET(THEFILE,USERINFO^.SYMFID,'shared')
	  else
	    begin
	      RESET(THEFILE,USERINFO^.ERRFID,'shared');
	      with userinfo^ do
		if not(gotsym and (errfid=symfid)) then efilename:=errfid;
	    end;
	  IF IORESULT<>ord(inoerror) THEN
	    begin
	      tempior := ioresult;
	      getioerrmsg(generrmsg,tempior);
	      writeln(output,'Error: ',generrmsg);
	      if streaming then ERROR('Workfile lost.',FATAL)
	      else
		begin
		  workopenfailed:=true;
		  writeln(output,'Failed to open workfile.');
		  msg:='File? (<'+entkey+'> for new file, <stop> exits)';
						       { 3.0 ITF fix }
		end;
	    end;
	END;
      if not((USERINFO^.GOTSYM) or (userinfo^.errnum<>0)) or workopenfailed then
	BEGIN
	  if not((USERINFO^.GOTSYM) or (userinfo^.errnum<>0)) then
	    begin
	      writeln(output,'No workfile found.');
	      MSG:='File? (<'+entkey+'> for new file, <stop> exits) ';
						       {3.0 ITF fix }
	    end;
	  REPEAT
	    WRITELN(output,MSG);
	    WRITE(output,': ');
	    READLN(INPUT,EFILENAME);
	    if strlen(efilename) > 0 then
	      for i := 1 to strlen(efilename) do  {RAM 15JAN82}
		IF EFILENAME[i]=SYSCOM^.CRTINFO.ALTMODE THEN escape(101);
	    fixname(efilename,textfile);
	    IF STRLEN(EFILENAME)=0 THEN
	      BEGIN
		fillchar(PAGEZERO, SIZEOF(PAGEZERO), chr(0));
		GOTO 1;
	      END;
	    reset(THEFILE,EFILENAME,'shared');{WAH 4/17/80}
	    tempior := ioresult;
	    if tempior <> ord(inoerror) then
	      begin
		writeln('File: ',efilename);
		getioerrmsg(generrmsg,tempior);
		MSG:='Error: '+ generrmsg + '. File? ';
		if streaming then
		  begin
		    writeln(output,msg);
		    escape(-1);
		  end;
	      end;
	  UNTIL tempior=ord(inoerror);
	END;

      fstripname(efilename,vstr,pstr,nstr);
      if ioresult = ord(inoerror) then
	efilekind := fibp(addr(THEFILE))^.fkind
      else
	begin
	  setstrlen(efilename,0);
	  setstrlen(vstr,0);
	  setstrlen(pstr,0);
	  setstrlen(nstr,0);
	end;

      READFILE;                                         (* Read in the file *)

   1: IF (EBUF^[BUFCOUNT-1]<>EOL) OR (BUFCOUNT=1) THEN
	BEGIN
	  EBUF^[BUFCOUNT]:=EOL;
	  BUFCOUNT:=BUFCOUNT+1;
	END;
      i:=1;   { remove form feeds.. mod 12/21/81 jws }
      while i<bufcount do
	begin
	  i:=i+scan(bufcount-i, =chr(12), ebuf^[i]);
	  if i<bufcount then ebuf^[i]:=chr(32);
	end;


      (* Initialize everything else! *)

      LASTPAT:=1; (* Init to the beginning of the buffer (for equalc) *)
      COPYOK:=FALSE;
      LINE1PTR:=1;
      (* These do not yet go through the Screen and Keyboard control
	 records *)
      WITH SYSCOM^.CRTINFO DO
	BEGIN
	  ESCC:=ORD(ALTMODE);
	  BSS:=ORD(CHARDEL);
	  DELL:=ORD(LINEDEL);
	  SCREENWID:=WIDTH-2;{ changed to 2 11/25/80 jws -- chipmunk kluge}
	  SCREENHITE:=HEIGHT-1;
	  tscreenwidth:=width;
	  tscreenheight:=height;
	  tscreensize:=width*height;
	  screenm:=anyptr(crtmemaddr);
	  MIDDLE:=(SCREENHITE DIV 2) + 1;
	END;
      ETXX:=ORD(KEYBRD.CH[ETXKEY]); {Changed from SYSCOM assignment 11/2/78 MAB}
      MAP(CHR(BSS),LEFT);                     (* Map backspace key for now *)
      SYSCOM^.MISCINFO.NOBREAK := TRUE;
      {Including the command prompt line}
      DEFPROMPTS;
      SDEFINED:=FALSE; (* No substring or target *)
      TDEFINED:=FALSE;
      WITH PAGEZERO DO
	IF (NOT DEFINED)
	or (count > 10)         {pagezero looks like garbage}
	or (count < 0)
	or (lmargin > rmargin)
	or (created.year > lastused.year)
	THEN
	  BEGIN
	    fillchar(BUF,pagesize, chr(0));
	    SYSDATE(CREATED); LASTUSED:=CREATED;
	    TOKDEF:=TRUE; (* Default mode is T(oken *)
	    FILLING:=FALSE; AUTOINDENT:=TRUE; RUNOFFCH:='^';
	    LMARGIN:=0; PARAMARGIN:=5; RMARGIN:=MIN(78,SCREENWID);
	    DEFINED:=TRUE;
	    newmarkers:=true;
	    ignorecase:=false;
	  END
	else if not newmarkers then
	  begin
	    count:=0;
	    newmarkers:=true;
	    name[0]:='        ';
	 end;
    END(* WITH *);


  (* Initialize the KIND array for token find *)

  FOR CH:=CHR(0) TO CHR(255) DO KIND[CH]:=ORD(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 CH:='0' TO '9' DO KIND[CH]:=ORD('A');
  KIND[EOL]:=ORD(' ');
  KIND[CHR(HT)] :=ORD(' ');
  FILLCHAR(BLANKAREA,SIZEOF(BLANKAREA),' ');
  setstrlen(savetop,0);

END(* INITIALIZE *);


procedure do_out;
LABEL 1,2,3;
VAR
  SAVE: EPTRTYPE;
  includeflag: boolean;
  I,blocks: INTEGER;
  BUF: pagebuftype;
  FN: FID;
  holdfilename: FID;
  THEFILE: text;
  overkind : filekind;
  oktosave : boolean;
  newefile : boolean;

{if it is of type TEXTFILE then ...}
{ 17 Jul 80 - MCh: compute the file size prior to writing it and build the
		   file name with the correct size so that the file system
		   will use a first fit algorithm.  This was done to reduce
		   fragmentation at the end of a disc }

  procedure openout;
  var
    opt1        : string[10];
    opt2        : string[6];

  procedure addfilesize;
  begin
    if suffix(opt2) = textfile then
      if strpos ('[',fn) = 0 then
	strwrite(FN, strlen(FN)+1, I, '[', (blocks + 2):1, ']');
  end;

  begin
    opt1 := 'exclusive';
    if ch = 'S' then
      begin
	opt2 := '.' + suffixtable^[efilekind];
	addfilesize;
	fmaketype(thefile, fn, opt1, opt2);
      end
    else if ch = 'O' then
      begin
	opt2 := '.' + suffixtable^[overkind];
	addfilesize;
	foverfile(thefile, fn, opt1, opt2);
      end
    else
      begin
	opt2 := '.' + suffixtable^[suffix(fn)];
	addfilesize;
	rewrite  (thefile, fn, 'exclusive');
      end;
    if newefile then
      begin
	newefile  := false;
	fstripname(efilename,vstr,pstr,nstr);
	if ioresult = ord(inoerror) then
	  efilekind := fibp(addr(thefile))^.fkind
	else
	  begin
	    setstrlen(efilename,0);
	    setstrlen(vstr,0);
	    setstrlen(pstr,0);
	    setstrlen(nstr,0);
	  end;
      end;
    if (ioresult <> ord(inoerror)) then
      if (ch = 'W') or (ch = 'O') then
	begin
	  tempior := ioresult;
	  home;
	  eclearline(0);
	  getioerrmsg(generrmsg,tempior);
	  write(output,direction,'ERROR: ',generrmsg);
	  efilename := holdfilename;
	  ch := 'W';
	  goto 3  { get another file name }
	end
      else goto 1;
  end;

  procedure breakout(write_em: boolean);
  var i: integer;
  begin
  blocks := 0;  { count the number of blocks }
  CURSOR:=1;
  WHILE CURSOR < BUFCOUNT-maxchar DO
    BEGIN
    I:=SCAN(-maxchar+1,=EOL,EBUF^[CURSOR+maxchar-1]);
    if write_em then
      begin
	MOVELEFT(EBUF^[CURSOR],BUF,maxchar+I);
	FILLCHAR(BUF[maxchar+I],ABS(I)+1,CHR(0));
	if fibp(addr(THEFILE))^.fkind = textfile then
	  fwritebytes(THEFILE,BUF,pagesize)
	else UCSD_to_any(BUF, THEFILE);
	if ioresult <> ord(inoerror) THEN GOTO 1;
	WRITE(output,'.')
      end;
    blocks := blocks + 2;
    CURSOR:=CURSOR+maxchar+I;
    END;
  IF CURSOR<BUFCOUNT THEN
    BEGIN
      if write_em then
	begin
	  fillchar(BUF, SIZEOF(BUF), chr(0));
	  MOVELEFT(EBUF^[CURSOR],BUF,BUFCOUNT-CURSOR);
	  if fibp(addr(THEFILE))^.fkind = textfile then
	    fwritebytes(THEFILE,BUF,pagesize)
	  else UCSD_to_any(BUF, THEFILE);
	  if ioresult <> ord(inoerror) THEN GOTO 1;
	  WRITE(output,'.')
	end;
      blocks := blocks + 2
    END;
  end;

BEGIN
  oktosave      := (strlen(efilename) <> 0) and (not bufovflw) and (not inreaderror);
  newefile      := false;
  holdfilename  := efilename;
  OUT           := FALSE;
  with userinfo^ do
    begin
      includeflag := (errnum<>0) and gotsym
	and (errfid<>symfid);
      if includeflag then efilename := errfid;
    end;
  if recovering then ch := 'U'      { 19 May 80 - MCh: force update }
  else
    begin
      ECLEARSCREEN;     (* Dumb terminal patch *)
      SAVETOP:='>Quit:';
      WRITELN(output,SAVETOP);
      if not includeflag then
	WRITELN('     Update the workfile and leave');
      WRITELN  ('     Exit without updating');
      WRITELN  ('     Return to the editor without updating');
      WRITELN  ('     Write to a file name and return');
      if oktosave then
	begin
	  writeln('     Save as file new file ',vstr,':',pstr,nstr);
	  writeln('     Overwrite as file ',vstr,':',pstr,nstr);
	end;
      REPEAT
	CH:=UCLC(GETCH);
      UNTIL (CH IN ['E','R','W'])
	or ((ch='U') and not includeflag)
	or (oktosave and ((ch = 'S') or (ch = 'O')) )
	or streaming;
      writeln(ch);
    end;

  if streaming then
    if not((CH IN ['E','R','W'])
    or ((ch='U') and not includeflag)
    or (oktosave and ((ch = 'S') or (ch = 'O')))) then
      begin
	writeln(output,'Illegal Quit option.');
	escape(-1);
      end;

  IF CH='R' THEN GOTO 2;
  if(ch='E') then
    if (not updated) then
      begin
	out:=true;
	eclearscreen;
	goto 2;
      end
    else
     BEGIN   {WAH 4/14/80}
       if not streaming then
	 begin
	   fgotoxy(output,0,9);
	   writeln('Are you sure you want to exit without updating?');
	   writeln('     Type Yes  to Exit Without Update');
	   writeln('     Type No   to Return to Editor');
	   repeat
	     ch := uclc(getch);
	   until ch in ['Y','N'];
	   if ch <> 'Y' then goto 2;
	 end;
       OUT:=TRUE;
       ECLEARSCREEN;
       GOTO 2;
     END;
  SAVE:=CURSOR;{WAH to save cursor for 'W' and 'S' both 4/14/80}
  3:                { return here after bad file name }
  IF (CH='W') THEN
    BEGIN
      BLANKCRT(1);
      WRITE(output,'Name of output file (<'+entkey+'> to return) -->');
						      { 3.0 ITF fix }
      READLN(input,FN);
      fixname(fn,textfile);
      IF STRLEN(FN)=0 THEN
	GOTO 2;
      if strlen(efilename) = 0 then
	begin
	  efilename := fn;                 {dst 01/80}
	  newefile  := true;
	end;
    END
  ELSE
    if (ch='S') or (ch='O') then fn := efilename       {dst 01/80}
  else
    FN:='*WORK.TEXT';
  if ch = 'O' then
    overkind := efilekind;
  if not recovering then
    BLANKCRT(1);  { 20 May 80 - MCh }
  SYSDATE(PAGEZERO.LASTUSED);

  breakout(false);
  if (ch = 'W') and (not streaming) then
    begin
      reset(thefile,fn,'shared');
      if ioresult = ord(inoerror) then
	if not unitable^[fibp(addr(thefile))^.funit].uisblkd then
	  begin           {PRINTER:, CONSOLE:, #6, etc...}
	    close(thefile);
	    if efilename = fn then
	      begin
		setstrlen(efilename,0);
		newefile  := false;
	      end;
	  end
	else
	  begin
	    writeln(fn, ' exists ...');
	    writeln('    Rewrite then purge old');
	    writeln('    Overwrite');
	    writeln('    Purge old then rewrite');
	    writeln('    None of the above');
	    repeat
	      ch := uclc(getch);
	    until ch in ['R','O','P','N'];
	    writeln(ch);
	    if ch = 'O' then
	      overkind := fibp(addr(thefile))^.fkind;
	    if ch = 'P' then
	      close(thefile,'purge')
	    else
	      close(thefile);
	    if ch in ['R','P'] then ch := 'W';
	    if ch = 'N' then begin    { avoid S options }    { 3.0 bug #4 }
	      if newefile then efilename:='';                { 3.0 bug #4 }
	      goto 2;                                        { 3.0 bug #4 }
	    end;                                             { 3.0 bug #4 }
	  end;
      end;
  openout;
  WRITE(output,'Writing');
  with fibp(addr(THEFILE))^ do
    if fkind = textfile then
      begin
	am := amtable^[untypedfile];
	fwritebytes(THEFILE,PAGEZERO,pagesize);
	if ioresult <> ord(inoerror) THEN
	  GOTO 1;
	WRITE(output,'.');
      end;
  breakout(true);
  CLOSE(THEFILE,'LOCK');
  if ioresult <> ord(inoerror) then
    goto 1;
  WRITELN;
  WRITELN('Your file is ',BUFCOUNT:1,' bytes long.');
  if (ch = 'S') or (ch = 'O') then
    updated := false;

  IF CH='U' THEN
    WITH USERINFO^ DO
      BEGIN
	SYMFID:='*WORK.TEXT';
	GOTSYM:=TRUE;
	reset(THEFILE,'*WORK.CODE','exclusive');
	CLOSE(THEFILE,'PURGE');
	GOTCODE:=FALSE;
	setstrlen(codefid,0);
	OUT:=TRUE;
	userinfo^.errnum := 0;
      END
  ELSE
    BEGIN
      WRITE(output,'Exit from or Return to the editor? ');
      REPEAT CH:=UCLC(GETCH);
	if streaming and not(ch in ['E','R']) then
	  begin
	    writeln('''E'' or ''R'' expected');
	    escape(-1);
	  end;
      UNTIL CH IN ['E','R'];
      OUT:= CH='E';
      if ch='E' then
	userinfo^.errnum := 0;
      CURSOR:=SAVE; (* QW returns to the editor *)
    END;
  GOTO 2; (* SORRY ABOUT THAT EDSGER *)
1: if ioresult = ord(inoerror) then
     ERROR('Writing the file.',fatalifstreaming)
   else
     begin
       tempior := ioresult;
       getioerrmsg(generrmsg,tempior);
       error(generrmsg,fatalifstreaming)
     end;
2:END;


PROCEDURE COPYFILE;
VAR
  STARTOFFSET,STOPOFFSET,
  LEFTPART,PAGE,NOTNULLS,THEREST,LMOVE: INTEGER;
  DONE,OVFLW: BOOLEAN;
  BUFR: pagebuftype;
  STARTMARK,STOPMARK: NAME;
  FN: STRING80;
  F: text;

PROCEDURE ERRMARKER;
BEGIN
      ERROR('Improper marker specification.',fatalifstreaming);
      escape(102);
END;

PROCEDURE UNSPLITBUFF;
(* Stich the buffer back together again. *)
var i: integer;
BEGIN
  MOVELEFT(EBUF^[THEREST],EBUF^[CURSOR],LMOVE);
  READJUST(LEFTPART+1,CURSOR-(LEFTPART+1));
  BUFCOUNT:=BUFCOUNT+(CURSOR-(LEFTPART+1));  {WAH 4/7/80 int. ovfl fix}
  i:=leftpart+1; { remove form feeds in copied file 12/21/81 jws }
  while i<cursor do
    begin
      i:=i+scan(cursor-i, =chr(12), ebuf^[i]);
      if i<cursor then ebuf^[i]:=chr(32);
    end;
  CURSOR:=LEFTPART+1; (* Cursor points to the beginning of the file *)
  COPYOK:=FALSE;
END;

PROCEDURE exitcopy(msg: string80; center: boolean);
BEGIN
  ERROR(Msg,fatalifstreaming);
  UNSPLITBUFF;
  if center then CENTERCURSOR(TRASH,MIDDLE,TRUE);
  close (f);
  escape(102);
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: STRING80;
BEGIN
  LPTR:=STRPOS('[',FN);
  IF LPTR=0 THEN
    BEGIN (* whole file *)
      STARTMARK:='        ';
      STOPMARK:= '        '
    END
  ELSE
    BEGIN
      RPTR:=STRPOS(']',FN);
      IF (RPTR=0) OR (RPTR<LPTR) OR (RPTR<>STRLEN(FN)) THEN ERRMARKER;
      MARK:=STR(FN,LPTR+1,RPTR-LPTR-1); (* stuff between the brackets *)
      FN:=STR(FN,1,LPTR-1);
      COMMA:=STRPOS(',',MARK);
      IF COMMA=0 THEN ERRMARKER;
      I:=STRLEN(MARK)-COMMA; (* second marker ptr *)
      MOVELEFT(MARK[1],STARTMARK,MIN(8,COMMA-1));
      FILLCHAR(STARTMARK[COMMA],MAX(0,8-(COMMA-1)),' ');
      MOVELEFT(MARK[COMMA+1],STOPMARK,MIN(I,8));
      FILLCHAR(STOPMARK[I+1],MAX(0,8-I),' ')
    END;
  FOR I:=1 TO 8 DO STARTMARK[I]:=UCLC(STARTMARK[I]);
  FOR I:=1 TO 8 DO STOPMARK [I]:=UCLC(STOPMARK[I]);
  fixname(fn,textfile);
END;

PROCEDURE STUFFIT(START,STOP:INTEGER);
(* Put the contents of BUFR into EBUF.  OVFLW is set to true when there is
   no more room in the buffer. *)
VAR AMOUNT: INTEGER;
BEGIN
  IF START<=STOP THEN
    BEGIN
      AMOUNT:=STOP-START+1;
      IF CURSOR+AMOUNT+250(*slop*)>=THEREST THEN
	exitcopy ('Buffer overflow.',true)
      ELSE
	BEGIN
	  MOVELEFT(BUFR[START],EBUF^[CURSOR],AMOUNT);
	  CURSOR:=CURSOR+AMOUNT
	END
    END
END;

PROCEDURE GETNEXT;
BEGIN
  with fibp(addr(F))^ do
    begin
      DONE:= fpos >= fleof;
      IF NOT DONE THEN
	BEGIN
	  if fkind = textfile then freadbytes(F, BUFR, pagesize)
	  else any_to_UCSD(F, BUFR);
	  if ioresult <> ord(inoerror) then
	    begin
	      tempior := ioresult;
	      getioerrmsg(generrmsg,tempior);
	      exitcopy (generrmsg,true);
	    end;
	  WRITE(output,'.');
	END;
    end;
  IF NOT DONE THEN NOTNULLS:=SCAN(-pagesize,<>CHR(0),BUFR[maxchar])+pagesize
  ELSE NOTNULLS:=0;
  PAGE:=PAGE+1;
END;

PROCEDURE FINDMARKERS;
(* Given STARTMARK and STOPMARK find out their offsets *)
VAR
  PZ: HEADER;

  PROCEDURE SEARCH(MNAME:NAME;VAR OFF: INTEGER);
  VAR
    I: INTEGER;
  BEGIN
    I:=0;
    WHILE (I<PZ.COUNT) AND (MNAME<>PZ.NAME[I]) DO I:=I+1;
    IF MNAME<>PZ.NAME[I] THEN exitcopy ('Marker not there.',false);
    OFF:=pz.poffset[3*i]*65536+pz.poffset[3*I+1]*256 + pz.poffset[3*i+2];
  END;

BEGIN(* findmarkers *)
  STARTOFFSET:=0;   (* default values *)
  STOPOFFSET:=8388608; (* 2^23 *)
  with fibp(addr(F))^ do
    if fkind = textfile then
      begin
	am := amtable^[untypedfile];
	freadbytes(F, PZ, pagesize);
	if ioresult <> ord(inoerror) then
	  begin
	    tempior := ioresult;
	    getioerrmsg(generrmsg,tempior);
	    exitcopy (generrmsg,true);
	  end;
	end
    else fillchar(PZ, pagesize, chr(0));
  IF (STARTMARK<>'        ') OR (STOPMARK<>'        ') THEN
   if pz.newmarkers then
     begin
       IF STARTMARK <> '        ' THEN SEARCH(STARTMARK,STARTOFFSET);
       IF STOPMARK  <> '        ' THEN SEARCH(STOPMARK,STOPOFFSET)
     end
   else
     begin
       pz.count:=0;
       pz.name[0]:='        ';
     end;
  stopoffset := stopoffset - 1;
END;

BEGIN
try
  PROMPTLINE:=' Copy: File[marker,marker] ? ';
  REPEAT
    EPROMPT;
    READLN(input,FN);
    IF STRLEN(FN)=0 THEN escape(102);
    PARSEFN;
    RESET(F,FN,'shared');
    tempior := ioresult;
    if tempior <> ord(inoerror) then
    begin
      getioerrmsg(generrmsg,tempior);
      if streaming then
	error(generrmsg,fatal);
      PROMPTLINE:=' Copy: ' + generrmsg + '. File? ';
    end;
  UNTIL tempior=ord(inoerror);
  updated := true;
  PROMPTLINE:=' Copy'; EPROMPT;
  SPLITBUF;
  FINDMARKERS;
  PAGE:=1;
  GETNEXT;
  WHILE (STARTOFFSET>NOTNULLS) AND NOT DONE DO
    BEGIN
      IF (STOPOFFSET>=NOTNULLS) THEN
	  STOPOFFSET:=STOPOFFSET-NOTNULLS;
      STARTOFFSET:=STARTOFFSET-NOTNULLS;
      GETNEXT;
    END;
  IF (STOPOFFSET<NOTNULLS) THEN
    STUFFIT(max(STARTOFFSET-1,0),STOPOFFSET-1)
  ELSE
    STUFFIT(max(STARTOFFSET-1,0),NOTNULLS-1);
  WHILE (STOPOFFSET>NOTNULLS) AND NOT DONE DO
    BEGIN
      STOPOFFSET:=STOPOFFSET-NOTNULLS;
      GETNEXT;
      IF (STOPOFFSET<NOTNULLS) THEN
	STUFFIT(0,STOPOFFSET-1)
      ELSE
	STUFFIT(0,NOTNULLS-1)
    END;
  IF IORESULT<>ord(inoerror) THEN
    begin
      tempior := ioresult;
      getioerrmsg(generrmsg,tempior);
      ERROR(generrmsg,fatalifstreaming)
    end;
  UNSPLITBUFF;
  if (ord(ebuf^[cursor])=16) and (ord(ebuf^[cursor-1])<>13) then
    begin
      moveleft(ebuf^[cursor+2],ebuf^[cursor], bufcount-cursor-1);
      readjust(leftpart+1,-2);
      bufcount:=bufcount-2;
    end;
  CENTERCURSOR(TRASH,MIDDLE,TRUE);
  CLOSE(F);
recover
  if escapecode<>102 then escape(escapecode);
END;

PROCEDURE ENVIRONMENT;

var
  maybeupdated : boolean;

  PROCEDURE ERASE10;
  VAR I: INTEGER;
  BEGIN
    WRITE(output,' ':10);
    FOR I:=1 TO 10 DO WRITE(output,CHR(BSS));
  END;

  PROCEDURE BOOL(B:BOOLEAN);
  BEGIN
    IF B THEN WRITE(output,'True')
    ELSE WRITE(output,'False');
    WRITELN(output);
  END;

  FUNCTION GETBOOL: BOOLEAN;
  VAR CH: CHAR;
      TRASH: SHORTINT;
  BEGIN
    ERASE10; CH:=UCLC(GETCH);
    WHILE NOT (CH IN ['T','F']) DO
      BEGIN
	WRITE(output,'T or F');
	FOR TRASH:=0 TO 5 DO WRITE(output,CHR(BSS));
	CH:=UCLC(GETCH)
      END;
    IF CH='T' THEN
      BEGIN
	WRITE(output,'True  ');
	GETBOOL:=TRUE
      END
    ELSE
      BEGIN
	WRITE(output,'False ');
	GETBOOL:=FALSE
      END;
  END;

  FUNCTION GETINT: INTEGER;
  VAR
    CH:CHAR;
    N: INTEGER;
    digitswritten : shortint;
  BEGIN
    ERASE10;
    digitswritten := 0;
    N:=0;
    REPEAT
      REPEAT
	CH:=GETCH;
	IF (NOT (CH IN ['0'..'9',CHR(SP),CHR(CR)])) THEN
	  WRITE(output,'#',CHR(BELL),CHR(BSS));
      UNTIL CH IN ['0'..'9',CHR(SP),CHR(CR)];
      IF CH IN ['0'..'9'] THEN
	IF N<1000 THEN
	  BEGIN
	    N:=N*10+ORD(CH)-ORD('0');
	    WRITE(output,CH);
	    digitswritten := digitswritten + 1;
	  END
	else
	  WRITE(output,'#',CHR(BELL),CHR(BSS));
    UNTIL CH IN [CHR(SP),CHR(CR)];
    GETINT:=N;
    if digitswritten = 0 then
      write(output,'0 ')
    else
      WRITE(output,'  ')
  END;

procedure showenviron;
VAR
  I: INTEGER;

begin
  WITH PAGEZERO DO
    BEGIN
      ECLEARSCREEN;
      PROMPTLINE:= ' Environment: {options} <'+exckey+'> or <sp> leaves';
							{ 3.0 ITF fix }
      EPROMPT; NEEDPROMPT:=TRUE;
      WRITELN(output);
      WRITE(output,'    Auto indent   '); BOOL(AUTOINDENT);
      WRITE(output,'    Filling       '); BOOL(FILLING);
      WRITE(output,'    Left margin   '); WRITELN(output,LMARGIN:1);
      WRITE(output,'    Right margin  '); WRITELN(output,RMARGIN:1);
      WRITE(output,'    Para margin   '); WRITELN(output,PARAMARGIN:1);
      WRITE(output,'    Command ch    '); WRITELN(output,RUNOFFCH);
      WRITE(output,'    Token def     '); BOOL(TOKDEF);
      WRITE(output,'    Ignore case   '); BOOL(ignorecase);
      WRITE(output,'    Zap markers   ');
      WRITELN(output);
      WRITELN(
       output,'    ',BUFCOUNT:1,' bytes used, ',(BUFSIZE-BUFCOUNT+1):1
		  ,' available.');
      WRITELN(output);
      IF SDEFINED OR TDEFINED THEN
	BEGIN
	WRITELN(output,'    Patterns:');
	IF TDEFINED THEN WRITE(output,'      <target>= ''',TARGET:TLENGTH,'''');
	IF SDEFINED THEN WRITE(output,', <subst>=  ''',SUBSTRING:SLENGTH,'''');
	WRITELN(output); WRITELN(output);
	END;
      IF COUNT>0 THEN WRITELN(output,'    Markers:');
      WRITE(output,'  ');
      FOR I:=0 TO COUNT-1 DO
	BEGIN WRITE(output,' ':6,NAME[I]);
	  IF (I+4) MOD 3=0 THEN BEGIN WRITELN(output); WRITE(output,'  ') END
	END;
      WRITELN(output);
      WRITELN(output);
      if strlen(efilename) <> 0 then
	 writeln(output,'    File ',vstr,':',pstr,nstr)
      else
	 writeln(output,'    System workfile');
      {LAF 880101 "MOD 100" added}
      WRITELN(output,'    Date Created: ',CREATED.MONTH:1,'-',CREATED.DAY:1
	 ,'-', CREATED.YEAR MOD 100:1,'   Last Used: ',LASTUSED.MONTH:1,'-',
	 LASTUSED.DAY:1,'-',LASTUSED.YEAR MOD 100:1);
    end;
end;

function marginsok : boolean;
begin
  with pagezero do
    if (lmargin < rmargin) AND (PARAMARGIN < RMARGIN)  then     { 3.0 BUG #2 }
      marginsok := true
    else
      begin
	marginsok := false;
	error('Improper margins',fatalifstreaming);
	eprompt;
      end;
end;

BEGIN
  maybeupdated := false;
  WITH PAGEZERO DO
    BEGIN
      showenviron;
      REPEAT
	fgotoxy(output,STRLEN(PROMPTLINE),0);
	CH:=UCLC(GETCH);
	maybeupdated := true;
	CASE CH OF
	  'A': BEGIN  fgotoxy(output,18,1); AUTOINDENT:=GETBOOL END;
	  'F': BEGIN  fgotoxy(output,18,2); FILLING:=GETBOOL END;
	  'L': repeat fgotoxy(output,18,3); LMARGIN:=GETINT; until marginsok;
	  'R': repeat fgotoxy(output,18,4); RMARGIN:=GETINT; until marginsok;
	  'P': repeat fgotoxy(output,18,5); PARAMARGIN:=GETINT; until marginsok;
	  'C': BEGIN  fgotoxy(output,18,6); READ(input,RUNOFFCH) END;
	  'T': BEGIN  fgotoxy(output,18,7); TOKDEF:=GETBOOL END;
	  'I': BEGIN  fgotoxy(output,18,8); ignorecase:=GETBOOL END;
	  'Z': begin  count := 0; name[0] := ' '; showenviron; end;
	  otherwise begin
		      maybeupdated := false;
		      if not (ch in [' ', chr(etxx), chr(cr)]) then
			begin
			  ERROR('Not option',fatalifstreaming);
			  EPROMPT;
			end;
		    end;
	END;
	updated := updated or maybeupdated;
      UNTIL CH IN [' ',CHR(ETXX),CHR(CR)];
      REDISPLAY;
    END;
END;

FUNCTION MIN(* (A,B:INTEGER):INTEGER *);
BEGIN
  IF A<B THEN MIN:=A ELSE MIN:=B
END;

FUNCTION MAX (*(A,B:INTEGER):INTEGER*);
BEGIN
  IF A>B THEN MAX:=A ELSE MAX:=B
END;

FUNCTION GETCH: CHAR;
VAR GCH: CHAR;
BEGIN
  IF EOLN(KEYBOARD) THEN
    begin
      GCH:=EOL;
      get(keyboard);
    end
  else READ(KEYBOARD,GCH);
  GETCH:=GCH;
END;

PROCEDURE CONTROL(*(WHAT: SCREENCOMMAND)*);
BEGIN
  WITH SCREENN DO
    BEGIN
      IF HASPREFIX[WHAT] THEN WRITE(output,PREFIX);
      WRITE(output,CH[WHAT]);
    END
END;

FUNCTION SCREENHAS(*(WHAT: SCREENCOMMAND): BOOLEAN*);
BEGIN
  SCREENHAS:=SCREENN.CH[WHAT]<>CHR(0);
END;

FUNCTION MAPCRTCOMMAND(VAR KCH:CHAR): KEYCOMMAND;
VAR WHATITIS: KEYCOMMAND;
    PREFIXREAD: BOOLEAN;
BEGIN
  WITH KEYBRD DO
    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=syscom^.crtctrl.escape) 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
	  otherwise
	END;
    END
  ELSE
    MAPTOCOMMAND:=TRANSLATE[CH];
END;

FUNCTION UCLC(*(CH:CHAR):CHAR*); (* Map Lower Case to Upper Case *)
BEGIN
  IF CH IN ['a'..'z'] THEN UCLC:=CHR(ORD(CH)-32) ELSE UCLC:=CH
END;

PROCEDURE EPROMPT;
BEGIN
  PROMPTLINE[1]:=DIRECTION;
  SAVETOP:=PROMPTLINE;
  CONTROL(WHOME);
  ECLEARLINE(0);
  WRITE(output,PROMPTLINE)
END;

PROCEDURE ECLEARSCREEN;
VAR I:INTEGER;
BEGIN
  IF SCREENHAS(CLEARSCN) THEN
    CONTROL(CLEARSCN)
  ELSE
    BEGIN
      HOME;
      EERASEOS(0,0)
    END;
END;

PROCEDURE ECLEARLINE(*Y:INTEGER*);
VAR I: INTEGER;
BEGIN
  IF SCREENHAS(CLEARLNE) THEN
    CONTROL(CLEARLNE)
  ELSE
    BEGIN
      fgotoxy(output,0,Y);
      ERASETOEOL(0,Y);
    END;
END;

PROCEDURE PUTMSG;
BEGIN
  CONTROL(WHOME);
  ECLEARLINE(0);
  SAVETOP:=MSG;
  WRITE(output,MSG);
END;

PROCEDURE HOME;
BEGIN
  IF SCREENHAS(WHOME) THEN
    CONTROL(WHOME)
  ELSE
    fgotoxy(output,0,0);
END;

PROCEDURE ERASETOEOL(*X,LINE:INTEGER*);
VAR I: INTEGER;
BEGIN
  IF SCREENHAS(ERASEEOL) THEN CONTROL(ERASEEOL)
  ELSE
    BEGIN
      IF LINE=SCREENHITE THEN I := SCREENWID-X
			 ELSE I := SCREENWID-X+1;
      call (fibp(gfiles[1])^.am, fibp(gfiles[1]), writebytes, BLANKAREA, I, 0);
      fgotoxy(output,X,LINE)
    END;
END;

PROCEDURE BLANKCRT(*Y: INTEGER*);
BEGIN
  IF SCREENHAS(ERASEEOS) THEN
    BEGIN
      fgotoxy(output,0,Y);
      CONTROL(ERASEEOS)
    END
  ELSE
    IF Y=1 THEN
      BEGIN
	ECLEARSCREEN;
	WRITELN(output,SAVETOP)
      END
    ELSE
      BEGIN
	fgotoxy(output,0,Y);
	EERASEOS(0,Y);
      END;
END;

PROCEDURE EERASEOS(*X,LINE*);
VAR I: INTEGER;
BEGIN
  IF SCREENHAS(ERASEEOS) THEN
    CONTROL(ERASEEOS)
  ELSE
    BEGIN
      ERASETOEOL(X,LINE);
      FOR I:=LINE+1 TO SCREENHITE DO
	BEGIN
	  WRITELN(output);
	  ECLEARLINE(I);
	END;
      fgotoxy(output,X,LINE);
    END;
END;

PROCEDURE ERRWAIT;
BEGIN
  WRITE(output,CHR(BELL));
  EPROMPT;
END;


PROCEDURE ERROR(*S: STRING80;HOWBAD: ERRORTYPE*);
BEGIN
  call (fibp(gfiles[0])^.am, fibp(gfiles[2]), clearunit, gfiles[2], 0, 0);
 {UNITCLEAR(1); (* Throw away all characters queued up *)
  IF HOWBAD=FATAL THEN
    BLANKCRT(1)
  ELSE
    BEGIN HOME; ECLEARLINE(0) END;
  WRITE(output,direction,'ERROR: ',S);
  IF HOWBAD=FATAL THEN
    if streaming then escape(-1) else escape(101)
  ELSE
    BEGIN
      if not streaming then
	begin
	  WRITE(output,' <space> continues.');
	  REPEAT UNTIL GETCH=' ';
	end;
      NEEDPROMPT:=TRUE
    END;
END;


FUNCTION LEADBLANKS(* (PTR: PTRTYPE; VAR BYTES: INTEGER): INTEGER *);
(* On entry-
      PTR points to the beginning of a line
   On exit-
      function returns the number of leading blanks on that line.
      bytes has the offset into the line of the first non-blank character *)
VAR
  OLDPTR: EPTRTYPE;
  INDENT: INTEGER;

  BEGIN
  OLDPTR:=PTR; INDENT:=0;
  WHILE ORD(EBUF^[PTR]) IN [HT,SP,DLE] DO
    BEGIN
      IF EBUF^[PTR]=CHR(DLE) THEN
	BEGIN
	  PTR:=PTR+1;
	  indent:=indent+max(0, ord(ebuf^[ptr])-32);    { 3.0 bug #1 }
	  {  INDENT:=INDENT+ORD(EBUF^[PTR])-32; }       { 3.0 bug #1 }
	END
      ELSE
	IF ORD(EBUF^[PTR])=SP THEN INDENT:=INDENT+1
	ELSE
	  (*HT*) INDENT:=((INDENT DIV 8)+1)*8;  (* KLUDGE FOR COLUMNAR TAB! *)
      PTR:=PTR+1
    END;
  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. *)
VAR
  LINEDIST,EOLDIST,LINE: INTEGER;
  PTR: EPTRTYPE;
  T: PACKED ARRAY [0..MAXSW] OF CHAR;
BEGIN
  BLANKCRT(1);
  LINE:=1;
  PTR:=LINE1PTR;
  REPEAT
    BLANKS:=MIN(LEADBLANKS(PTR,BYTES),SCREENWID);
    fgotoxy(output,BLANKS,LINE);
    PTR:=PTR+BYTES;
    EOLDIST:=SCAN(MAXCHAR,=EOL,EBUF^[PTR]);
    LINEDIST:=MAX(0,MIN(EOLDIST,SCREENWID-BLANKS+1));
    MOVELEFT(EBUF^[PTR],T[0],LINEDIST);
    IF EBUF^[PTR+LINEDIST]<>EOL THEN (* Line truncation *)
      T[MAX(0,LINEDIST-1)]:='!';
    WRITE(output,T:LINEDIST);
    PTR:=PTR+EOLDIST+1; LINE:=LINE+1
  UNTIL (LINE>SCREENHITE) 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, and
   newscreen is false, then no redisplay is done.  Otherwise an attempt
   is made to position the cursor at line "linesup".  line is then updated
   to the actual line the cursor was forced to. *)
VAR
  MARK: INTEGER;
  PTR: EPTRTYPE;
BEGIN
  IF EBUF^[CURSOR]=EOL THEN PTR:=CURSOR ELSE PTR:=CURSOR+1;
  LINE:=0;
  REPEAT
    PTR:=PTR-1;
    PTR:=SCAN(-MAXCHAR,=EOL,EBUF^[PTR])+PTR;
    LINE:=LINE+1;
    IF LINE=LINESUP THEN MARK:=PTR;
  UNTIL (LINE>SCREENHITE) OR ((LINE1PTR=PTR+1) AND NOT NEWSCREEN) OR (PTR<1);
  IF LINE>SCREENHITE THEN (* Off the screen *)
    BEGIN
      LINE1PTR:=MARK+1;
      REDISPLAY;
      LINE:=LINESUP;
    END
  ELSE
    IF LINE1PTR=PTR+1 THEN
      BEGIN
	IF NEWSCREEN THEN REDISPLAY
      END
    ELSE
      BEGIN
	LINE1PTR:=1;
	REDISPLAY;
      END;
END;

PROCEDURE actualXY(*VAR INDENT,LINE: INTEGER*);  { NEW FOR 3.0 bug #7 }
{ added to find logical xy position. Same code as FINDXY used to }
{ have except for final INDENT assignment.                        }
VAR
  I,LEAD: INTEGER;
  PTR,EOLPTR: EPTRTYPE;
BEGIN
  (* Place CRT cursor on the screen at the position corresponding
     to the logical cursor. *)
  LINE:=1;
  PTR:=LINE1PTR;
  EOLPTR:=SCAN(MAXCHAR,=EOL,EBUF^[PTR])+PTR;
  WHILE EOLPTR<CURSOR DO
    BEGIN
      LINE:=LINE+1;
      PTR:=EOLPTR+1; (* Set up for the next line *)
      EOLPTR:=SCAN(MAXCHAR,=EOL,EBUF^[PTR])+PTR;
    END;
  (* Now find the indentation on that line of the cursor *)
  LEAD:=LEADBLANKS(PTR,I);
  INDENT:=(LEAD-I)+(CURSOR-PTR);
			  (* (extra spaces) + (offset into line) *)
END;(* FINDXY *)

PROCEDURE FINDXY(*VAR INDENT,LINE: INTEGER*);
BEGIN
actualXY(INDENT, LINE);                           { 3.0 BUG #7 }
INDENT:=MIN(SCREENWID, INDENT);                   { 3.0 BUG #7 }
END;(* FINDXY *)                                  { 3.0 BUG #7 }

PROCEDURE SHOWCURSOR;
VAR
  X,Y: INTEGER;
BEGIN
  FINDXY(X,Y);
  fgotoxy(output,X,Y)
END(* SHOWCURSOR *);

FUNCTION GETNUM(*:INTEGER*);
VAR
  N: INTEGER;
  OVERFLOW: BOOLEAN;
BEGIN
  N:=0;
  OVERFLOW:=FALSE;
  IF NOT (CH IN ['0'..'9']) THEN N:=1
  ELSE
    REPEAT
      IF N >= 1000 THEN OVERFLOW:=TRUE
      ELSE
	BEGIN
	  N:=N*10+ORD(CH)-ORD('0');
	  CH:=GETCH
	END
    UNTIL (NOT (CH IN ['0'..'9'])) OR OVERFLOW;
  IF OVERFLOW THEN
    BEGIN
      ERROR('Repeatfactor>=10000',fatalifstreaming);
      GETNUM:=0;
    END
  ELSE
    GETNUM:=N;
  if overflow then ecommand:=illegal
  else ECOMMAND:=MAPTOCOMMAND(CH); (* Takes CH and maps it to a command *)
END;

PROCEDURE GETLEADING;
BEGIN
  (* Sets:
	LINESTART ......... A pointer to the beginning of the line
	STUFFSTART ........ A pointer to the beginning of the text on the line
	BYTES ............. The number of bytes between LINESTART and
			    STUFFSTART
	BLANKS ............ The indentation of the line    *)
  LINESTART:=CURSOR;
  IF EBUF^[LINESTART]=EOL THEN LINESTART:=LINESTART-1; (* for scan! *)
  LINESTART:=SCAN(-MAXCHAR,=EOL,EBUF^[LINESTART])+LINESTART+1;
  BLANKS:=LEADBLANKS(LINESTART,BYTES);
  STUFFSTART:=LINESTART+BYTES
END (* GETLEADING *);

procedure movetobuf(*cursor,anchor: eptrtype*);
begin
  if (abs(cursor-anchor)>(bufsize-bufcount-10)) then
    if not streaming then
      error('Copy buffer ovflw', nonfatal)
    else
  else
    begin
      copyok:=true;
      copylength:=abs(cursor-anchor);
      copystart:=bufsize-copylength+1;
      moveleft(ebuf^[min(cursor,anchor)],ebuf^[copystart], copylength);
    end;
end;

FUNCTION OKTODEL (* (CURSOR,ANCHOR: PTRTYPE):BOOLEAN *) ;
var temp, cursortemp: eptrtype;
BEGIN
  IF (ABS(CURSOR-ANCHOR)>((BUFSIZE-BUFCOUNT)-10)) and not streaming THEN
    BEGIN
      MSG:='No room to copy deletion. Delete anyway? (y/n)';
      PUTMSG;
      IF UCLC(GETCH)='Y' THEN OKTODEL:=TRUE
      ELSE OKTODEL:=FALSE;
    END
  ELSE
    BEGIN
      (* COPYLINE is set by the caller *)
      COPYOK:=TRUE;
      COPYLENGTH:=ABS(CURSOR-ANCHOR);
      COPYSTART:=BUFSIZE-COPYLENGTH+1;
      MOVELEFT(EBUF^[MIN(CURSOR,ANCHOR)],EBUF^[COPYSTART],COPYLENGTH);
      OKTODEL:=TRUE
    END;
END;


PROCEDURE LINEOUT(*VAR PTR:PTRTYPE; BYTES,BLANKS,LINE:INTEGER*);
(* Write a line out *)
VAR
  LINEDIST,EOLDIST: INTEGER;
  T: PACKED ARRAY [0..MAXSW] OF CHAR;
BEGIN
  fgotoxy(output,BLANKS,LINE);
  PTR:=PTR+BYTES;
  EOLDIST:=SCAN(MAXCHAR,=EOL,EBUF^[PTR]);
  LINEDIST:=MAX(0,MIN(EOLDIST,SCREENWID-BLANKS+1));
  MOVELEFT(EBUF^[PTR],T[0],LINEDIST);
  IF EBUF^[PTR+LINEDIST]<>EOL THEN (* Line truncation *)
    BEGIN
      LINEDIST:=MAX(LINEDIST,1);
      T[LINEDIST-1]:='!';
    END;
  if blanks>=screenwid then fgotoxy(output,screenwid,line);
  WRITE(output,T:LINEDIST);
  PTR:=PTR+EOLDIST+1
END;

PROCEDURE UPSCREEN(*FIRSTLINE,WHOLESCREEN: BOOLEAN; LINE: INTEGER*);
(* Zap, Insert and Delete call this procedure to update (possibly partially)
   the screen.  FIRSTLINE means only the line that the cursor is on need
   be updated.  WHOLESCREEN means that everything must be updated.  If
   neither of these is true then only the part of the screen that's after
   the cursor is updated *)
VAR
  PTR: EPTRTYPE;

BEGIN (* Upscreen *)
  IF FIRSTLINE THEN
    BEGIN
      GETLEADING;
      fgotoxy(output,0,LINE); ERASETOEOL(0,LINE); (* Clean the line *)
      LINEOUT(LINESTART,BYTES,BLANKS,LINE) (* Just this line *)
    END
  ELSE
    IF WHOLESCREEN THEN
      CENTERCURSOR(TRASH,MIDDLE,TRUE)
    ELSE (* Only update the part of the screen after the cursor *)
      BEGIN
	fgotoxy(output,0,LINE);
	EERASEOS(0,LINE);
	GETLEADING;
	PTR:=LINESTART;
	REPEAT
	  BLANKS:=MIN(LEADBLANKS(PTR,BYTES),SCREENWID);
	  LINEOUT(PTR,BYTES,BLANKS,LINE); (* Writes out the line at ptr *)
	  LINE:=LINE+1
	UNTIL (LINE>SCREENHITE) OR (PTR>=BUFCOUNT)
      END;
END;

PROCEDURE READJUST(*CURSOR:PTRTYPE; DELTA: INTEGER*);
(* if DELTA<0 then move all affected markers to CURSOR.  Also adjust all
   markers >= CURSOR by DELTA *)
VAR
  I,j: INTEGER;
BEGIN
  WITH PAGEZERO DO
    begin
      if lastpat >= cursor then
	lastpat := max(lastpat+delta,cursor);
      FOR I:=0 TO COUNT-1 DO
	begin
	  j:=poffset[3*i]*65536+poffset[3*i+1]*256+poffset[3*i+2];
	  IF j>=CURSOR THEN
	    begin
	      j:=MAX(j+DELTA,CURSOR);
	      poffset[3*i]:=j div 65536;
	      poffset[3*i+1]:=(j mod 65536) div 256;
	      poffset[3*i+2]:=j mod 256;
	    end
	end;
    end;
END;

PROCEDURE THEFIXER(*PARAPTR:PTRTYPE;RFAC:INTEGER;WHOLE:BOOLEAN*);
(* PARAPTR points somewhere in a paragraph.  If WHOLE is true then the
   entire paragraph is filled, otherwise only that directly after the cursor
   is filled.  RFAC, when implemented will tell how many paragraphs to be
   filled.  Note: A paragraph is defined as lines of text delimited by a line
   with no text on it whatsoever, or a line of a text whose first character is
   RUNOFFCH *)

label 1;

VAR
  SAVE,PTR,WPTR: INTEGER;
  WLENGTH,X: INTEGER;
  DONE: BOOLEAN;
  startadjust: integer;

BEGIN
  updated := true;
  WITH PAGEZERO DO
    BEGIN
      SAVE:=CURSOR;
      CURSOR:=PARAPTR;
      GETLEADING;
      IF EBUF^[STUFFSTART] IN [EOL,RUNOFFCH] THEN goto 1;
      IF WHOLE THEN (* Scan backwards for the beginning of the paragraph *)
	BEGIN
	  REPEAT
	    CURSOR:=LINESTART-1;
	    GETLEADING
	  UNTIL (LINESTART<=1) OR (EBUF^[STUFFSTART] IN [RUNOFFCH,EOL]);
	  IF EBUF^[STUFFSTART] IN [RUNOFFCH,EOL] THEN
	    PTR:=CURSOR+1
	  ELSE
	    PTR:=1;
	  X:=PARAMARGIN;
	END
      ELSE
	BEGIN
	  PTR:=cursor; { formerly LINESTART } { mods 12/22/81 jws }
	  x:=cursor - stuffstart + blanks;
	  {  IF BLANKS=PARAMARGIN THEN X:=PARAMARGIN ELSE X:=LMARGIN }
	END;
      CURSOR:=BUFSIZE-(BUFCOUNT-PTR)+1; (* Split the buffer *)
      MOVERIGHT(EBUF^[PTR],EBUF^[CURSOR],BUFCOUNT-PTR);
      if not whole then         {don't want to lose leading space  RAM 27AUG82}
	if (ebuf^[cursor] = ' ') then
	  if (ebuf^[ptr-1] = ' ') then
	    begin
	      if (ebuf^[ptr-2] in ['.', '?', ':', '!']) then
		begin
		  ebuf^[ptr]:= ' ';
		  ptr       := ptr + 1;
		  cursor    := cursor + 1;
		end
	    end
	  else
	    begin
	      if (ebuf^[ptr-1] in ['.', '?', ':', '!'])
	      and (ebuf^[cursor + 1] = ' ') then
		begin
		  ebuf^[ptr]:= ' ';
		  ptr       := ptr + 1;
		  cursor    := cursor + 1;
		end;
	      ebuf^[ptr]    := ' ';
	      ptr           := ptr + 1;
	      cursor        := cursor + 1;
	    end;
      startadjust:=ptr;
      (* Now dribble back the (rest of the) paragraph *)
      if whole then
	begin
	  EBUF^[PTR]:=CHR(DLE);
	  EBUF^[PTR+1]:=CHR(X+32);
	  PTR:=PTR+2;
	end;
      EBUF^[CURSOR-1]:=EOL; (* sentinel for getleading *)
      DONE:=FALSE;
      REPEAT
	WHILE EBUF^[CURSOR] IN [CHR(HT),CHR(SP),CHR(DLE)] DO
	  IF EBUF^[CURSOR]=CHR(DLE) THEN
	    CURSOR:=CURSOR+2
	  ELSE
	    CURSOR:=CURSOR+1;
	WPTR:=CURSOR;
	(* Skip over a token *)
	WHILE NOT (EBUF^[CURSOR] IN [EOL,' ']) DO CURSOR:=CURSOR+1;
	(* Special cases for ".<sp><sp>"  *)
	IF (EBUF^[CURSOR-1] in ['.','?',':','!']) 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]=' ') and (ebuf^[ptr-2]<>chr(dle)) THEN
	      PTR:=PTR-1;
	    EBUF^[PTR]:=EOL;
	    EBUF^[PTR+1]:=CHR(DLE);
	    EBUF^[PTR+2]:=CHR(LMARGIN+32);
	    PTR:=PTR+3;
	    X:=LMARGIN
	  END;
	CURSOR:=CURSOR+1;
	MOVELEFT(EBUF^[WPTR],EBUF^[PTR],WLENGTH);
	IF EBUF^[CURSOR-1]=EOL THEN
	  BEGIN
	    IF (EBUF^[CURSOR]=CHR(0)) OR (CURSOR > BUFSIZE) THEN DONE:=TRUE
	    ELSE
	      BEGIN
		GETLEADING;
		DONE:=(EBUF^[STUFFSTART]=EOL) OR (EBUF^[STUFFSTART]=RUNOFFCH);
		(* The last transfer will move over the <eol> for the paragraph *)
		IF NOT DONE THEN
		  BEGIN
		    EBUF^[PTR+WLENGTH-1]:=' ';
		    (* If <eol> <sp>, map to one space only *)
		    IF EBUF^[CURSOR-2]=' ' THEN PTR:=PTR-1;
		  END
	      END
	  END;
	X:=X+WLENGTH;
	PTR:=PTR+WLENGTH;
      UNTIL DONE;
      READJUST(startadjust,(BUFSIZE-CURSOR+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;
1:END;

PROCEDURE GETNAME(*MSG:STRING80; VAR M:NAME*);
VAR
  I: INTEGER;
  S: STRING80;
BEGIN
  NEEDPROMPT:=TRUE;
  HOME;
  ECLEARLINE(0);
  WRITE(output,MSG,' what marker? ');
  READLN(input,S);
  {remove control characters}
  if strlen(s)>=1 then begin
    i:=1;
    while i<=strlen(s) do begin
      if (ord(s[i])<=32) or (s[i]=',') or
	 (ord(s[i])=127)  then strdelete(s,i,1)
      else  i:=i+1;
    end;
  end;
  FOR I:=1 TO STRLEN(S) DO S[I]:=UCLC(S[I]);
  MOVELEFT(S[1],M,MIN(8,STRLEN(S)));
  FILLCHAR(M[STRLEN(S)+1],MAX(0,8-STRLEN(S)),' ')
END;

end;   {edit1}




module edit2;


import
  sysglobals,
  misc,
  sysdevs,
  fs,
  ci,
  edit1;


export
  procedure xeditor;

implement

PROCEDURE EDITCORE;

(* Core procedures.  Execute these commands until either a set environment
   comes along or a quit command. *)



PROCEDURE NEXTCOMMAND; FORWARD;

PROCEDURE FIXDIRECTION;
BEGIN
  IF ECOMMAND=FORWARDC THEN
    DIRECTION:='>'
  ELSE
    DIRECTION:='<';
  HOME;
  WRITE(output,DIRECTION); (* Update prompt line *)
  SHOWCURSOR;
  NEXTCOMMAND
END;

PROCEDURE COPY;
var
  copykludge    : boolean;
  templength    : integer;
  tempstart     : integer;
  i             : integer;
BEGIN
  PROMPTLINE:=' Copy: Buffer File <'+esckey+'>';       { 3.0 ITF fix 4/6/84 }
  EPROMPT; NEEDPROMPT:=TRUE;
  REPEAT
    CH:=UCLC(GETCH);
    if streaming and not(ch in ['B','F',chr(escc)]) then
      begin
	msg:='Illegal Copy option.';
	putmsg;
	escape(-1);
      end;
  UNTIL CH IN ['B','F',CHR(ESCC)];
  IF CH='F' THEN escape(103);
  IF CH='B' THEN
    BEGIN
      IF NOT COPYOK
      OR ((BUFCOUNT+COPYLENGTH+10>COPYSTART) AND (COPYSTART>=BUFCOUNT)) THEN
	ERROR('Invalid copy.',fatalifstreaming)
      ELSE
	IF BUFCOUNT+COPYLENGTH>=BUFSIZE THEN
	  ERROR('No room',fatalifstreaming)
	ELSE
	  BEGIN
	    updated := true;
	    copykludge:=false;
	    IF COPYLINE THEN
	      BEGIN
		GETLEADING;
		if not iflag then begin
		  if (cursor=stuffstart) then cursor:=linestart
		  else
		    begin
		      copykludge      := true;
		      tempstart       := copystart;
		      templength      := copylength;
		      i := 0;
		      while (i < copylength)
			    and (   (ebuf^[copystart+i] = ' '     )
				 or (ebuf^[copystart+i] = chr(DLE)) ) do
			begin
			  if ebuf^[copystart+i] = chr(DLE) then
			    i := i + 1;
			  i := i + 1;
			end;
		      copystart       := copystart + i;
		      copylength      := copylength - i;
		    end
		end;
	      END;
	    MOVERIGHT(EBUF^[CURSOR],EBUF^[CURSOR+COPYLENGTH],BUFCOUNT-CURSOR+1);
	    IF (COPYSTART>=CURSOR) AND (COPYSTART<BUFCOUNT) THEN
	      MOVELEFT(EBUF^[COPYSTART+COPYLENGTH],EBUF^[CURSOR],COPYLENGTH)
	    ELSE
	      MOVELEFT(EBUF^[COPYSTART],EBUF^[CURSOR],COPYLENGTH);
	    BUFCOUNT:=BUFCOUNT+COPYLENGTH;
	    READJUST(CURSOR,COPYLENGTH);
	    GETLEADING;
	    CURSOR:=MAX(CURSOR,STUFFSTART);
	    CENTERCURSOR(TRASH,MIDDLE,TRUE);
	    if copykludge then
	      begin
		copystart:=tempstart;
		copylength:=templength;
	      end;
	  END;
    END (* CH='B' *);
  SHOWCURSOR;
  NEXTCOMMAND;
END(*COPY*);

PROCEDURE FIND; FORWARD;

PROCEDURE INSERTIT; FORWARD;

PROCEDURE JUMP;
VAR CH: CHAR;

PROCEDURE JUMPMARKER;
VAR
  I: INTEGER;
  MNAME: NAME;
BEGIN
  WITH PAGEZERO DO
    BEGIN
      GETNAME('Jump to',MNAME);
      IF MNAME<>'        ' THEN
	BEGIN
	  I:=0;
	  WHILE (I<COUNT) AND (MNAME<>NAME[I]) DO I:=I+1;
	  IF MNAME<>NAME[I] THEN
	    ERROR('Not there.',fatalifstreaming)
	  ELSE
	    BEGIN
	      CURSOR:=poffset[3*i]*65536+poffset[3*i+1]*256+poffset[3*i+2];
	      GETLEADING;
	      CURSOR:=MAX(CURSOR,STUFFSTART);
	      CENTERCURSOR(TRASH,MIDDLE,FALSE)
	    END;
	END;
    END;
END; (* jumpmarker *)

BEGIN (* jump *)
  PROMPTLINE:=' JUMP: Begin End Marker <'+esckey+'>';   { 3.0 ITF fix 4/6/84 }
  EPROMPT;
  NEEDPROMPT:=TRUE;  (* Need to redisplay EDIT: promptline! *)
  REPEAT
    CH:=UCLC(GETCH);
    if streaming and not(ch in ['B','E','M',chr(escc)]) then
      begin
	msg:='Illegal Jump option.';
	putmsg;
	escape(-1);
      end;
    IF CH='B' THEN
      BEGIN
	CURSOR:=1;
	GETLEADING;
	CURSOR:=STUFFSTART;
	CENTERCURSOR(TRASH,1,FALSE)
      END
    ELSE
      IF CH='E' THEN
	BEGIN
	  CURSOR:=BUFCOUNT-1;
	  CENTERCURSOR(TRASH,SCREENHITE-1,FALSE);
	END
      ELSE
	IF CH='M' THEN JUMPMARKER
	ELSE IF CH<>CHR(ESCC) THEN ERRWAIT;
  UNTIL (CH IN ['B','E','M',CHR(ESCC)]);
  NEXTCOMMAND;
END;

PROCEDURE DEFMACRO;
BEGIN
  WITH PAGEZERO DO
    IF FILLING AND NOT AUTOINDENT THEN
      BEGIN
	BLANKCRT(1);
	THEFIXER(CURSOR,REPEATFACTOR,TRUE);
	CENTERCURSOR(TRASH,MIDDLE,TRUE);
      END
    ELSE
      ERROR('Wrong environment',fatalifstreaming);
  COPYOK:=FALSE;
  SHOWCURSOR;
  NEXTCOMMAND;
END;

PROCEDURE SETMARKER;
LABEL 1;
VAR
  I,SLOT: INTEGER;
  MNAME: NAME;
BEGIN
  WITH PAGEZERO DO
    BEGIN
      NEEDPROMPT:=TRUE;
      GETNAME('Set',MNAME);
      IF MNAME<>'        ' THEN
	BEGIN
	  SLOT:=COUNT;
	  FOR I:=0 TO COUNT-1 DO
	    IF NAME[I]=MNAME THEN SLOT:=I;
	  IF SLOT >= 10 THEN
	    BEGIN
	      BLANKCRT(1);
	      FOR I:=0 TO COUNT-1 DO
		WRITELN(output,I:1,') ',NAME[I]);
	      MSG:='Marker ovflw.  Which one to replace?';
	      PUTMSG;
	      if streaming then escape(-1);
	      CH:=GETCH;
	      CENTERCURSOR(TRASH,MIDDLE,TRUE);
	      IF NOT (CH IN ['0'..'9']) THEN GOTO 1;
	      SLOT:=ORD(CH)-ORD('0')
	    END;
	  updated := true;
	  NAME[SLOT]:=MNAME;
	  poffset[3*slot]:=cursor div 65536;
	  poffset[3*slot+1]:= (cursor mod 65536) div 256;
	  poffset[3*slot+2]:= cursor mod 256;
	  IF SLOT=COUNT THEN COUNT:=COUNT+1
	END;
    END;
1:END;

PROCEDURE SETSTUFF;
VAR CH: CHAR;
BEGIN
  PROMPTLINE:=' Set: Env Mrk Prog Doc <'+esckey+'>';  {3.0 ITF fix 4/6/84 }
  EPROMPT; NEEDPROMPT:=TRUE;
  with pagezero do
  REPEAT
    CH:=UCLC(GETCH);
    if streaming and not(ch in ['E','M','P','D',CHR(ESCC)]) then
      begin
	msg:='Illegal Set option.';
	putmsg;
	escape(-1);
      end;

    case ch of

      'E': escape(103);

      'M': setmarker;

      'P': begin
	     updated := true;
	     autoindent := true;
	     filling := false;
	    {lmargin := 0;                            3.0 BUG #34  3/22/84 }
	    {rmargin := screenwid;                    3.0 BUG #34  3/22/84 }
	    {paramargin := 5;                         3.0 BUG #34  3/22/84 }
	     tokdef := true;
	     escape(103); { display the new defaults }
	   end;

      'D': begin
	     updated := true;
	     autoindent := false;
	     filling := true;
	    {lmargin := 0;                          3.0 BUG #34 3/22/84 }
	    {rmargin := screenwid;                  3.0 BUG #34 3/22/84 }
	    {paramargin := 15;                      3.0 BUG #34 3/22/84 }
	     tokdef := false;
	     escape(103);  { display the new defaults }
	   end;

      otherwise if ch <> chr(escc) then errwait;

    end;  { case ch of }
  UNTIL CH IN ['E','M','P','D',CHR(ESCC)]; { MCh: added 'P' and 'D' }
  SHOWCURSOR;
  NEXTCOMMAND;
END(* SETSTUFF *);

PROCEDURE VERIFY;
BEGIN
  CENTERCURSOR(TRASH,MIDDLE,TRUE);
  SHOWCURSOR;
  NEXTCOMMAND
END (* VERIFY *);

PROCEDURE XMACRO; { EXTENSIVELY MODIFIED FOR 3.0 BUG #7 }
{ FIX PRODUCES PROPER BEHAVIOR WHEN OPERATING PAST SCREENWIDTH }
{ ALSO ENHANCED TO ALLOW RIGHT ARROW MOVEMENT OF CURSOR  2/9/84 jws }
VAR
  SAVEC,I: INTEGER;
  SAVE:PACKED ARRAY [0..MAXSTRING] OF CHAR;
  c: char;        { working char only }                  { 2/9/84 jws }
  x,y: integer;
BEGIN
  PROMPTLINE:=' Xchnge: Text <bs> <'+esckey+'> aborts <'+exckey+'> accepts';
							 { 3.0 ITF fix }
  EPROMPT; NEEDPROMPT:=TRUE;
  SHOWCURSOR;
  SAVEC:=CURSOR;
  I:=0;
  actualXY(x,y);                                         { 3.0 BUG #7 }
  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 *)
	    x:=x-1;                 { new line position } { 3.0 BUG #7 }
	    if x<=screenwid then    { display if visible }   { 3.0 BUG #7 }
	      WRITE(output,CHR(BSS),EBUF^[CURSOR],CHR(BSS));
	  END
	  ELSE                                                { 2/9/84 jws }
	      WRITE(output, CHR(BELL))                        { 2/9/84 jws }
      END
    ELSE  BEGIN                                               { 2/9/84 jws }
       IF MAPTOCOMMAND(CH)=RIGHT                              { 2/9/84 jws }
	 THEN BEGIN                                           { 2/9/84 jws }
	   IF EBUF^[CURSOR]<>EOL                              { 2/9/84 jws }
	     THEN BEGIN                                       { 2/9/84 jws }
	       c:=EBUF^[CURSOR]; { save current char }        { 2/9/84 jws }
	       SAVE[I]:=c;                                    { 2/9/84 jws }
	       I:=I+1;                 { bump save ptr     }  { 2/9/84 jws }
	       CURSOR:=CURSOR+1;       { next cursor pos.  }  { 2/9/84 jws }
	       if x<=SCREENWID THEN WRITE(output,c);          { 2/9/84 jws }
	       x:=x+1;                                        { 2/9/84 jws }
	     END                                              { 2/9/84 jws }
	   ELSE                                               { 2/9/84 jws }
	     WRITE(output,CHR(BELL))                          { 2/9/84 jws }
	 END                                                  { 2/9/84 jws }
      ELSE                                                    { 2/9/84 jws }
	IF CH=EOL THEN
	  BEGIN
	    ERRWAIT;
	    SHOWCURSOR;
	  END
	ELSE
	  IF NOT (CH IN [CHR(ETXX),CHR(ESCC)])
	    THEN                                              { 2/9/84 jws }
	      IF (EBUF^[CURSOR]<>EOL)                         { 2/9/84 jws }
		THEN BEGIN
		  IF ch<' ' THEN CH:='?'; { handle control chars as ? }
		  SAVE[I]:=EBUF^[CURSOR];
		  I:=I+1;
		  EBUF^[CURSOR]:=CH;
		  CURSOR:=CURSOR+1;
		  if (x<=screenwid) THEN WRITE(output,CH);    { 3.0 BUG #7 }
		  x:=x+1;                                     { 3.0 BUG #7 }
		END
	      ELSE
		WRITE(output, CHR(BELL))                      { 2/9/84 jws }
    END { IF MAPTOCOMMAND=LEFT ELSE BEGIN }                   { 2/9/84 jws }
  UNTIL CH IN [CHR(ETXX),CHR(ESCC)];
  IF CH=CHR(etxx) THEN
    begin
      if cursor <> savec then
      begin
	updated := true;
	getleading;                             {11/29/88 DEW fix for defect}
	if CURSOR < STUFFSTART then             {11/29/88 DEW #FSDdt01798}
		CURSOR := STUFFSTART;           {11/29/88 DEW }
      end;
    end
  else
    BEGIN
      CURSOR:=SAVEC;
      MOVELEFT(SAVE[0],EBUF^[CURSOR],I);
      SHOWCURSOR;
      findxy(x,y);
      WRITE(output,SAVE:(min(screenwid-x+1,I))); SHOWCURSOR
    END;
  NEXTCOMMAND;
END (* XMACRO *);

PROCEDURE ZAPIT;
label 1;
var
  sizeofzap : integer;
BEGIN
  sizeofzap := abs(cursor-lastpat);
  IF (sizeofzap>80) and not streaming THEN
    BEGIN
      PROMPTLINE:= ' WARNING! Zap more than 80 chars? (y/n)';
      EPROMPT;
      NEEDPROMPT:=TRUE;
      IF UCLC(GETCH)<>'Y' THEN
	BEGIN
	  SHOWCURSOR;
	  NEXTCOMMAND;
	  goto 1;
	END;
    END;
  IF OKTODEL(MIN(CURSOR,LASTPAT),MAX(CURSOR,LASTPAT)) THEN
    BEGIN
      updated := true;
      COPYLINE:=FALSE;
      IF CURSOR>LASTPAT THEN
	MOVELEFT(EBUF^[CURSOR],EBUF^[LASTPAT],BUFCOUNT-CURSOR)
      ELSE
	MOVELEFT(EBUF^[LASTPAT],EBUF^[CURSOR],BUFCOUNT-LASTPAT);
      BUFCOUNT:=BUFCOUNT-sizeofzap;
      if cursor>lastpat then CURSOR:=LASTPAT;
      READJUST(CURSOR,-sizeofzap);
      CENTERCURSOR(TRASH,MIDDLE,TRUE);
    END;
  SHOWCURSOR;
  NEXTCOMMAND;
1: END;

PROCEDURE INSERTIT;
CONST
  FUDGEFACTOR=10;
VAR
  THEREST,LEFTPART,SAVEBUFCOUNT: EPTRTYPE;
  CLEARED,WARNED,OK,EXITPROMPT,NOTEXTYET,FIRSTLINE: BOOLEAN;
  SPACES,LMOVE,X,LINE,EOLDIST,RJUST: INTEGER;
  CONTEXT: PACKED ARRAY [0..MAXSTRING] OF CHAR;
  myspaces: boolean; { added 1/5/82 jws }
  didspecialpopov: boolean;   {added 9/14/83 jws}
  popovlen: integer;          {added 9/14/83 jws}
  popovptr: eptrtype;         {added 9/14/83 jws}


PROCEDURE SLAMRIGHT;
(* Move (slam) the portion of the EBUF^ to the right of (and including)
   the cursor so that the last NUL in the file (EBUF^[BUFCOUNT]) is now at
   EBUF^[BUFSIZE].  THEREST points to the beginning of the right-justified
   text. *)
BEGIN
  GETLEADING;
  THEREST:=BUFSIZE-(BUFCOUNT-CURSOR);
  LMOVE:=BUFCOUNT-CURSOR+1;
  MOVERIGHT(EBUF^[CURSOR],EBUF^[THEREST],LMOVE);
  GETLEADING; (* Set blanks *)
  IF THEREST-CURSOR<MAXSTRING THEN
    BEGIN
      ERROR('No room to insert.',fatalifstreaming);
      SHOWCURSOR;
      NEXTCOMMAND;
      escape(104);
    END;
  (* Optional indentation *)
  EBUF^[THEREST-2]:=CHR(DLE);
  EBUF^[THEREST-1]:=CHR(BLANKS+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: EPTRTYPE;
    LNGTH: INTEGER;
BEGIN
  WITH PAGEZERO DO
    IF NOTEXTYET AND (NOT FIRSTLINE) AND
       ((NOT FILLING) OR AUTOINDENT) AND (CH<>CHR(ESCC))
    THEN (* We want the blanks before THEREST *)
      BEGIN
	getleading; {added 1/5/82 jws}
	BUFCOUNT:=BUFCOUNT+2;
	THEREST:=THEREST-2;
	LMOVE:=LMOVE+2;
	CURSOR:=SCAN(-MAXCHAR,=EOL,EBUF^[CURSOR-1])+CURSOR;
	if myspaces then ebuf^[therest+1]:=chr(blanks+32); { jws 1/5/82 }
      END;
  MOVELEFT(EBUF^[THEREST],EBUF^[CURSOR],LMOVE);
  READJUST(LEFTPART+1,CURSOR-(LEFTPART+1));
  BUFCOUNT:=BUFCOUNT+(CURSOR-(LEFTPART+1));               {scs  3/20/80}
  WITH PAGEZERO DO
    begin
      IF FILLING AND NOT AUTOINDENT AND (CH=CHR(ETXX)) THEN
	BEGIN
	  THEFIXER(CURSOR,1,FALSE);        { 3.0 BUG #5  -- REMOVED FIX 4/27}
	  FIRSTLINE:=FALSE;
	  FINDXY(X,LINE);
	END;
      UPSCREEN(FIRSTLINE,
	       EXITPROMPT OR (CH=CHR(ESCC)) OR (FILLING AND NOT AUTOINDENT),
	       LINE);
    end;
  GETLEADING;
  CURSOR:=MAX(CURSOR,STUFFSTART);
  LASTPAT:=LEFTPART+1;
  movetobuf(cursor,lastpat);
  NEXTCOMMAND
END;

FUNCTION CHECK(VALUE:INTEGER): BOOLEAN;
  (* VALUE is the potential value of the cursor.  If it is not in legal
     range then CHECK is false.  This function also warns the user if
     s/he is getting too close to overflowing the buffer *)
BEGIN
  CHECK:=TRUE;
  IF VALUE<=LEFTPART THEN
    BEGIN
      OK:=FALSE;  CHECK:=FALSE;
      if not streaming then
	begin
	  ERROR('Can''t backup.',NONFATAL); EPROMPT;
	end;
      fgotoxy(output,X,LINE)
    END
  ELSE
    IF VALUE>=THEREST-MAXCHAR THEN
      BEGIN
	IF NOT WARNED THEN
	  BEGIN
	    if not streaming then
	      begin
		ERROR('Finish the insertion',NONFATAL); EPROMPT;
	      end;
	    fgotoxy(output,X,LINE);
	    WARNED:=TRUE
	  END;
	IF VALUE>THEREST-FUDGEFACTOR THEN
	  BEGIN
	    ERROR('Buffer Overflow!!!!',fatalifstreaming);
	    WRAPUP;
	    escape(104);
	  END
      END
END;

PROCEDURE SPACEOVER;
(* This procedure handles spaces and tabs inserted into the buffer *)
BEGIN
  IF CH=CHR(HT) THEN SPACES:=8-X+(x div 8)*8 {WAH 4/9/80} ELSE SPACES:=1;
  IF CHECK(CURSOR+SPACES) THEN
    BEGIN
      FILLCHAR(EBUF^[CURSOR],SPACES,' ');
      CURSOR:=CURSOR+SPACES;
      if notextyet then myspaces:=true; {jws 1/5/82}
    END
END;

PROCEDURE FIXUP; FORWARD;

PROCEDURE ENDLINE;
(* First, if there was no text inserted on the current line, then convert
   all of the spaces to blank compression codes.  Then insert an <EOL> into
   the buffer followed by the appropriate number of spaces for the
   indentation. *)
BEGIN
  WITH PAGEZERO DO
    BEGIN
      IF NOTEXTYET THEN FIXUP;
      EBUF^[CURSOR]:=EOL;
      IF AUTOINDENT THEN GETLEADING
      ELSE
	IF FILLING THEN
	  BEGIN
	    GETLEADING;
	    IF EBUF^[STUFFSTART]=EOL THEN (* Empty line *)
	      BLANKS:=PARAMARGIN
	    ELSE BLANKS:=LMARGIN
	  END
	ELSE BLANKS:=0;
      IF CHECK(CURSOR+BLANKS+1) THEN
	BEGIN
	  FILLCHAR(EBUF^[CURSOR+1],BLANKS,' ');
	  CURSOR:=CURSOR+BLANKS+1
	END;
      NOTEXTYET:=TRUE;
      myspaces:=false;
    END;
END;

PROCEDURE BACKUP;
(* If the CH is a backspace then decrement cursor by 1.  If this would
   result in backing over an <EOL> or a blank compression code, then fall
   into the code for a <DEL> (also changing the CH to <DEL> for communication
   to the outer block)  *)
VAR PTR: EPTRTYPE;
BEGIN
  IF (CH=CHR(BSS)) AND
     NOT( (EBUF^[CURSOR-2]=CHR(DLE)) OR (EBUF^[CURSOR-1]=EOL) ) THEN
    BEGIN
      IF CURSOR<LEFTPART+2 THEN OK:=FALSE
      ELSE CURSOR:=CURSOR-1;
    END
  ELSE
    BEGIN (* A <DEL> or equivalent *)
      CH:=CHR(DELL); (* Tell the CRT driver that the line has changed *)
      GETLEADING;
      IF CHECK(LINESTART-1) THEN CURSOR:=LINESTART-1;
      NOTEXTYET:=FALSE; (* thank you shawn! *)
    END
END;

PROCEDURE FIXUP;
(* Convert the indentation spaces into blank compression codes, and move
   the current line around accordingly *)
label 1;
BEGIN
  (* First compress the current line *)
  EBUF^[CURSOR]:=EOL; (* Fool Getleading *)
  GETLEADING;
  IF BYTES >= 2 THEN (* OK to put in <DLE> # as it stands *)
    MOVELEFT(EBUF^[STUFFSTART],EBUF^[LINESTART+2],CURSOR-STUFFSTART)
  ELSE
    IF CHECK(CURSOR+2-BYTES) THEN
      MOVERIGHT(EBUF^[STUFFSTART],EBUF^[STUFFSTART+2-BYTES],CURSOR-STUFFSTART)
    ELSE BEGIN OK:=FALSE; goto 1;  END;
  CURSOR:=CURSOR-(BYTES-2);
  EBUF^[LINESTART]:=CHR(DLE);
  EBUF^[LINESTART+1]:=CHR(32+BLANKS);
1: END;

PROCEDURE INSERTCH;
  (* This procedure inserts a single character into the buffer. It also
     handles all of the control codes (EOL,BS,DEL) and buffer over- and
     under- flow conditions.  INSERTCH is called by the CRT handler *)
BEGIN
  REPEAT
  OK:=TRUE; (* No errors that invalidate the current character have occured *)
  CH:=GETCH;
  IF MAPTOCOMMAND(CH)=LEFT THEN CH:=CHR(BSS);
  IF ORD(CH) IN [SP,HT,CR,BSS,DELL,ETXX,ESCC] THEN
    BEGIN
      (* <etx> and <esc> are handled in the body of insertit *)
      IF ORD(CH) IN [SP,HT] THEN SPACEOVER
      ELSE
	IF CH=EOL THEN ENDLINE
	ELSE
	  IF ORD(CH) IN [BSS,DELL] THEN BACKUP;
    END
  ELSE
    BEGIN (* A character to insert! *)
{notice commented out code to allow underlining  Husni 12/12/79}
      IF (CH<'!') {OR (CH>'~')} THEN CH:='?'; (* No non-printing characters *)
      IF NOTEXTYET THEN FIXUP;
      IF CHECK(CURSOR+1) AND OK THEN
	BEGIN
	  NOTEXTYET:=FALSE;
	  EBUF^[CURSOR]:=CH;
	  CURSOR:=CURSOR+1
	END;
    END;
 UNTIL OK;
END;

PROCEDURE POPDOWN;
(* Displays CONTEXT, doing an implied scrollup if nec. *)
BEGIN
  IF CLEARED THEN ERASETOEOL(X,LINE)
  ELSE BEGIN CLEARED:=TRUE; EERASEOS(X,LINE) END;
  fgotoxy(output,RJUST,LINE);
  ERASETOEOL(RJUST,LINE);
  WRITE(output,CHR(LF));
  IF LINE=SCREENHITE THEN BEGIN EXITPROMPT:=TRUE; LINE:=SCREENHITE-1 END;
  WRITE(output,CONTEXT:(min(screenwid-rjust+1,EOLDIST)));
  FIRSTLINE:=FALSE; (* Says that the whole screen has been affected. *)
END;

PROCEDURE WRITESP(CH:CHAR;HOWMANY:INTEGER);
BEGIN
  IF X+HOWMANY<=SCREENWID THEN WRITE(output,CH:HOWMANY);
  IF X+HOWMANY>=SCREENWID THEN
    BEGIN
      fgotoxy(output,SCREENWID,LINE);
      IF X+HOWMANY>SCREENWID THEN
	BEGIN
	  WRITE(output,'!');
	  fgotoxy(output,SCREENWID,LINE);
	END
    END;
  X:=X+HOWMANY
END;

PROCEDURE CLEANSCREEN;
(* Code to, if possible, only erase the line, otherwise clear
   the screen.  Then call popdown *)
BEGIN
  FIRSTLINE:=FALSE;
  IF CLEARED THEN
    BEGIN
      IF X<SCREENWID THEN ERASETOEOL(X,LINE)
    END
  ELSE
    BEGIN
      CLEARED:=TRUE;
      EERASEOS(X,LINE);
    END;
  LINE:=LINE+1;
  IF LINE>SCREENHITE THEN
    BEGIN
      LINE:=LINE-1;
      WRITELN(output);
      EXITPROMPT:=TRUE
    END;
  IF EOLDIST<>0 THEN POPDOWN
END;

PROCEDURE POPOV;
(* When in filling mode, this procedure is called when a line is overflowed
   (X >= rightmargin).  The word is scanned off and "popped" down to the
   next line. *)
label 1;
VAR
  i: integer;
  WLENGTH: INTEGER;
  SAVE,PTR: EPTRTYPE;
  WORD: PACKED ARRAY [0..MAXSW] OF CHAR;
BEGIN
  IF NOTEXTYET THEN FIXUP;
  {following stmt mod 12/18/81 by jws}
  PTR:=max(SCAN(-MAXCHAR,=' ',EBUF^[CURSOR-1]),
	 max(scan(-maxchar,=eol,ebuf^[cursor-1]),
	     scan(-maxchar,=chr(dle),ebuf^[cursor-1])+1))+CURSOR;
  WLENGTH:=CURSOR-PTR;
  WITH PAGEZERO DO IF WLENGTH>=RMARGIN-LMARGIN THEN
    BEGIN
      WRITESP(CH,1);
      goto 1;
    END;
  fgotoxy(output,min(screenwid,X)-WLENGTH+1,LINE);
  ERASETOEOL(min(screenwid,X)-WLENGTH+1,LINE);
  MOVERIGHT(EBUF^[PTR],EBUF^[PTR+3],WLENGTH);
  MOVELEFT(EBUF^[PTR+3],WORD,WLENGTH);
  if (not didspecialpopov) and (ptr<=leftpart) then begin   {jws 9/14/83}
      popovptr:=ptr;                                        {jws 9/14/83}
      popovlen:=wlength;                                    {jws 9/14/83}
      leftpart:=leftpart+3;                                 {jws 9/14/83}
      savebufcount:=savebufcount+3;                         {jws 9/14/83}
      didspecialpopov:=true;                                {jws 9/14/83}
  end;                                                      {jws 9/14/83}
  CURSOR:=CURSOR+3;
  EBUF^[PTR]:=EOL;
  EBUF^[PTR+1]:=CHR(DLE);
  WITH PAGEZERO DO IF AUTOINDENT THEN
    BEGIN
      SAVE:=CURSOR; (* Set blanks to the indentation of the line above *)
      CURSOR:=PTR;
      GETLEADING;
      CURSOR:=SAVE;
      if (blanks+wlength)>=rmargin then
	blanks:=lmargin; {jws 12/18/81}
    END
  ELSE
    BLANKS:=LMARGIN;
  EBUF^[PTR+2]:=CHR(BLANKS+32);
  CLEANSCREEN;
  X:=BLANKS;
  fgotoxy(output,X,LINE);
  if (x+wlength)<=screenwid then
    begin
      WRITE(output,WORD:WLENGTH);
      X:=X+WLENGTH;
    end
  else
    for i:=1 to wlength do
      writesp(word[i-1],1);
  NOTEXTYET:=FALSE;
1: END;


BEGIN (* INSERT *)
try
  didspecialpopov:=false;          { jws 9/14/83 }
  iflag:=true; (*WAH 1/18/80*)
  myspaces:=false; { jws 1/5/82 }
  CLEARED:=FALSE;
  EOLDIST:=SCAN(MAXCHAR,=EOL,EBUF^[CURSOR]);
  MOVELEFT(EBUF^[CURSOR],CONTEXT[0],min(maxstring+1,EOLDIST));
  RJUST:=max(SCREENWID-EOLDIST,0);
  SLAMRIGHT;
  SAVEBUFCOUNT:=BUFCOUNT;
  PROMPTLINE:=INSERTPROMPT;
  EPROMPT;
  EXITPROMPT:=FALSE;
  NEEDPROMPT:=TRUE;
  LEFTPART:=CURSOR-1;
  NOTEXTYET:=FALSE;
  FINDXY(X,LINE);
  fgotoxy(output,X,LINE);
  ERASETOEOL(X,LINE);
  FIRSTLINE:=TRUE;
  IF EOLDIST<>0 THEN (* A context needs to be displayed *)
    IF RJUST>X THEN (* and it will fit on the current line ... *)
      BEGIN
	fgotoxy(output,RJUST,LINE);
	WRITE(output,CONTEXT:EOLDIST);
	fgotoxy(output,X,LINE)
      END
    ELSE (* and it won't fit on the current line *)
      BEGIN
	FIRSTLINE:=FALSE;
	EERASEOS(X,LINE);(* Clear the screen *)
	WRITELN(output);
	IF LINE=SCREENHITE THEN
	  BEGIN
	    LINE:=SCREENHITE-1;
	    EXITPROMPT:=TRUE;
	  END;
	fgotoxy(output,RJUST,LINE+1);
	WRITE(output,CONTEXT:(min(screenwid-rjust+1,EOLDIST)));
	fgotoxy(output,X,LINE)
      END;
  REPEAT
    INSERTCH;
    IF NOT (ORD(CH) IN [CR,ETXX,ESCC,DELL]) THEN
      BEGIN
	IF TRANSLATE[CH]=LEFT THEN
	  BEGIN
	    IF X<=SCREENWID THEN
	      WRITE(output,CHR(BSS),' ',CHR(BSS));
	    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=SCREENWID-8) AND (CH<>CHR(BSS))
	  THEN WRITE(output,CHR(BELL));
	IF (EOLDIST<>0) AND
	   (X>=RJUST) AND FIRSTLINE THEN  (*ran into context *)
	  BEGIN
	    POPDOWN;
	    fgotoxy(output,min(X,screenwid),LINE)
	  END;
      END
    ELSE (* ch in [eol,etxx,escc,dell] *)
      BEGIN
	IF CH=EOL THEN
	  BEGIN
	    CLEANSCREEN;
	    X:=BLANKS;
	    fgotoxy(output,X,LINE);
	  END
	ELSE
	  IF CH=CHR(DELL) THEN
	    BEGIN
	      IF LINE<=1 THEN  (* Rubbed out all of what was on the screen *)
		BEGIN
		  BUFCOUNT:=CURSOR+1;
		  EBUF^[CURSOR]:=EOL;
		  CENTERCURSOR(LINE,MIDDLE,TRUE);
		  IF EOLDIST<>0 THEN POPDOWN;
		  IF EXITPROMPT THEN
		    BEGIN
		      EPROMPT;
		      EXITPROMPT:=FALSE;
		    END
		END
	      ELSE
		BEGIN
		  fgotoxy(output,0,LINE);
		  CLEARED:=FALSE;
		  ERASETOEOL(0,LINE);
		  LINE:=LINE-1;
		END;
	      GETLEADING;
	      X:=BLANKS-BYTES+CURSOR-LINESTART;
	      fgotoxy(output,X,LINE);
	    END;
      END;
  UNTIL CH IN [CHR(ETXX),CHR(ESCC)];
  IF CH=CHR(ESCC) THEN
    if not didspecialpopov then                               {jws 9/14/83}
      CURSOR:=LEFTPART+1
    else begin                                                {jws 9/14/83}
      moveleft(ebuf^[popovptr+3], ebuf^[popovptr], popovlen); {jws 9/14/83}
      leftpart:=leftpart-3;                                   {jws 9/14/83}
      cursor:=leftpart+1;                                     {jws 9/14/83}
      savebufcount:=savebufcount-3;                           {jws 9/14/83}
      didspecialpopov:=false;                                 {jws 9/14/83}
    end                                                       {jws 9/14/83}
  else
    if cursor <> leftpart + 1 then
      updated := true;
  BUFCOUNT:=SAVEBUFCOUNT;
  WRAPUP;
recover
  if escapecode<>104 then escape(escapecode);
END;


PROCEDURE MOVEIT;
VAR
  SCROLLMARK,X,LINE,I: INTEGER;
  EXITPROMPT: BOOLEAN; (* Prompt after leaving Moveit! *)
  OLDLINE,OLDX: INTEGER;
  NEWDIST,DIST: INTEGER;
  DOFFSCREEN,ATEND,INREPLACE,INDELETE: BOOLEAN;
  PTR,ANCHOR,OLDCURSOR: EPTRTYPE;
  deltaline: integer;  { used only for left moves }
  doresolve: boolean;   { don't resolve when went off page}
  xtemp: integer;


PROCEDURE SCROLLUP(BOTTOMLINE:EPTRTYPE; HOWMANY: INTEGER);
(* bottomline is the "linestart" of the line to be scrolled up *)
VAR
  PTR: EPTRTYPE;
  I: INTEGER;
BEGIN
  (* DISPLAY THE NEXT LINE ON THE BOTTOM OF THE SCREEN *)
  I:=0;
  PTR:=SCAN(MAXCHAR,=EOL,EBUF^[LINE1PTR])+LINE1PTR+1;
  WHILE (I<HOWMANY) AND (PTR<BUFCOUNT) DO
    BEGIN
      LINE1PTR:=PTR;
      PTR:=SCAN(MAXCHAR,=EOL,EBUF^[PTR])+PTR+1;
      I:=I+1
    END;
  I:=0;
  fgotoxy(output,0,SCREENHITE);
  REPEAT
    I:=I+1;
    BLANKS:=LEADBLANKS(BOTTOMLINE,BYTES);
    if syscom^.miscinfo.haslccrt then doupscroll
    else WRITE(output,CHR(LF));
    LINEOUT(BOTTOMLINE,BYTES,BLANKS,SCREENHITE);
    LINE:=LINE-1;
  UNTIL (I>=HOWMANY) OR (BOTTOMLINE>=BUFCOUNT);
  EXITPROMPT:=not(syscom^.miscinfo.haslccrt);
END(* SCROLLUP *);

procedure scrolldown;
var ptr: eptrtype;
begin
  line:=0;
  IF EBUF^[CURSOR]=EOL THEN PTR:=CURSOR
  ELSE PTR:=CURSOR+1;
  ptr:=ptr-1;
  ptr:=ptr+scan(-maxchar,=eol,ebuf^[ptr])+1;
  line1ptr:=ptr;
  getleading;
  BLANKS:=MIN(LEADBLANKS(PTR,BYTES),SCREENWID);
  if ptr>= 1 then
    begin
      if syscom^.miscinfo.haslccrt then dodownscroll
      else  WRITE(OUTPUT,CHR(31));
      line:=line+1;
      fgotoxy(output,0,LINE);
      ERASETOEOL(0,LINE);             (* Clean the line *)
      LINEOUT(PTR,BYTES,BLANKS,LINE); (* Writes out the line at ptr *)
    end;
  exitprompt:=not(syscom^.miscinfo.haslccrt);
end;


PROCEDURE CLEAR(X1,Y1,X2,Y2: INTEGER); FORWARD;

PROCEDURE CENTER;
label 1;
var xanch,yanch: integer;

function anchoronscreen: boolean;
 var save: eptrtype;
begin
  save:=cursor;
  cursor:=anchor;
  findxy(xanch,yanch);
  cursor:=save;
  if (yanch>=1) and (yanch<=screenhite) and (xanch>=0) then
    anchoronscreen:=true
  else anchoronscreen:=false;
end;


BEGIN
  IF INDELETE THEN
    BEGIN
      if line>screenhite then
	begin
	  centercursor(line,1,true);
	  findxy(x,line);
	  if (dist>=0) and (cursor>anchor) then
	    begin
	      if x>0 then clear(0,1,max(x-1,0),line)
	    end
	  else
	    if cursor<anchor then
	      if anchoronscreen then
		begin
		  if xanch=0 then
		    begin
		      yanch:=max(1,yanch-1);
		      xanch:=screenwid
		    end;
		  clear(x,line,max(0,xanch-1),yanch)
		end
	      else
		begin
		  fgotoxy(output,x,line);
		  write(output,chr(11));
		end
	    else
	      if anchoronscreen then begin
		if (cursor<>anchor) then clear(xanch,yanch,max(x-1,0),line)
	      end
	      else begin if x<>0 then clear(0,1,max(x-1,0),line) end
	end
      else
	begin
	  centercursor(line, screenhite, true);
	  findxy(x,line);
	  if (dist<=0) and (cursor<anchor) then
	    begin
	      fgotoxy(output,x,line);
	      write(output,chr(11));
	    end
	  else
	    if cursor>anchor then
	      if anchoronscreen then
		if x>0 then clear(xanch,yanch,max(x-1,0),line)
		else clear(xanch,yanch, screenwid, line-1)
	      else
		if x>0 then clear(0,1,max(x-1,0),line)
		else clear (0,1,screenwid,line-1)
	    else
	      if anchoronscreen then
		begin
		  if cursor<>anchor then clear(x,line,max(0,xanch-1),yanch)
		end
	      else
		begin
		  fgotoxy(output,x,line);
		  write(output,chr(11));
		end
	end;
      doresolve:=false;
      DOFFSCREEN:=TRUE;
      fgotoxy(output,x,line);
    END
  ELSE
    if (((ecommand=up) or (ecommand=advance)) and (repeatfactor<=1))
      or ((ecommand=left) and (deltaline=1)) then
	if screenn.candownscroll then
	  begin
	    scrolldown;
	    goto 1;
	  end
	else centercursor(line,oldline,true)
    else
      IF (ECOMMAND=PARAC) AND ((DIRECTION='<') OR
       (LINE MOD SCREENHITE=OLDLINE)) OR (line mod screenhite=0)
	THEN CENTERCURSOR(LINE,OLDLINE,TRUE)
	ELSE CENTERCURSOR(LINE,MIDDLE,TRUE);
  IF EXITPROMPT AND (ECOMMAND<>QUITC) THEN
    BEGIN
      EPROMPT;
      EXITPROMPT:=FALSE;
    END;
1:OLDLINE:=LINE;
  OLDX:=X;
END;



PROCEDURE UPMOVE;
VAR I:INTEGER;
BEGIN
  I:=1;
  GETLEADING;
  (* FIND THE LINE FIRST *)
  WHILE (I<=REPEATFACTOR) AND (LINESTART>1) DO
    BEGIN
      CURSOR:=LINESTART-1; (* LAST CHAR OF LINE ABOVE *)
      GETLEADING;
      LINE:=LINE-1;  I:=I+1;
    END;
  (* If possible set the cursor at the same x coord we came from.  Otherwise,
     set it either to the beginning of the buffer, the beginning of text
     on that line, or the end of the text on that line *)
  CURSOR:=
	   MAX(1,     (* The beginning of the buffer *)
	       MAX(STUFFSTART,  (* The beginning of the text *)
		   MIN(X-BLANKS+BYTES+LINESTART, (* same col *)
		       SCAN(MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR (* eol *)
		      )
		   )
	       );
  IF LINE<1 THEN CENTER;
  if indelete then findxy(x,line);
END(* UPALINE *);

PROCEDURE DOWNMOVE;
VAR
  I: INTEGER;
  NEXTEOL: EPTRTYPE;
BEGIN
  I:=1;
  NEXTEOL:=SCAN(MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR;
  WHILE (NEXTEOL<BUFCOUNT-1) AND (I<=REPEATFACTOR) DO
    BEGIN
      CURSOR:=NEXTEOL+1;
      NEXTEOL:=SCAN(MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR;
      IF NEXTEOL<BUFCOUNT THEN
	BEGIN
	  LINE:=LINE+1;
	  I:=I+1;
	  IF LINE=SCREENHITE+1 THEN
	    BEGIN
	      SCROLLMARK:=CURSOR;
	    END;
	END;
    END;
  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 *)
		 MAX(STUFFSTART,    (* Not in the indentation *)
		     MIN(X-BLANKS+BYTES+LINESTART (* Where it wants to be *)
			,SCAN(MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR
			)
		     )
	      );
  IF LINE>SCREENHITE THEN
    IF (LINE-SCREENHITE>=SCREENHITE) OR (INDELETE) THEN
      CENTER
    ELSE
      SCROLLUP(SCROLLMARK,LINE-SCREENHITE);
  if indelete then findxy(x,line);
END(* DOWNMOVE *);

PROCEDURE LEFTMOVE;
BEGIN
  deltaline:=0;
  GETLEADING; (* SET LINESTART AND STUFFSTART *)
  WHILE (STUFFSTART>CURSOR-REPEATFACTOR)
	and (linestart>1) DO
    BEGIN
      REPEATFACTOR:=REPEATFACTOR-(CURSOR-STUFFSTART+1); (* CHARS MOVED OVER *)
      IF EBUF^[CURSOR]=EOL THEN CURSOR:=CURSOR-1;
      CURSOR:=MAX(SCAN(-MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR,1);
      LINE:=LINE-1;
      deltaline:=deltaline+1;
      GETLEADING; (* RESET LINESTART AND STUFFSTART *)
    END;
  CURSOR:=MAX(STUFFSTART,MAX(CURSOR-REPEATFACTOR,1));
  IF LINE<1 THEN CENTER;
  FINDXY(X,LINE);
END (* LEFTMOVE *);

PROCEDURE RIGHTMOVE;
VAR
  EOLPTR: EPTRTYPE;
BEGIN
  EOLPTR:=SCAN(MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR;
  WHILE (EOLPTR<CURSOR+REPEATFACTOR) AND (EOLPTR<BUFCOUNT-1) DO
    BEGIN
      REPEATFACTOR:=REPEATFACTOR-(EOLPTR-CURSOR+1);
      CURSOR:=EOLPTR+1; (* BEGINNING OF THE LINE BELOW *)
      GETLEADING;
      CURSOR:=STUFFSTART;
      LINE:=LINE+1;
      IF LINE=SCREENHITE+1 THEN SCROLLMARK:=LINESTART;
      EOLPTR:=SCAN(MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR
    END;
  CURSOR:=MIN(BUFCOUNT-1,CURSOR+REPEATFACTOR);
  IF LINE>SCREENHITE THEN
    IF (LINE-SCREENHITE>=SCREENHITE) OR (INDELETE) THEN
      CENTER
    ELSE
      SCROLLUP(SCROLLMARK,LINE-SCREENHITE);
  FINDXY(X,LINE);
END(* RIGHTMOVE *);

PROCEDURE LINEMOVE(REPEATFACTOR: INTEGER);
VAR I, oldcursor: INTEGER;
BEGIN
  ATEND:= (CURSOR >= BUFCOUNT-1);
  I:=1;
  IF DIRECTION='<' THEN
    BEGIN
      WHILE (I<=REPEATFACTOR) AND (CURSOR>1) DO
	BEGIN
	  IF EBUF^[CURSOR]=EOL THEN CURSOR:=CURSOR-1; (* NULL LINE CASE *)
	  CURSOR:=SCAN(-MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR; (* 1 UP *)
	  IF CURSOR>=1 THEN BEGIN LINE:=LINE-1; I:=I+1 END;
	END;
      CURSOR:=MAX(1,CURSOR); (* BACK INTO REALITY *)
      ATEND:= (CURSOR=1);
      IF LINE<1 THEN CENTER
    END
  ELSE
    BEGIN (* DIRECTION='>' *)
      oldcursor:=cursor;
      WHILE (I<=REPEATFACTOR) AND (CURSOR<BUFCOUNT-1) DO
	BEGIN
	  oldcursor:=cursor;
	  CURSOR:=SCAN(MAXCHAR,=EOL,EBUF^[CURSOR])+CURSOR+1; (*1 DOWN *)
	  ATEND:= (CURSOR >= BUFCOUNT);
	  if ATEND then
	    cursor := oldcursor
	  else
	    BEGIN
	      LINE:=LINE+1;
	      IF LINE=SCREENHITE+1 THEN SCROLLMARK:=CURSOR;
	    END;
	  I:=I+1;
	END;
      IF LINE>SCREENHITE THEN
	IF (LINE-SCREENHITE>=SCREENHITE) OR (ECOMMAND=PARAC)
	   OR INREPLACE OR INDELETE
	  THEN
	    CENTER
	  ELSE SCROLLUP(SCROLLMARK,LINE-SCREENHITE);
      CURSOR:=MIN(CURSOR,BUFCOUNT-1)
    END;
  if atend and (direction='>') then cursor:=oldcursor
  else
    begin
      GETLEADING;
      CURSOR:=STUFFSTART; (* FORCED TO BEGINNING OF STUFF *)
      X:=BLANKS;
    end;
END(* LINEMOVE *);

PROCEDURE JUMPBEGIN;
BEGIN
  CURSOR:=1;
  GETLEADING;                                       { 3.0 BUG #3 }
  CURSOR:=STUFFSTART;                               { 3.0 BUG #3 }
  CENTERCURSOR(TRASH,1,FALSE)
END;

PROCEDURE JUMPEND;
BEGIN
  CURSOR:=BUFCOUNT-1;
  CENTERCURSOR(TRASH,SCREENHITE,FALSE)
END;

PROCEDURE ADJUSTING;
LABEL 1;
TYPE
  MODES=(RELATIVE,LEFTJ,RIGHTJ,CENTER);
VAR
  LLENGTH,TDELTA,I: INTEGER;
  SAVEDIR: CHAR;
  MODE: MODES;

PROCEDURE DOIT(DELTA:INTEGER);
VAR
  EOLDIST: INTEGER;
  T: PACKED ARRAY [0..MAXSTRING] OF CHAR;
BEGIN
  GETLEADING; (* Set linestart, stuffstart, and blanks *)
  IF BLANKS+DELTA<0 THEN DELTA:=-BLANKS;
  IF (EBUF^[LINESTART]=CHR(DLE)) AND (STUFFSTART-LINESTART=2) THEN
    X:=ORD(EBUF^[LINESTART+1])+DELTA-32
  ELSE
    BEGIN
      IF STUFFSTART-LINESTART>2 THEN
	MOVELEFT(EBUF^[STUFFSTART],EBUF^[LINESTART+2],BUFCOUNT-STUFFSTART)
      ELSE
	BEGIN
	  IF BUFCOUNT>BUFSIZE-100 THEN
	    BEGIN
	      error('Buffer overflow',fatalifstreaming);
	      escape(105);
	    END
	  ELSE
	    MOVERIGHT(EBUF^[STUFFSTART],EBUF^[LINESTART+2],BUFCOUNT-STUFFSTART);
	END;
      IF LINESTART+2<>STUFFSTART THEN
	BEGIN
	  READJUST(LINESTART, LINESTART+2-STUFFSTART);
	  BUFCOUNT:=BUFCOUNT+(LINESTART+2-STUFFSTART);   {scs   3/20/80}
	END;
      EBUF^[LINESTART]:=CHR(DLE);
      X:=BLANKS+DELTA;
    END;
  if x>223 then x:=223; { don't wrap around ! }
  EBUF^[LINESTART+1]:=CHR(X+32);
  CURSOR:=LINESTART+2; GETLEADING;
  fgotoxy(output,0,LINE); ERASETOEOL(0,LINE); (* erase the line *)
  LINEOUT(LINESTART,BYTES,BLANKS,LINE); fgotoxy(output,X,LINE);
END(* DOIT *);

BEGIN (* adjusting *)
try
  updated := true;
  WITH PAGEZERO DO
    BEGIN
      SAVEDIR:=DIRECTION; EXITPROMPT:=FALSE; INDELETE:=FALSE; LASTPAT:=CURSOR;
      INREPLACE:=TRUE;
      PROMPTLINE:=ADJUSTPROMPT;
      EPROMPT; NEEDPROMPT:=TRUE;
      MODE:=RELATIVE;
      SHOWCURSOR;
      FINDXY(X,LINE);
      TDELTA:=0;
      REPEAT
	CH:=GETCH;
	ECOMMAND:=MAPTOCOMMAND(CH);
	INFINITY:=FALSE;
	IF ECOMMAND=SLASHC THEN
	  BEGIN
	    REPEATFACTOR:=1;
	    INFINITY:=TRUE;
	    CH:=GETCH;
	    ECOMMAND:=TRANSLATE[CH];
	  END
	ELSE
	  IF ECOMMAND=DIGIT THEN REPEATFACTOR:=GETNUM
	  ELSE REPEATFACTOR:=1;
	IF ECOMMAND IN [UP,DOWN] THEN
	  BEGIN
	    IF ECOMMAND=UP THEN DIRECTION:='<'
	    ELSE DIRECTION:='>';
	    I:=1;
	    ATEND:=FALSE;
	    WHILE NOT ATEND AND ((I<=REPEATFACTOR) OR INFINITY) DO
	      BEGIN
		I:=I+1;
		LINEMOVE(1);
		IF NOT ATEND THEN
		  BEGIN
		    IF MODE=RELATIVE THEN DOIT(TDELTA)
		    ELSE
		      BEGIN
			LLENGTH:=SCAN(MAXCHAR,=EOL,EBUF^[STUFFSTART]);
			CASE MODE OF
			  LEFTJ:  DOIT(LMARGIN-BLANKS);
			  RIGHTJ: DOIT((RMARGIN-LLENGTH+1)-BLANKS);
			  CENTER:
			  DOIT(((RMARGIN-LMARGIN+1)-LLENGTH) DIV 2-BLANKS+LMARGIN)
			  otherwise
			END (* case *)
		      END (* else *)
		  END; (* if not atend *)
	      END (* while ... *)
	  END
	ELSE
	  IF ECOMMAND=LEFT THEN
	    BEGIN
	      DOIT(-REPEATFACTOR);
	      TDELTA:=TDELTA-REPEATFACTOR;
	      MODE:=RELATIVE
	    END
	  ELSE
	    IF ECOMMAND=RIGHT THEN
	      BEGIN
		DOIT(REPEATFACTOR);
		TDELTA:=TDELTA+REPEATFACTOR;
		MODE:=RELATIVE
	      END
	    ELSE
	      IF ECOMMAND IN [LISTC,REPLACEC,COPYC] THEN
		BEGIN
		  GETLEADING;
		  LLENGTH:=SCAN(MAXCHAR,=EOL,EBUF^[STUFFSTART]);
		  IF ECOMMAND=LISTC THEN
		    BEGIN
		      MODE:=LEFTJ;
		      DOIT(LMARGIN-BLANKS);
		    END
		  ELSE
		    IF ECOMMAND=REPLACEC THEN
		      BEGIN
			MODE:=RIGHTJ;
			DOIT((RMARGIN-LLENGTH+1)-BLANKS);
		      END
		    ELSE (* ECOMMAND=COPYC *)
		      BEGIN
			MODE:=CENTER;
			DOIT(((RMARGIN-LMARGIN+1)-LLENGTH) DIV 2-BLANKS+LMARGIN)
		      END
		END
	      ELSE
	    IF CH<>CHR(ETXX) THEN
	      BEGIN
		ERRWAIT;
		SHOWCURSOR;
	      END;
      1: UNTIL CH=CHR(ETXX);
      DIRECTION:=SAVEDIR;
    END;
recover
  if escapecode<>105 then escape(escapecode);
END;

FUNCTION TABBY: INTEGER;
BEGIN
  IF REPEATFACTOR > 0 THEN
    IF DIRECTION = '>' THEN
      TABBY:=8*(REPEATFACTOR-1)+  8-X+(x div 8)*8 {WAH 4/9/80}
    ELSE
      BEGIN
	IF X=0 THEN TABBY:=REPEATFACTOR*8
	ELSE TABBY:=8*(REPEATFACTOR-1)+X-((x-1) div 8)*8; {WAH 4/9/80}
      END
  ELSE TABBY:=0;
END;

PROCEDURE MOVING;
VAR
  SAVEX: INTEGER;
BEGIN
  INDELETE:=FALSE;
  INREPLACE:=FALSE;
  EXITPROMPT:=FALSE;
  IF INFINITY THEN
    BEGIN
      CASE ECOMMAND OF
	UP,LEFT: JUMPBEGIN;
	DOWN,RIGHT: JUMPEND;
	SPACE,ADVANCE,TABB,parac: IF DIRECTION='<' THEN
				    JUMPBEGIN
				  ELSE JUMPEND
	otherwise
      END;
      NEEDPROMPT:=TRUE;
      NEXTCOMMAND;
      escape(107);
    END;
  FINDXY(X,LINE);
  REPEAT
    OLDX:=X;
    OLDLINE:=LINE;
    CASE ECOMMAND OF
      LEFT: LEFTMOVE;
      RIGHT: RIGHTMOVE;
      SPACE: IF DIRECTION='<' THEN
	       begin
		 ecommand:=left;
		 LEFTMOVE;
	       end
	       ELSE
		 begin
		   ecommand:=right;
		   RIGHTMOVE;
		 end;
      UP: UPMOVE;
      DOWN: DOWNMOVE;
      ADVANCE: LINEMOVE(REPEATFACTOR);
      PARAC:
	IF REPEATFACTOR>1000 THEN
	  error('Too many',fatalifstreaming)
	ELSE LINEMOVE(SCREENHITE*REPEATFACTOR);
      TABB: BEGIN
	     FINDXY(X,LINE);                         { 3.0 BUG }
	     IF REPEATFACTOR >= 4096 THEN
	       error('Too many',fatalifstreaming)
	     ELSE
	       BEGIN
		 REPEATFACTOR:=TABBY;
		 IF DIRECTION='<' THEN LEFTMOVE ELSE RIGHTMOVE;
		 SAVEX:=X+1;
		 WHILE (X<>SAVEX) AND (X MOD 8<>0) DO
		   BEGIN
		     SAVEX:=X;
		     REPEATFACTOR:=1;
		     IF DIRECTION='>' THEN RIGHTMOVE
		     ELSE LEFTMOVE;
		   END;
	       END;
	   END;
      otherwise
    END;
    fgotoxy(output,X,LINE);
    REPEATFACTOR:=1;
    NEXTCOMMAND
  UNTIL NOT (ECOMMAND IN [UP,DOWN,LEFT,RIGHT,ADVANCE,SPACE,TABB]);
  IF EXITPROMPT THEN EPROMPT;
  SHOWCURSOR;
END (* MOVING *);

PROCEDURE PUTITBACK(C1,C2: EPTRTYPE);
VAR
  PTR: EPTRTYPE;
  INDENT,LOFF: INTEGER;
BEGIN
  PTR:=C1;
  WHILE PTR<=C2 DO
    BEGIN
      IF EBUF^[PTR]=EOL THEN
	BEGIN
	  PTR:=PTR+1; WRITELN(output);
	  xtemp:=0;
	  INDENT:=LEADBLANKS(PTR,LOFF);
	  IF (PTR<C2) AND (INDENT>0) THEN
	    begin
	      while (xtemp<screenwid) and (indent>0) do
		begin
		  write(output,' ');
		  indent:=indent-1;
		  xtemp:=xtemp+1;
		end;
	      if (xtemp>=screenwid) and (indent>0) then
		begin
		  write(output,'!');
		  xtemp:=xtemp+1;
		end;
	    end;
	  ptr:=ptr+loff;
	end
	else
	  begin
	    if xtemp<screenwid then
	       write(output,ebuf^[ptr])
	    else
	      if xtemp=screenwid then
		write(output,'!');
	    ptr:=ptr+1;
	    xtemp:=xtemp+1;
	  end
    END;
END;

PROCEDURE CLEAR(*X1,Y1,X2,Y2: INTEGER*);
(* Screen co-ordinate (X1,Y1) is assumed to be before (X2,Y2).  This
   procedure takes these co-ordinates and clears (writes blanks) over
   the screen between them (inclusive)  *)
VAR XX,I: INTEGER;
BEGIN
  fgotoxy(output,X1,Y1);
  XX:=X1;
  FOR I:=Y1 TO Y2-1 DO
    BEGIN
      IF I<>0 THEN
	ERASETOEOL(XX,I);
      XX:=0;
      WRITELN(output);
    END;
  IF Y1<>Y2 THEN
    FOR I:=0 TO X2 DO WRITE(output,' ')
  ELSE FOR I:=X1 TO X2 DO WRITE(output,' ')
END;


PROCEDURE DELETING;
LABEL 1;
VAR
  ATBOL,SAVE: EPTRTYPE;
  OK,ATBOT,NOMOVE: BOOLEAN;
  STARTLINE: INTEGER;
  savex: integer;

PROCEDURE RESOLVESCREEN;
label 1;
VAR
  X1,X2,x3,Y1,Y2,y3,SAVE: INTEGER;
  C1,C2: EPTRTYPE;
BEGIN
  X1:=X;
  Y1:=LINE;
  X2:=OLDX;
  Y2:=OLDLINE;
  IF NEWDIST>DIST THEN
    BEGIN
      C1:=CURSOR-1;
      C2:=OLDCURSOR;
      if (y1<>y2) or (x1<>x2) then
	X1:=X1-1;
    END
  ELSE
    IF NEWDIST<DIST THEN
      BEGIN
	C2:=OLDCURSOR-1;
	C1:=CURSOR;
	if (x2<>x1) or (y1<>y2) then
	  X2:=X2-1;
      END
    ELSE
      goto 1;
  IF (Y1>Y2) OR ((Y1=Y2) AND (X1>X2)) THEN
    BEGIN
      SAVE:=C1; C1:=C2; C2:=SAVE;
      SAVE:=Y1; Y1:=Y2; Y2:=SAVE;
      SAVE:=X1; X1:=X2; X2:=SAVE
    END;
  if ((dist>0) and (cursor<anchor))
  or ((dist<0) and (cursor>anchor)) then
    begin
     save:=cursor;
     cursor:=anchor;
     findxy(x3,y3);
     cursor:=save;
     if cursor<anchor then
       begin
	 clear(x1,y1,x3,y3);
	 fgotoxy(output,x3,y3);
	 xtemp:=x3;
	 putitback(anchor, oldcursor-1);
       end
     else
       begin
	 fgotoxy(output,x1,y1);
	 xtemp:=x1;
	 putitback(oldcursor, anchor-1);
	 clear(x3,y3,x2,y2);
       end
    end
  else
    begin
      IF ABS(NEWDIST)>ABS(DIST) THEN
	CLEAR(X1,Y1,X2,Y2)
      ELSE
	BEGIN
	  fgotoxy(output,X1,Y1);
	  xtemp:=x1;
	  PUTITBACK(C1,C2)
	END
    end;
  fgotoxy(output,X,LINE);
1:END;
BEGIN
  iflag:=false; (*WAH 1/18/80*)
  DOFFSCREEN:=FALSE;
  INDELETE:=TRUE;
  INREPLACE:=FALSE;
  EXITPROMPT:=FALSE;
  ANCHOR:=CURSOR;
  NEWDIST:=0;
  GETLEADING;
  ATBOL:=LINESTART;
  ATBOT:=(CURSOR=STUFFSTART);
  PROMPTLINE:=DELETEPROMPT;
  EPROMPT;
  NEEDPROMPT:=TRUE;
  SHOWCURSOR;
  FINDXY(X,LINE);
  STARTLINE:=LINE;
  REPEAT
    doresolve:=true;
    OLDCURSOR:=CURSOR;
    DIST:=NEWDIST;
    OLDX:=X; OLDLINE:=LINE;
    CH:=GETCH;
    ECOMMAND:=TRANSLATE[CH];
    IF ECOMMAND=DIGIT THEN REPEATFACTOR:=GETNUM
    ELSE REPEATFACTOR:=1;
    IF ECOMMAND IN [REVERSEC..DIGIT,ADVANCE,SPACE] THEN
      BEGIN
	CASE ECOMMAND OF
	  LEFT: LEFTMOVE;
	  RIGHT: RIGHTMOVE;
	  SPACE: IF DIRECTION='<' THEN LEFTMOVE
		 ELSE RIGHTMOVE;
	  UP: UPMOVE;
	  DOWN: DOWNMOVE;
	  ADVANCE: LINEMOVE(REPEATFACTOR);
	  REVERSEC,FORWARDC:
	    BEGIN
	      IF ECOMMAND=REVERSEC THEN
		DIRECTION:='<'
	      ELSE
		DIRECTION:='>';
	      fgotoxy(output,0,0); WRITE(output,DIRECTION); fgotoxy(output,X,LINE)
	    END;
	  TABB:
	    BEGIN
	      IF REPEATFACTOR>=4096 THEN
		error('Too many',fatalifstreaming)
	      ELSE
		BEGIN
		  REPEATFACTOR:=TABBY;
		  IF DIRECTION='<' THEN LEFTMOVE
		  ELSE RIGHTMOVE;
		  SAVEX:=X+1;
		  WHILE (X<>SAVEX) AND (X MOD 8<>0) DO
		    BEGIN
		      SAVEX:=X;
		      REPEATFACTOR:=1;
		      IF DIRECTION='>' THEN RIGHTMOVE
		      ELSE LEFTMOVE
		    END
	       END
	    END
	  otherwise
	    begin
	      eprompt;
	      fgotoxy(output,x,line)
	    end
	END;
	NEWDIST:=CURSOR-ANCHOR;
	if doresolve then RESOLVESCREEN;
      END
    ELSE
      IF (CH<>CHR(ESCC)) AND (CH<>CHR(ETXX)) THEN
	BEGIN
	  ERRWAIT;
	  fgotoxy(output,X,LINE);
	END
  UNTIL (CH IN [CHR(ETXX),CHR(ESCC)]);
  IF CH=CHR(ETXX) THEN
    BEGIN
      GETLEADING; (* Indentation fixup *)
      IF ATBOT AND (CURSOR=STUFFSTART) THEN
	BEGIN
	  CURSOR:=LINESTART;
	  SAVE:=ANCHOR;
	  ANCHOR:=ATBOL;
	END;
      IF OKTODEL(CURSOR,ANCHOR) THEN
	BEGIN
	  updated := true;
	  READJUST(MIN(CURSOR,ANCHOR),-ABS(CURSOR-ANCHOR));
	  COPYLINE:=(CURSOR=LINESTART) AND ATBOT;
	  IF ANCHOR<CURSOR THEN
	    MOVELEFT(EBUF^[CURSOR],EBUF^[ANCHOR],BUFCOUNT-CURSOR)
	  ELSE
	    MOVELEFT(EBUF^[ANCHOR],EBUF^[CURSOR],BUFCOUNT-ANCHOR);
	  BUFCOUNT:=BUFCOUNT-ABS(CURSOR-ANCHOR);
	  CURSOR:=MIN(CURSOR,ANCHOR);
	  GETLEADING; CURSOR:=MAX(STUFFSTART,CURSOR)
	END
      ELSE
	CURSOR:=SAVE
    END
  ELSE
    BEGIN
      IF ATBOT AND (CURSOR=STUFFSTART) THEN
	BEGIN
	  CURSOR:=LINESTART;
	  SAVE:=ANCHOR;
	  ANCHOR:=ATBOL;
	END;
      COPYLINE:=(CURSOR=LINESTART) AND ATBOT;
      movetobuf(cursor,anchor);
      if copyline then cursor:=save
      else CURSOR:=ANCHOR;
    END;
  1:INDELETE:=FALSE;
  OK:=(LINE=STARTLINE) AND NOT DOFFSCREEN;
  UPSCREEN(OK,NOT OK,LINE);
  NEXTCOMMAND;
END;

BEGIN
try
  IF ECOMMAND=DELETEC THEN
    DELETING
  ELSE
    IF ECOMMAND=ADJUSTC THEN
      BEGIN
	ADJUSTING;
	NEXTCOMMAND
      END
    ELSE MOVING;
recover
  if escapecode<>107 then escape(escapecode);
END;


PROCEDURE FIND;

label 1;

VAR
  THERE,FOUND,LASTPATTERN: BOOLEAN;
  TRASH,COULDBE,PLENGTH,START,STOP,NEXTSTART: INTEGER;
  NEXT,PTR: EPTRTYPE;
  MODE: (LITERAL,TOKEN);
  I: INTEGER;
  DELIMITER: CHAR;
  JUSTIN: BOOLEAN;
  POSSIBLE,PAT: PTYPE;
  USEOLD,VERIFY: BOOLEAN;

PROCEDURE NEXTCH;
BEGIN
  CH:=GETCH;
  IF CH=CHR(ESCC) THEN
      BEGIN
	IF NOT JUSTIN THEN REDISPLAY;
	SHOWCURSOR; NEXTCOMMAND;
	escape(106);
      END
  ELSE
    IF ((ord(ch)>=32) and (ord(ch)<>127)) or (ch=chr(bss)) then
      WRITE(output,CH);
END;

PROCEDURE SKIP;
BEGIN
  WHILE CH IN [CHR(SP),CHR(HT),EOL] DO NEXTCH
END;

PROCEDURE OPTIONS;
BEGIN
  REPEAT
    CH:=UCLC(CH);
    IF CH='L' THEN
      BEGIN
	MODE:=LITERAL;
	NEXTCH;
      END
    ELSE
      IF (CH='V') and (ecommand=replacec) THEN
	BEGIN
	  VERIFY:=TRUE;
	  NEXTCH;
	END
      ELSE
	IF CH='T' THEN
	  BEGIN
	    MODE:=TOKEN;
	    NEXTCH;
	  END;
    CH:=UCLC(CH);
  UNTIL NOT (((CH='V') and (ecommand=replacec)) OR (CH='T') OR (CH='L'));
  SKIP;
  IF (CH='S') OR (CH='s') THEN USEOLD:=TRUE;
END;

PROCEDURE PARSESTRING(VAR PATTERN: PTYPE; VAR PLENGTH: INTEGER);
VAR I,J: INTEGER;
BEGIN
  SKIP;
  IF CH IN ['A'..'Z','a'..'z','0'..'9',CHR(127),CHR(BSS),chr(0)..chr(31)] THEN
    BEGIN
      error('Invalid delimiter.',fatalifstreaming);
      IF NOT JUSTIN THEN REDISPLAY;
      NEXTCOMMAND;
      escape(106);
    END;
  DELIMITER:=CH;
  I:=0;
  REPEAT
    NEXTCH;
    IF CH=CHR(BSS) THEN
      BEGIN
	IF (PATTERN[I]<>EOL) AND (I>0) THEN (* Don't go overboard! *)
	  BEGIN
	    WRITE(output,' ',CHR(BSS));
	    I:=I-1
	  END
	ELSE CONTROL(RIGHTCURSOR); (* Make up for the <BS> NEXTCH wrote out *)
      END
    ELSE
    IF CH=CHR(127) THEN
      BEGIN
	IF (PATTERN[I]<>EOL) THEN (* Don't go overboard! *)
	  WHILE I > 0 DO
	    BEGIN
	      WRITE(output,chr(bss),' ',CHR(BSS));
	      I:=I-1;
	    END;
      END
    ELSE
      if (ord(ch)>=32) then { only allow printable chars }
	BEGIN
	  PATTERN[I]:=CH;
	  I:=I+1
	END;
  UNTIL (CH=DELIMITER) OR (I>=MAXSTRING);
  IF I>=MAXCHAR THEN
    BEGIN
      error('Pattern too long',fatalifstreaming);
      IF NOT JUSTIN THEN REDISPLAY;
      NEXTCOMMAND;
      escape(106);
    END;
  PLENGTH:=I-1;
END (* PARSESTRING *);

FUNCTION OK(PTR: EPTRTYPE): BOOLEAN;
(* Compare PAT against the buffer *)
VAR
  I     : INTEGER;
  lch   : char;
  lch2  : char;
  done  : boolean;
BEGIN
  I:=0;
  if (mode = literal) or (not pagezero.ignorecase) then
    WHILE (I<PLENGTH) AND (EBUF^[PTR+I]=PAT[I]) DO I:=I+1
  else
    begin
      done := false;
      while (i<plength) and not done do
	begin
	  lch := ebuf^[ptr+i];
	  lch2 := pat[i];
	  if (lch  >= 'a') and (lch  <= 'z') then
	    lch   := chr( ord(lch ) - (ord('a')-ord('A')) );
	  if (lch2 >= 'a') and (lch2 <= 'z') then
	    lch2  := chr( ord(lch2) - (ord('a')-ord('A')) );
	  if lch = lch2 then
	    i := i + 1
	  else
	    done := true;
	end;
    end;
  OK:= I=PLENGTH;
END;

PROCEDURE SKIPKIND3(VAR CURSOR: EPTRTYPE);
BEGIN
  (* Skip over kind3 characters in the ebuf.  Update the cursor
     to the first non-kind3 character                           *)
  WHILE EBUF^[CURSOR] IN [CHR(SP),CHR(HT),CHR(DLE),EOL] DO
    IF EBUF^[CURSOR]=CHR(DLE) THEN CURSOR:=CURSOR+2
    ELSE CURSOR:=CURSOR+1;
END;

PROCEDURE SCANBACKWARD;
LABEL 1;
VAR
  LOC: EPTRTYPE;
  CHTHERE: BOOLEAN;
  lch   : char;
  lch2  : char;
BEGIN
  CHTHERE:=TRUE;
  THERE:=FALSE;
  FILLCHAR(PAT[0],SIZEOF(PAT),' ');
  MOVELEFT(TARGET[START],PAT[0],PLENGTH);
  lch  := pat[0];
  lch2 := lch;
  if (pagezero.ignorecase) and (mode = token) then
    if (lch >= 'a') and (lch <= 'z')
    or (lch >= 'A') and (lch <= 'Z') then
      begin
	lch2 := chr(ord(lch2) mod (ord('a')-ord('A')));
	lch  := chr(ord(lch2) + ord('A')-1 );
	lch2 := chr(ord(lch2) + ord('a')-1 );
      end;
  WHILE CHTHERE AND NOT THERE DO
    BEGIN
      1: IF PTR>=PLENGTH THEN (* Possibly there *)
	begin
	  LOC :=    SCAN(-PTR,=lch ,EBUF^[PTR]);
	  if lch <> lch2 then
	    loc := max(loc, SCAN(-PTR,=lch2,EBUF^[PTR]));
	end
      ELSE
	LOC:=-PTR;
      IF LOC=-PTR THEN (* Not there! *)
	BEGIN
	  CHTHERE:=FALSE;
	  THERE:=FALSE
	END
      ELSE
	BEGIN
	  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 PTR:=NEXT;
	END
    END;
END;

PROCEDURE SCANFORWARD;
LABEL 1;
VAR
  MAXSCAN,LOC: INTEGER;
  CHTHERE: BOOLEAN;
  lch   : char;
  lch2  : char;
BEGIN
  CHTHERE:=TRUE;
  THERE:=FALSE;
  FILLCHAR(PAT[0],SIZEOF(PAT),' ');
  MOVELEFT(TARGET[START],PAT[0],PLENGTH);
  lch  := pat[0];
  lch2 := lch;
  if (pagezero.ignorecase) and (mode = token) then
    if (lch >= 'a') and (lch <= 'z')
    or (lch >= 'A') and (lch <= 'Z') then
      begin
	lch2 := chr(ord(lch2) mod (ord('a')-ord('A')));
	lch  := chr( ord(lch2) + ord('A')-1 );
	lch2 := chr( ord(lch2) + ord('a')-1 );
      end;
  WHILE CHTHERE AND NOT THERE DO
    BEGIN
      1: MAXSCAN:=(BUFCOUNT-PLENGTH)-PTR+1;
      IF MAXSCAN>0 THEN (* still stuff to scan *)
	begin
	  LOC :=SCAN(MAXSCAN,=lch ,EBUF^[PTR]);
	  if lch <> lch2 then
	    loc := min(loc, SCAN(MAXSCAN,=lch2,EBUF^[PTR]));
	end
      ELSE
	LOC:=MAXSCAN; (* Dummy up 'not found' condition *)
      IF LOC=MAXSCAN THEN
	BEGIN
	  CHTHERE:=FALSE;
	  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 OK(PTR) THEN THERE:=TRUE
	  ELSE PTR:=NEXT;
	END
    END;
END;

PROCEDURE GOFORIT;

PROCEDURE NEXTLINE;
(* Given NEXTSTART, calculate the START and STOP for the next line *)
BEGIN
  LASTPATTERN:=FALSE;
  START:=NEXTSTART;
  STOP:=MIN(TLENGTH-1,START+SCAN(TLENGTH-START,=EOL,TARGET[START]));
  IF STOP=TLENGTH-1 THEN
    BEGIN
      STOP:=MAX(STOP,0);
      LASTPATTERN:=TRUE;
    END;
  NEXTSTART:=STOP+1;
END;

PROCEDURE NEXTTOKEN;
(* Given NEXTSTART, calculate START and STOP *)
BEGIN
  LASTPATTERN:=FALSE;
  START:=NEXTSTART;
  (* Skip over leading kind3 characters *)
  WHILE (TARGET[START] IN [CHR(SP),EOL,CHR(HT)]) AND (START<TLENGTH-1) DO
    START:=START+1;
  STOP:=START;
  (* Get the next token *)
  WHILE (KIND[TARGET[START]]=KIND[TARGET[STOP+1]]) AND (STOP<TLENGTH-1) DO
    STOP:=STOP+1;
  STOP:=MIN(STOP,TLENGTH-1);
  (* To accurately test for the last token, scan off the trailing kind3
     characters *)
  NEXTSTART:=STOP+1;
  WHILE (TARGET[NEXTSTART] IN [EOL,CHR(SP),CHR(HT)]) AND
	(NEXTSTART<TLENGTH) DO NEXTSTART:=NEXTSTART+1;
  IF NEXTSTART=TLENGTH THEN
    BEGIN
      STOP:=MAX(STOP,0);
      LASTPATTERN:=TRUE;
    END;
END;

BEGIN(* goforit *)
  FOUND:=FALSE;
  NEXT:=PTR;
  REPEAT
    PTR:=NEXT; (* Set to next place to scan for *)
    NEXTSTART:=0;  (* Fool NEXTLINE into giving us START and STOP for line 1 *)
    IF MODE=LITERAL THEN NEXTLINE
    ELSE NEXTTOKEN;
    PLENGTH:=STOP-START+1;
    IF DIRECTION='>' THEN SCANFORWARD
    ELSE SCANBACKWARD;
    IF THERE THEN
      BEGIN
	COULDBE:=PTR;
	FOUND:=TRUE;
	WHILE (NOT LASTPATTERN) AND FOUND DO
	  BEGIN
	    IF MODE=LITERAL THEN NEXTLINE ELSE NEXTTOKEN;
	    PTR:=PTR+PLENGTH;
	    SKIPKIND3(PTR); (* Go past the junk on the next line *)
	    PLENGTH:=STOP-START+1; (* For the new line *)
	    FILLCHAR(PAT[0],SIZEOF(PAT),' ');
	    MOVELEFT(TARGET[START],PAT[0],PLENGTH);
	    IF PTR+PLENGTH > BUFCOUNT THEN
	      FOUND:=FALSE
	    ELSE
	      IF NOT OK(PTR) THEN FOUND:=FALSE;
	  END;
      END;
    (* In token mode make sure the first and last characters
       of the target are on 'token boundaries' *)
    IF MODE=TOKEN THEN
      IF KIND[target[0]]=ORD('A') THEN
	IF FOUND THEN
	  BEGIN
	    IF ((COULDBE>2) AND (EBUF^[COULDBE-2]<>CHR(DLE))) OR
	       (COULDBE<=2) THEN (* whew! *)
	      IF KIND[EBUF^[COULDBE]]=KIND[EBUF^[COULDBE-1]] THEN
		FOUND:=FALSE; (* False find... don't count it. *)
	    IF (PTR+PLENGTH<=BUFCOUNT-1) then
	      if kind[ebuf^[ptr+plength-1]]=ord('A') then
		if (KIND[EBUF^[PTR+PLENGTH-1]]=KIND[EBUF^[PTR+PLENGTH]]) THEN
		  FOUND:=FALSE; (* Another false find *)
	  END;
  UNTIL FOUND OR NOT THERE;
END(* goforit *);

PROCEDURE PUTPROMPT(LEFT,RIGHT:STRING80; REPEATFACTOR:INTEGER; LORT:BOOLEAN);
BEGIN
  PROMPTLINE:=LEFT; EPROMPT;
  WRITE(output,'[');
  IF INFINITY THEN WRITE(output,'/')
  ELSE WRITE(output,REPEATFACTOR:1);
  WRITE(output,']: ');
  IF LORT THEN IF MODE=TOKEN THEN WRITE(output,'L')
  ELSE WRITE(output,'T');
  WRITE(output,RIGHT)
END;

PROCEDURE REPLACEIT;
LABEL 1;
var
  tokensize     : integer;
  savlastpat    : integer;
BEGIN
  IF VERIFY THEN
    BEGIN
      CENTERCURSOR(TRASH,MIDDLE,NOT JUSTIN);
      PUTPROMPT(' Rpl','<'+esckey+'> aborts,R replaces,'' '' doesn''t',
		REPEATFACTOR-I+2,FALSE);             { 3.0 ITF fix 4/6/84 }
      SHOWCURSOR;
      CH:=GETCH;
      IF CH=CHR(ESCC) THEN
	BEGIN
	  GETLEADING;
	  CURSOR:=MAX(CURSOR,STUFFSTART);
	  NEXTCOMMAND;
	  escape(106);
	END;
      IF (CH<>'R') AND (CH<>'r') THEN GOTO 1;
    END;
  (* Replace TARGET with SUBSTRING *)
  tokensize := cursor-lastpat;
  IF SLENGTH>tokensize THEN
    IF SLENGTH-tokensize+BUFCOUNT>BUFSIZE-200 THEN
	BEGIN
	  error('Buffer full. Replace aborted',fatalifstreaming);
	  GETLEADING;
	  CURSOR:=MAX(CURSOR,STUFFSTART);
	  NEXTCOMMAND;
	  escape(106);
	END
    ELSE
      MOVERIGHT(EBUF^[CURSOR],EBUF^[LASTPAT+SLENGTH],BUFCOUNT-CURSOR)
  ELSE
    IF SLENGTH<tokensize THEN
      MOVELEFT(EBUF^[CURSOR],EBUF^[LASTPAT+SLENGTH],BUFCOUNT-CURSOR);
  MOVELEFT(SUBSTRING[0],EBUF^[LASTPAT],SLENGTH);
  IF SLENGTH<>tokensize THEN
    begin
      savlastpat := lastpat;
      READJUST(LASTPAT,SLENGTH-tokensize);
      lastpat := savlastpat;
      BUFCOUNT:=BUFCOUNT+SLENGTH-tokensize;
      CURSOR  :=CURSOR  +SLENGTH-tokensize;
    end;
  JUSTIN:=FALSE;
  updated := true;
1:END;

BEGIN
try
  JUSTIN:=TRUE;
  USEOLD:=FALSE;
  VERIFY:=FALSE;
  IF PAGEZERO.TOKDEF THEN MODE:=TOKEN
  ELSE MODE:=LITERAL;
  IF ECOMMAND=FINDC THEN
    PUTPROMPT(' Find','<target>=>',REPEATFACTOR,TRUE)
  ELSE
    PUTPROMPT(' Repl',' V <targ><sub>=>',REPEATFACTOR,TRUE);
  NEEDPROMPT:=TRUE;
  NEXTCH;
  SKIP;
  OPTIONS;
  IF NOT USEOLD THEN
    BEGIN
      PARSESTRING(TARGET,TLENGTH);
      if tlength=0 then
	begin
	  tdefined := false;
	  goto 1;
	end
      else
	TDEFINED:=TRUE;
    END;
  IF ECOMMAND=REPLACEC THEN
    BEGIN
      NEXTCH; SKIP;
      USEOLD:=FALSE;
      OPTIONS;
      IF NOT USEOLD THEN
	BEGIN
	  PARSESTRING(SUBSTRING,SLENGTH);
	  SDEFINED:=TRUE
	END
    END;
  HOME;
  ECLEARLINE(0);
  IF ((ECOMMAND=FINDC) AND TDEFINED)
     OR ((ECOMMAND=REPLACEC) AND SDEFINED AND TDEFINED) THEN
    BEGIN
      I:=1;
      FOUND:=TRUE;
      IF (DIRECTION='<') AND (CURSOR>1) THEN          { 3.0 BUG 2/16/84}
	PTR:=CURSOR-1                                 { 3.0 BUG 2/16/84}
      ELSE                                            { 3.0 BUG 2/16/84}
	PTR:=CURSOR;                                  { 3.0 BUG 2/16/84}
      WHILE ((I<=REPEATFACTOR) OR INFINITY) AND FOUND DO
	BEGIN
	  GOFORIT; (* Find the target (handles token and literal mode) *)
	  I:=I+1;
	  IF FOUND THEN
	    BEGIN
	      CURSOR:=PTR+PLENGTH;
	      LASTPAT:=COULDBE; (*Set up for next time*)
	      IF ECOMMAND=REPLACEC THEN REPLACEIT;
	      IF DIRECTION='<' THEN PTR:=COULDBE-1
	      ELSE PTR:=CURSOR;
	    END;
	END;
      IF DIRECTION='<' THEN               { 3.0 BUG 2/16/84 }
	IF FOUND OR (I>2) THEN            { 3.0 BUG 2/16/84 }
	  CURSOR:=LASTPAT;                { 3.0 BUG 2/16/84 }
      {SETS CURSOR ON FIRST CHAR OF PATTERN WHEN GOING BACKWARD}
      IF NOT FOUND THEN
	IF NOT( INFINITY AND (I>2) ) THEN
	  if not streaming then ERROR('Pattern not found.',NONFATAL)
    END
  ELSE
    error('No old pattern.',fatalifstreaming);
  CENTERCURSOR(TRASH,MIDDLE,NOT JUSTIN);
  GETLEADING;
  CURSOR:=MAX(STUFFSTART,CURSOR);
1: SHOWCURSOR;
  NEXTCOMMAND;
recover
  if escapecode<>106 then escape(escapecode);
END;



{ 7 Apr 80 - MCh: added second prompt line }

PROCEDURE NEXTCOMMAND;
BEGIN
  IF NEEDPROMPT THEN
    BEGIN
      PROMPTLINE:=COMPROMPT; {Made variable for screens of short width. MAB}
      if prompt2flag then promptline := prompt2;  { MCh: second prompt line }
      EPROMPT;
      NEEDPROMPT:=FALSE;
      SHOWCURSOR
    END;
  CH:=GETCH;
  ECOMMAND:=MAPTOCOMMAND(CH);
END(* NEXTCOMMAND *);

PROCEDURE COMMANDER;
BEGIN
  INFINITY:=FALSE;

  { 7 Apr 80 - MCh: default to using first prompt unless have a '?' command }

  if ecommand <> dumpc then prompt2flag := false;
  IF ECOMMAND=SLASHC THEN
    BEGIN
      REPEATFACTOR:=1;
      INFINITY:=TRUE;
      NEXTCOMMAND;
    END
  ELSE
    IF ECOMMAND=DIGIT THEN REPEATFACTOR:=GETNUM
    ELSE REPEATFACTOR:=1;
  CASE ECOMMAND OF
    ILLEGAL: BEGIN ERRWAIT; SHOWCURSOR; NEXTCOMMAND END;
    REVERSEC,FORWARDC: FIXDIRECTION;
    COPYC: COPY;
    DUMPC: begin        { MCh: toggle prompt lines }
	     needprompt := true;
	     prompt2flag := not prompt2flag;
	     nextcommand;
	   end;
    FINDC: FIND;
    INSERTC: INSERTIT;
    JUMPC: JUMP;
    LISTC: begin
	     errwait;
	     showcursor;
	     nextcommand;
	   end;
    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,TABB,SPACE: MOVEIT ;
    otherwise
  END (* BIG LONG CASE STATEMENT *);
END (* COMMANDER *);

BEGIN (* Editcore *)
try
  NEXTCOMMAND;
  WHILE ECOMMAND<>QUITC DO COMMANDER
recover
  if escapecode<>103 then escape(escapecode);
END;


procedure xeditor;

label 1;
BEGIN (* procedure XEDITOR *)
  try
    INITIALIZE
  recover
    if escapecode=101 then goto 1
    else escape(escapecode);
  GETLEADING;
  CURSOR:=MAX(CURSOR,STUFFSTART);
  iflag:=false; (* WAH 1/18/80 *)
  recovering := false;     { 19 May 80 - MCh: default state }

  REPEAT
    CENTERCURSOR(TRASH,MIDDLE,TRUE);
    NEEDPROMPT:=TRUE;
    prompt2flag := false;  { 7 Apr 80 - MCh: second prompt line }
    REPEAT
      HOME; ECLEARLINE(0);
      try
	EDITCORE;
	IF ECOMMAND=SETC THEN
	  ENVIRONMENT
	ELSE IF ECOMMAND=COPYC THEN
	  COPYFILE;
      recover
	begin     { 19 May 80 - MCh: save text in case of fatal error }
	  if escapecode=101 then goto 1;
	  if escapecode = -20 then      { user interruption (stop key) }
	    begin
	      if not updated then
		escape(-20)
	      else
		begin
		  if oktostop then
		    escape(-20)
		  else
		    begin
		      centercursor(trash,middle,true);
		      needprompt := true;
		    end;
		end;
	    end
	  else
	    begin
	      if escapecode <> -1 then
		begin
		  recovering := true;
		  eclearscreen; writeln(output);
		  writeln (output,'Fatal error encountered.');
		  if updated then
		    begin
		      writeln (output,'Will try to save text file.');
		      do_out;
		      if out then
			writeln (output,'Work file updated.')
		      else
			writeln ('Work file not updated.  Text was not saved.');
		    end;
		end;
	      escape (escapecode)     { get back to the system }
	    end;
	end;
    UNTIL ECOMMAND=QUITC;
    try
      do_out;
    recover
      if (escapecode = -20) and updated then
	out := oktostop
      else
	escape(escapecode);
  UNTIL OUT;
  SYSCOM^.MISCINFO.NOBREAK := FALSE;  (* 28 SEPT 77*)
1: END;

end;  {edit2}

import xeditor;

BEGIN
  xeditor;
END. { of EDTR }
