                                              (*

 (c) Copyright Hewlett-Packard Company, 1985,1989.
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,1989 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 'CONVERT'$
import
  sysglobals,
  sysdevs,
  ci,
  misc,
  fs,
  convert_text;

export

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

  editversion   = '[3.23e]';
  editdate      = '19-Jan-90';
  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, 1989.');
      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;
  my_counter : integer;

{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];
    my_count : integer;

  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
          home;
          eclearline(0);
          getioerrmsg(generrmsg,tempior);
          write(output,direction,'ERROR1: ',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');
      WRITELN  ('     Do whatever you damned well please');
      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 
    begin writeln('trying'); for my_counter := 1 to 10000000 do ; fn := efilename; end       {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);
       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 }
