TP3/shell/Editor.mod

IMPLEMENTATION MODULE Editor ;

FROM Term IMPORT
   GotoXY, PutCh, PutStr, PutCard, ScrnWide, Marked, Normal,
   GetCh, Avail, GetKey, Beep ;

FROM TextBuf IMPORT
   TextLimit, CharAt, InsertCh, OverwriteCh, DeleteFromTo, Length ;

FROM Posix IMPORT
   open, close, read, write ;

FROM SYSTEM IMPORT ADR, BYTE ;

IMPORT Keys ;

CONST
   Broad    = 80 ;                (* columns on the screen *)
   TopRow   = 1 ;
   NBufRows = 23 ;                (* text rows: screen rows 2..24 *)
   FirstRow = 2 ;
   MaxCol   = 125 ;               (* max chars per line before CR *)

   NoMark   = 0FFFFFFFFH ;        (* not-found / not-set value *)

   (* control keys *)
   C_A = CHR (1) ;  C_C = CHR (3) ;  C_D = CHR (4) ;  C_E = CHR (5) ;
   C_F = CHR (6) ;  C_G = CHR (7) ;  C_H = CHR (8) ;  C_I = CHR (9) ;
   C_J = CHR (10) ; C_K = CHR (11) ; C_L = CHR (12) ; C_M = CHR (13) ;
   C_N = CHR (14) ; C_P = CHR (16) ; C_Q = CHR (17) ; C_R = CHR (18) ;
   C_S = CHR (19) ; C_T = CHR (20) ; C_U = CHR (21) ; C_V = CHR (22) ;
   C_W = CHR (23) ; C_X = CHR (24) ; C_Y = CHR (25) ; C_Z = CHR (26) ;
   Esc = CHR (27) ; Del = CHR (127) ;

VAR
   drive      : CHAR ;
   fname      : ARRAY [0..255] OF CHAR ;
   modified   : BOOLEAN ;
   keys       : Keys.Map ;        (* the key map, from TP3.KEY *)

   curLine, curCol : CARDINAL ;   (* 0-based cursor *)
   topLine    : CARDINAL ;        (* first visible line *)
   colOff     : CARDINAL ;        (* horizontal scroll *)
   insertMode : BOOLEAN ;
   autoIndent : BOOLEAN ;

   haveLast   : BOOLEAN ;         (* last cursor position remembered *)
   lastLine, lastCol : CARDINAL ;

   blkDef     : BOOLEAN ;         (* a block has been marked *)
   blkShown   : BOOLEAN ;         (* block is displayed *)
   blkB, blkE : CARDINAL ;        (* block byte offsets [blkB, blkE) *)

   restoreOn  : BOOLEAN ;         (* current line snapshot exists *)
   restoreLine : CARDINAL ;
   restoreText : ARRAY [0..MaxCol + 2] OF CHAR ;
   restoreLen : CARDINAL ;

   lastFind   : BOOLEAN ;         (* a search was issued *)
   fnStr      : ARRAY [0..31] OF CHAR ;
   rpStr      : ARRAY [0..31] OF CHAR ;
   optB, optG, optU, optW, optN : BOOLEAN ;
   optN2      : CARDINAL ;
   lastIsReplace : BOOLEAN ;

   endEdit    : BOOLEAN ;         (* Ctrl-K-D pressed *)

   gotoPend   : BOOLEAN ;         (* enter editor at gotoOff (errexit jump) *)
   gotoOff    : CARDINAL ;

   trash      : LONGINT ;         (* discarded syscall result *)

PROCEDURE StrClear (VAR s : ARRAY OF CHAR) ;
BEGIN
   s [0] := 0C
END StrClear ;

PROCEDURE PatLen (s : ARRAY OF CHAR) : CARDINAL ;
VAR p : CARDINAL ;
BEGIN
   p := 0 ;
   WHILE (p <= HIGH (s)) AND (s [p] # 0C) DO
      INC (p)
   END ;
   RETURN p
END PatLen ;

(* ------------------------------------------------------------------ *)
(*  buffer geometry (lines are CR-terminated)                         *)
(* ------------------------------------------------------------------ *)

PROCEDURE LineCount () : CARDINAL ;
VAR n, i : CARDINAL ;
BEGIN
   n := 1 ;
   i := 0 ;
   WHILE i < Length () DO
      IF CharAt (i) = C_M THEN
         INC (n)
      END ;
      INC (i)
   END ;
   RETURN n
END LineCount ;

PROCEDURE LineStart (l : CARDINAL) : CARDINAL ;
VAR i, n : CARDINAL ;
BEGIN
   i := 0 ;
   n := 0 ;
   WHILE (n < l) AND (i < Length ()) DO
      IF CharAt (i) = C_M THEN
         INC (n)
      END ;
      INC (i)
   END ;
   RETURN i
END LineStart ;

PROCEDURE LineEnd (l : CARDINAL) : CARDINAL ;
(* byte offset of the CR terminating line l, or Length for the last *)
VAR i : CARDINAL ;
BEGIN
   i := LineStart (l) ;
   WHILE (i < Length ()) AND (CharAt (i) # C_M) DO
      INC (i)
   END ;
   RETURN i
END LineEnd ;

PROCEDURE LineLen (l : CARDINAL) : CARDINAL ;
BEGIN
   RETURN LineEnd (l) - LineStart (l)
END LineLen ;

PROCEDURE LastLine () : CARDINAL ;
VAR c : CARDINAL ;
BEGIN
   c := LineCount () ;
   IF c = 0 THEN
      RETURN 0
   END ;
   RETURN c - 1
END LastLine ;

PROCEDURE OffToPos (off : CARDINAL ; VAR ln, cl : CARDINAL) ;
VAR l, ls, le : CARDINAL ;
BEGIN
   IF off > Length () THEN
      off := Length ()
   END ;
   l := 0 ;
   LOOP
      ls := LineStart (l) ;
      le := LineEnd (l) ;
      IF off <= le THEN
         ln := l ;
         cl := off - ls ;
         RETURN
      END ;
      INC (l)
   END
END OffToPos ;

PROCEDURE GotoOffset (off : CARDINAL) ;
(* Arm a jump: the next Run enters the editor with the cursor on this
   0-based TextBuf offset.  Mirrors TP3's errexit path, where the shell
   does  waitesc ; BX:=txerrpos ; DEC BX ; JMP editor2  and editor2
   lands on txbeg+txerrpos.  PositionCursor scrolls the view to it. *)
VAR ln, cl : CARDINAL ;
BEGIN
   gotoPend := TRUE ;
   gotoOff := off
END GotoOffset ;

PROCEDURE ClampCursor ;
VAR last : CARDINAL ;
BEGIN
   last := LastLine () ;
   IF curLine > last THEN
      curLine := last
   END ;
   IF curCol > LineLen (curLine) THEN
      curCol := LineLen (curLine)
   END
END ClampCursor ;

PROCEDURE CursorOff () : CARDINAL ;
BEGIN
   RETURN LineStart (curLine) + curCol
END CursorOff ;

(* ------------------------------------------------------------------ *)
(*  block marker maintenance                                          *)
(* ------------------------------------------------------------------ *)

PROCEDURE Inserted (at, n : CARDINAL) ;
BEGIN
   IF NOT blkDef THEN RETURN END ;
   IF at <= blkB THEN blkB := blkB + n END ;
   IF at <= blkE THEN blkE := blkE + n END
END Inserted ;

PROCEDURE Deleted (at, n : CARDINAL) ;
VAR end2 : CARDINAL ;
BEGIN
   IF NOT blkDef THEN RETURN END ;
   end2 := at + n ;
   IF at < blkB THEN
      IF end2 < blkB THEN
         blkB := blkB - n
      ELSE
         blkB := at
      END
   END ;
   IF at < blkE THEN
      IF end2 < blkE THEN
         blkE := blkE - n
      ELSE
         blkE := at
      END
   END
END Deleted ;

PROCEDURE BufInsert (at : CARDINAL ; ch : CHAR) ;
BEGIN
   InsertCh (at, ch) ;
   Inserted (at, 1)
END BufInsert ;

PROCEDURE BufDeleteN (at, n : CARDINAL) ;
BEGIN
   Deleted (at, n) ;
   DeleteFromTo (at, n)
END BufDeleteN ;

(* ------------------------------------------------------------------ *)
(*  screen                                                           *)
(* ------------------------------------------------------------------ *)

PROCEDURE StatusLine ;
BEGIN
   GotoXY (TopRow, 1) ;
   PutStr ("Line ") ;
   PutCard (curLine + 1) ;
   PutStr ("       Col ") ;
   PutCard (curCol + 1) ;
   IF insertMode THEN
      PutStr ("     Insert   ")
   ELSE
      PutStr ("   Overwrite  ")
   END ;
   IF autoIndent THEN
      PutStr ("   Indent   ")
   ELSE
      PutStr ("            ")
   END ;
   PutCh (drive) ;
   PutCh (":") ;
   PutStr (fname)
END StatusLine ;

PROCEDURE DrawRow (row, ln : CARDINAL) ;
VAR start, i, x, off : CARDINAL ;
    shown : BOOLEAN ;
BEGIN
   GotoXY (row, 1) ;
   start := LineStart (ln) ;
   shown := blkDef AND blkShown ;
   i := colOff ;
   x := 0 ;
   WHILE (i < LineLen (ln)) AND (x < Broad) DO
      off := start + i ;
      IF shown AND (off >= blkB) AND (off < blkE) THEN
         Marked
      ELSE
         Normal
      END ;
      PutCh (CharAt (off)) ;
      INC (i) ;
      INC (x)
   END ;
   Normal ;
   IF x < Broad THEN
      ScrnWide (Broad - x)
   END
END DrawRow ;

PROCEDURE DrawScreen ;
VAR r : CARDINAL ;
BEGIN
   StatusLine ;
   r := 0 ;
   WHILE (r < NBufRows) AND (topLine + r <= LastLine ()) DO
      DrawRow (FirstRow + r, topLine + r) ;
      INC (r)
   END ;
   WHILE r < NBufRows DO
      GotoXY (FirstRow + r, 1) ;
      ScrnWide (Broad) ;
      INC (r)
   END
END DrawScreen ;

PROCEDURE PositionCursor ;
VAR row, col : CARDINAL ;
BEGIN
   IF curLine < topLine THEN topLine := curLine END ;
   IF curLine >= topLine + NBufRows THEN
      topLine := curLine - NBufRows + 1
   END ;
   IF curCol < colOff THEN colOff := curCol END ;
   IF curCol >= colOff + Broad THEN colOff := curCol - Broad + 1 END ;
   row := FirstRow + (curLine - topLine) ;
   col := curCol - colOff + 1 ;
   GotoXY (row, col)
END PositionCursor ;

PROCEDURE MsgWait (msg : ARRAY OF CHAR) ;
VAR ch : CHAR ;
BEGIN
   GotoXY (TopRow, 1) ;
   ScrnWide (Broad) ;
   GotoXY (TopRow, 1) ;
   PutStr (msg) ;
   GetCh (ch) ;
   StatusLine
END MsgWait ;

(* ------------------------------------------------------------------ *)
(*  status line input                                                 *)
(* ------------------------------------------------------------------ *)

PROCEDURE ReadStatus (prompt : ARRAY OF CHAR ; prefix : BOOLEAN ;
                      VAR s : ARRAY OF CHAR) : BOOLEAN ;
VAR len : CARDINAL ;
    ch   : CHAR ;
BEGIN
   GotoXY (TopRow, 1) ;
   ScrnWide (Broad) ;
   GotoXY (TopRow, 1) ;
   PutStr (prompt) ;
   len := 0 ;
   LOOP
      GetCh (ch) ;
      IF (ch = C_M) OR (ch = C_J) THEN
         EXIT
      ELSIF (ch = C_U) OR (ch = Esc) THEN
         RETURN FALSE
      ELSIF (ch = C_H) OR (ch = Del) THEN
         IF len > 0 THEN
            DEC (len) ;
            PutCh (CHR (8)) ;
            PutCh (" ") ;
            PutCh (CHR (8))
         END
      ELSIF ch = C_P THEN
         IF prefix THEN
            GetCh (ch) ;
            IF (ch = Esc) OR (ch = C_U) THEN
               RETURN FALSE
            END ;
            IF len < HIGH (s) THEN
               s [len] := ch ;
               INC (len) ;
               PutCh (ch)
            END
         END
      ELSIF (ch >= " ") AND (ch <= "~") AND (len < HIGH (s)) THEN
         s [len] := ch ;
         INC (len) ;
         PutCh (ch)
      END
   END ;
   s [len] := 0C ;
   StatusLine ;
   RETURN TRUE
END ReadStatus ;

(* ------------------------------------------------------------------ *)
(*  word boundaries                                                   *)
(* ------------------------------------------------------------------ *)

PROCEDURE IsSep (ch : CHAR) : BOOLEAN ;
BEGIN
   IF (ch = " ") OR (ch = C_M) OR (ch = C_J) THEN RETURN TRUE END ;
   IF (ch = "<") OR (ch = ">") OR (ch = ",") OR (ch = ";") OR
      (ch = ".") OR (ch = "(") OR (ch = ")") OR (ch = "[") OR
      (ch = "]") OR (ch = "*") OR (ch = "+") OR (ch = "-") OR
      (ch = "/") OR (ch = "$") OR (ch = "=") OR (ch = ":") OR
      (ch = "{") OR (ch = "}") OR (ch = "^") OR (ch = "#") OR
      (ch = "&") OR (ch = "'") THEN RETURN TRUE END ;
   RETURN FALSE
END IsSep ;

PROCEDURE NextWord (from : CARDINAL) : CARDINAL ;
(* offset of the first non-separator at or after "from" *)
VAR i : CARDINAL ;
BEGIN
   i := from ;
   WHILE (i < Length ()) AND IsSep (CharAt (i)) DO INC (i) END ;
   RETURN i
END NextWord ;

PROCEDURE EndWord (from : CARDINAL) : CARDINAL ;
(* offset past the last non-separator starting at "from" *)
VAR i : CARDINAL ;
BEGIN
   i := from ;
   WHILE (i < Length ()) AND NOT IsSep (CharAt (i)) DO INC (i) END ;
   RETURN i
END EndWord ;

PROCEDURE PrevWord (from : CARDINAL) : CARDINAL ;
(* start of the word to the left of "from" *)
VAR i : CARDINAL ;
BEGIN
   i := from ;
   WHILE (i > 0) AND IsSep (CharAt (i - 1)) DO DEC (i) END ;
   WHILE (i > 0) AND NOT IsSep (CharAt (i - 1)) DO DEC (i) END ;
   RETURN i
END PrevWord ;

(* ------------------------------------------------------------------ *)
(*  cursor movement                                                   *)
(* ------------------------------------------------------------------ *)

PROCEDURE SavePos ;
BEGIN
   haveLast := TRUE ;
   lastLine := curLine ;
   lastCol := curCol
END SavePos ;

PROCEDURE TakeSnapshot ;
VAR i : CARDINAL ;
BEGIN
   restoreOn := TRUE ;
   restoreLine := curLine ;
   restoreLen := LineLen (curLine) ;
   i := 0 ;
   WHILE i < restoreLen DO
      restoreText [i] := CharAt (LineStart (curLine) + i) ;
      INC (i)
   END
END TakeSnapshot ;

PROCEDURE ToPos (ln, cl : CARDINAL) ;
BEGIN
   IF ln # curLine THEN TakeSnapshot END ;
   curLine := ln ;
   curCol := cl ;
   ClampCursor
END ToPos ;

PROCEDURE CharLeft ;
BEGIN
   IF curCol > 0 THEN DEC (curCol) ELSE Beep END
END CharLeft ;

PROCEDURE CharRight ;
BEGIN
   IF curCol < LineLen (curLine) THEN INC (curCol) ELSE Beep END
END CharRight ;

PROCEDURE WordLeft ;
VAR off, ln, cl : CARDINAL ;
BEGIN
   off := PrevWord (CursorOff ()) ;
   OffToPos (off, ln, cl) ;
   ToPos (ln, cl)
END WordLeft ;

PROCEDURE WordRight ;
VAR off, ln, cl : CARDINAL ;
BEGIN
   off := NextWord (CursorOff ()) ;
   OffToPos (off, ln, cl) ;
   ToPos (ln, cl)
END WordRight ;

PROCEDURE LineUp ;
BEGIN
   IF curLine > 0 THEN ToPos (curLine - 1, curCol) ELSE Beep END
END LineUp ;

PROCEDURE LineDown ;
BEGIN
   IF curLine < LastLine () THEN ToPos (curLine + 1, curCol) ELSE Beep END
END LineDown ;

PROCEDURE ScrollUp ;
BEGIN
   IF topLine > 0 THEN
      DEC (topLine) ;
      IF curLine = topLine + NBufRows THEN DEC (curLine) END
   ELSE
      Beep
   END
END ScrollUp ;

PROCEDURE ScrollDown ;
BEGIN
   IF topLine < LastLine () THEN
      INC (topLine) ;
      IF curLine < topLine THEN INC (curLine) END
   ELSE
      Beep
   END
END ScrollDown ;

PROCEDURE PageUp ;
VAR target : CARDINAL ;
BEGIN
   SavePos ;
   target := NBufRows - 1 ;
   IF curLine > target THEN
      ToPos (curLine - target, curCol)
   ELSE
      ToPos (0, curCol)
   END ;
   IF curLine < topLine THEN topLine := curLine END
END PageUp ;

PROCEDURE PageDown ;
VAR target, last : CARDINAL ;
BEGIN
   SavePos ;
   target := NBufRows - 1 ;
   last := LastLine () ;
   IF curLine + target <= last THEN
      ToPos (curLine + target, curCol)
   ELSE
      ToPos (last, curCol)
   END ;
   IF curLine >= topLine + NBufRows THEN
      topLine := curLine - NBufRows + 1
   END
END PageDown ;

PROCEDURE HomeLine ;
BEGIN
   curCol := 0
END HomeLine ;

PROCEDURE EndLine ;
BEGIN
   curCol := LineLen (curLine)
END EndLine ;

PROCEDURE HomeScreen ;
BEGIN
   ToPos (topLine, 0)
END HomeScreen ;

PROCEDURE EndScreen ;
BEGIN
   ToPos (topLine + NBufRows - 1, 0)
END EndScreen ;

PROCEDURE HomeFile ;
BEGIN
   SavePos ;
   ToPos (0, 0) ;
   topLine := 0
END HomeFile ;

PROCEDURE EndFile ;
BEGIN
   SavePos ;
   ToPos (LastLine (), LineLen (LastLine ())) ;
   IF curLine >= topLine + NBufRows THEN
      topLine := curLine - NBufRows + 1
   END
END EndFile ;

PROCEDURE ToBlockB ;
VAR ln, cl : CARDINAL ;
BEGIN
   IF blkDef THEN
      SavePos ;
      OffToPos (blkB, ln, cl) ;
      ToPos (ln, cl)
   END
END ToBlockB ;

PROCEDURE ToBlockE ;
VAR ln, cl : CARDINAL ;
BEGIN
   IF blkDef THEN
      SavePos ;
      OffToPos (blkE, ln, cl) ;
      ToPos (ln, cl)
   END
END ToBlockE ;

PROCEDURE ToLastPos ;
BEGIN
   IF haveLast THEN ToPos (lastLine, lastCol) END
END ToLastPos ;

(* ------------------------------------------------------------------ *)
(*  editing                                                          *)
(* ------------------------------------------------------------------ *)

PROCEDURE NewLine ;
VAR indentCol, i, at : CARDINAL ;
BEGIN
   at := CursorOff () ;
   InsertCh (at, C_M) ;
   Inserted (at, 1) ;
   IF autoIndent THEN
      indentCol := 0 ;
      i := 0 ;
      WHILE (i < curCol) AND (CharAt (LineStart (curLine) + i) = " ") DO
         INC (i)
      END ;
      indentCol := i
   ELSE
      indentCol := 0
   END ;
   INC (curLine) ;
   curCol := indentCol ;
   IF indentCol > 0 THEN
      at := LineStart (curLine) ;
      i := 0 ;
      WHILE i < indentCol DO
         InsertCh (at + i, " ") ;
         Inserted (at + i, 1) ;
         INC (i)
      END
   END ;
   restoreOn := FALSE ;
   modified := TRUE
END NewLine ;

PROCEDURE InsertBreak ;
VAR at, ln, cl : CARDINAL ;
BEGIN
   at := CursorOff () ;
   InsertCh (at, C_M) ;
   Inserted (at, 1) ;
   OffToPos (at, ln, cl) ;
   ToPos (ln, cl) ;
   restoreOn := FALSE ;
   modified := TRUE
END InsertBreak ;

PROCEDURE TypeChar (ch : CHAR) ;
VAR at : CARDINAL ;
BEGIN
   IF insertMode THEN
      IF LineLen (curLine) >= MaxCol THEN
         MsgWait ("Line too long - CR inserted") ;
         NewLine ;
         at := CursorOff () ;
         InsertCh (at, ch) ;
         Inserted (at, 1) ;
         INC (curCol)
      ELSE
         at := CursorOff () ;
         InsertCh (at, ch) ;
         Inserted (at, 1) ;
         INC (curCol)
      END
   ELSE
      IF curCol < LineLen (curLine) THEN
         at := CursorOff () ;
         OverwriteCh (at, ch) ;
         INC (curCol)
      ELSE
         at := CursorOff () ;
         InsertCh (at, ch) ;
         Inserted (at, 1) ;
         INC (curCol)
      END
   END ;
   restoreOn := FALSE ;
   modified := TRUE
END TypeChar ;

PROCEDURE DeleteLeft ;
VAR off : CARDINAL ;
BEGIN
   IF CursorOff () = 0 THEN Beep ; RETURN END ;
   IF curCol > 0 THEN
      DEC (curCol) ;
      off := CursorOff () ;
      BufDeleteN (off, 1)
   ELSE
      off := CursorOff () - 1 ;        (* the CR ending the previous line *)
      BufDeleteN (off, 1) ;
      DEC (curLine) ;
      curCol := LineLen (curLine)
   END ;
   restoreOn := FALSE ;
   modified := TRUE
END DeleteLeft ;

PROCEDURE DeleteChar ;
VAR off : CARDINAL ;
BEGIN
   IF curCol >= LineLen (curLine) THEN Beep ; RETURN END ;
   off := CursorOff () ;
   BufDeleteN (off, 1) ;
   restoreOn := FALSE ;
   modified := TRUE
END DeleteChar ;

PROCEDURE DeleteWord ;
VAR from, ew : CARDINAL ;
BEGIN
   from := CursorOff () ;
   ew := EndWord (from) ;
   IF ew = from THEN ew := NextWord (from) END ;
   IF ew > from THEN
      BufDeleteN (from, ew - from) ;
      restoreOn := FALSE ;
      modified := TRUE
   END
END DeleteWord ;

PROCEDURE DeleteLine ;
VAR s, e, last : CARDINAL ;
BEGIN
   s := LineStart (curLine) ;
   e := LineEnd (curLine) ;
   IF e < Length () THEN INC (e) END ;    (* include the CR *)
   BufDeleteN (s, e - s) ;
   last := LastLine () ;
   IF curLine > last THEN curLine := last END ;
   curCol := 0 ;
   restoreOn := FALSE ;
   modified := TRUE
END DeleteLine ;

PROCEDURE DeleteToEOL ;
VAR to, at : CARDINAL ;
BEGIN
   at := CursorOff () ;
   to := LineEnd (curLine) ;
   IF to > at THEN
      BufDeleteN (at, to - at) ;
      restoreOn := FALSE ;
      modified := TRUE
   END
END DeleteToEOL ;

PROCEDURE RestoreLine ;
VAR s, i : CARDINAL ;
BEGIN
   IF NOT (restoreOn AND (restoreLine = curLine)) THEN Beep ; RETURN END ;
   s := LineStart (curLine) ;
   BufDeleteN (s, LineLen (curLine)) ;
   i := 0 ;
   WHILE i < restoreLen DO
      InsertCh (s + i, restoreText [i]) ;
      Inserted (s + i, 1) ;
      INC (i)
   END ;
   IF curCol > restoreLen THEN curCol := restoreLen END
END RestoreLine ;

PROCEDURE MarkBlockB ;
BEGIN
   blkDef := TRUE ;
   blkShown := TRUE ;
   blkB := CursorOff () ;
   blkE := CursorOff ()
END MarkBlockB ;

PROCEDURE MarkBlockE ;
BEGIN
   blkDef := TRUE ;
   blkShown := TRUE ;
   blkE := CursorOff () ;
   IF blkE < blkB THEN blkE := blkB END
END MarkBlockE ;

PROCEDURE MarkWord ;
VAR b, e : CARDINAL ;
BEGIN
   b := CursorOff () ;
   e := EndWord (b) ;
   IF e = b THEN
      b := PrevWord (b) ;
      e := EndWord (b)
   END ;
   blkDef := TRUE ;
   blkShown := TRUE ;
   blkB := b ;
   blkE := e
END MarkWord ;

PROCEDURE ToggleBlock ;
BEGIN
   IF blkDef THEN blkShown := NOT blkShown END
END ToggleBlock ;

PROCEDURE CopyBlock (VAR dst : ARRAY OF CHAR) : CARDINAL ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (blkB + i < blkE) AND (i < HIGH (dst)) DO
      dst [i] := CharAt (blkB + i) ;
      INC (i)
   END ;
   RETURN i
END CopyBlock ;

PROCEDURE CopyBlockCmd ;
VAR buf : ARRAY [0..MaxCol * 4 + 8] OF CHAR ;
    n, at, i : CARDINAL ;
BEGIN
   IF NOT blkDef THEN RETURN END ;
   n := CopyBlock (buf) ;
   IF n = 0 THEN RETURN END ;
   at := CursorOff () ;
   i := 0 ;
   WHILE i < n DO
      InsertCh (at + i, buf [i]) ;
      INC (i)
   END ;
   Inserted (at, n) ;
   blkB := at ;
   blkE := at + n ;
   restoreOn := FALSE ;
   modified := TRUE
END CopyBlockCmd ;

PROCEDURE MoveBlockCmd ;
VAR buf : ARRAY [0..MaxCol * 4 + 8] OF CHAR ;
    n, at, del : CARDINAL ;
    i : CARDINAL ;
BEGIN
   IF NOT blkDef THEN RETURN END ;
   n := CopyBlock (buf) ;
   IF n = 0 THEN RETURN END ;
   at := CursorOff () ;
   IF (at >= blkB) AND (at <= blkE) THEN RETURN END ;
   del := blkE - blkB ;
   BufDeleteN (blkB, del) ;
   IF at > blkB THEN at := at - del END ;
   blkDef := FALSE ;
   i := 0 ;
   WHILE i < n DO
      InsertCh (at + i, buf [i]) ;
      INC (i)
   END ;
   Inserted (at, n) ;
   blkDef := TRUE ;
   blkB := at ;
   blkE := at + n ;
   restoreOn := FALSE ;
   modified := TRUE
END MoveBlockCmd ;

PROCEDURE DeleteBlockCmd ;
BEGIN
   IF blkDef AND (blkE > blkB) THEN
      BufDeleteN (blkB, blkE - blkB) ;
      blkDef := FALSE ;
      restoreOn := FALSE ;
      modified := TRUE
   END
END DeleteBlockCmd ;

(* ------------------------------------------------------------------ *)
(*  find / replace                                                    *)
(* ------------------------------------------------------------------ *)

PROCEDURE MatchAt (at : CARDINAL ; pa : ARRAY OF CHAR ;
                   ignoreCase : BOOLEAN) : BOOLEAN ;
VAR b, q, len2 : CARDINAL ;
    c1, c2 : CHAR ;
    f, l  : CARDINAL ;
BEGIN
   len2 := PatLen (pa) ;
   IF len2 = 0 THEN RETURN FALSE END ;
   q := 0 ;
   b := at ;
   WHILE q < len2 DO
      IF (pa [q] = C_M) AND (q + 1 < len2) AND (pa [q + 1] = C_J) THEN
         (* pattern CR LF matches a single CR in the buffer *)
         IF b >= Length () THEN RETURN FALSE END ;
         IF CharAt (b) # C_M THEN RETURN FALSE END ;
         INC (b) ;
         INC (q, 2)
      ELSIF pa [q] = C_A THEN
         (* Ctrl-A wildcard: any character *)
         IF b >= Length () THEN RETURN FALSE END ;
         INC (b) ;
         INC (q)
      ELSE
         IF b >= Length () THEN RETURN FALSE END ;
         c1 := CharAt (b) ;
         c2 := pa [q] ;
         IF ignoreCase THEN
            f := ORD (c1) ;
            l := ORD (c2) ;
            IF (f >= ORD ("a")) AND (f <= ORD ("z")) THEN f := f - 32 END ;
            IF (l >= ORD ("a")) AND (l <= ORD ("z")) THEN l := l - 32 END ;
            IF f # l THEN RETURN FALSE END
         ELSIF c1 # c2 THEN
            RETURN FALSE
         END ;
         INC (b) ;
         INC (q)
      END
   END ;
   RETURN TRUE
END MatchAt ;

PROCEDURE WordBounded (at : CARDINAL) : BOOLEAN ;
VAR len2 : CARDINAL ;
    c : CHAR ;
BEGIN
   len2 := PatLen (fnStr) ;
   IF at = 0 THEN
      (* ok at start of buffer *)
   ELSE
      c := CharAt (at - 1) ;
      IF NOT IsSep (c) THEN RETURN FALSE END
   END ;
   IF at + len2 >= Length () THEN
      (* ok at end of buffer *)
   ELSE
      c := CharAt (at + len2) ;
      IF NOT IsSep (c) THEN RETURN FALSE END
   END ;
   RETURN TRUE
END WordBounded ;

PROCEDURE FindFwd (from : CARDINAL) : CARDINAL ;
VAR i, len2 : CARDINAL ;
    found : BOOLEAN ;
BEGIN
   len2 := PatLen (fnStr) ;
   IF len2 = 0 THEN RETURN NoMark END ;
   found := FALSE ;
   i := from ;
   WHILE (i + len2 <= Length ()) AND NOT found DO
      IF MatchAt (i, fnStr, optU) AND
         ((NOT optW) OR WordBounded (i)) THEN
         found := TRUE
      ELSE
         INC (i)
      END
   END ;
   IF found THEN RETURN i END ;
   RETURN NoMark
END FindFwd ;

PROCEDURE FindBwd (from : CARDINAL) : CARDINAL ;
VAR i, len2 : CARDINAL ;
    found : CARDINAL ;
BEGIN
   len2 := PatLen (fnStr) ;
   IF len2 = 0 THEN RETURN NoMark END ;
   IF from > Length () THEN from := Length () END ;
   found := NoMark ;
   i := 0 ;
   WHILE i + len2 <= from DO
      IF MatchAt (i, fnStr, optU) AND
         ((NOT optW) OR WordBounded (i)) THEN
         found := i
      END ;
      INC (i)
   END ;
   RETURN found
END FindBwd ;

PROCEDURE PutCursorAfter (m : CARDINAL) ;
VAR len2, ln, cl : CARDINAL ;
BEGIN
   len2 := PatLen (fnStr) ;
   OffToPos (m + len2, ln, cl) ;
   ToPos (ln, cl)
END PutCursorAfter ;

PROCEDURE DoSeek (global : BOOLEAN) : BOOLEAN ;
VAR from, m : CARDINAL ;
BEGIN
   IF PatLen (fnStr) = 0 THEN RETURN FALSE END ;
   IF global THEN
      IF optB THEN from := Length () ELSE from := 0 END
   ELSIF optB THEN
      from := CursorOff ()
   ELSE
      from := CursorOff () + 1 ;
      IF from > Length () THEN from := Length () END
   END ;
   IF optB THEN m := FindBwd (from) ELSE m := FindFwd (from) END ;
   IF m = NoMark THEN
      MsgWait ("Target not found") ;
      RETURN FALSE
   END ;
   PutCursorAfter (m) ;
   RETURN TRUE
END DoSeek ;

PROCEDURE ReplAt (m : CARDINAL) : CARDINAL ;
VAR len2, rl, i, q : CARDINAL ;
    buf : ARRAY [0..64] OF CHAR ;
BEGIN
   len2 := PatLen (fnStr) ;
   rl := PatLen (rpStr) ;
   i := 0 ;
   WHILE i < rl DO
      buf [i] := rpStr [i] ;
      INC (i)
   END ;
   BufDeleteN (m, len2) ;
   q := 0 ;
   i := 0 ;
   WHILE i < rl DO
      IF (buf [i] = C_M) AND (i + 1 < rl) AND (buf [i + 1] = C_J) THEN
         InsertCh (m + q, C_M) ;
         Inserted (m + q, 1) ;
         INC (q) ;
         INC (i, 2)
      ELSE
         InsertCh (m + q, buf [i]) ;
         Inserted (m + q, 1) ;
         INC (q) ;
         INC (i)
      END
   END ;
   modified := TRUE ;
   RETURN m + q
END ReplAt ;

PROCEDURE ParseOptions (s : ARRAY OF CHAR) ;
VAR i, d, num : CARDINAL ;
    ch : CHAR ;
BEGIN
   optB := FALSE ; optG := FALSE ; optU := FALSE ; optW := FALSE ;
   optN := FALSE ; optN2 := 0 ;
   i := 0 ;
   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
      ch := s [i] ;
      IF (ch = "B") OR (ch = "b") THEN
         optB := TRUE
      ELSIF (ch = "G") OR (ch = "g") THEN
         optG := TRUE
      ELSIF (ch = "U") OR (ch = "u") THEN
         optU := TRUE
      ELSIF (ch = "W") OR (ch = "w") THEN
         optW := TRUE
      ELSIF (ch = "N") OR (ch = "n") THEN
         optN := TRUE
      ELSIF (ch >= "0") AND (ch <= "9") THEN
         num := 0 ;
         WHILE (i <= HIGH (s)) AND (s [i] >= "0") AND (s [i] <= "9") DO
            d := ORD (s [i]) - ORD ("0") ;
            num := num * 10 + d ;
            INC (i)
         END ;
         IF num > 0 THEN optN2 := num END ;
         DEC (i)
      END ;
      INC (i)
   END
END ParseOptions ;

PROCEDURE DoFind ;
VAR s : ARRAY [0..255] OF CHAR ;
    i, n : CARDINAL ;
BEGIN
   IF NOT ReadStatus ("Find: ", TRUE, s) THEN StatusLine ; RETURN END ;
   StrClear (fnStr) ;
   i := 0 ;
   LOOP
      IF (i <= HIGH (s)) AND (i <= 30) AND (s [i] # 0C) THEN
         fnStr [i] := s [i] ;
         INC (i)
      ELSE
         EXIT
      END
   END ;
   IF NOT ReadStatus ("Options: ", FALSE, s) THEN StatusLine ; RETURN END ;
   ParseOptions (s) ;
   lastFind := TRUE ;
   lastIsReplace := FALSE ;
   IF DoSeek (optG) THEN
      n := optN2 ;
      WHILE n > 1 DO
         IF NOT DoSeek (FALSE) THEN n := 1 END ;
         DEC (n)
      END
   END ;
   StatusLine
END DoFind ;

PROCEDURE DoReplace ;
VAR s : ARRAY [0..255] OF CHAR ;
    i, from, m, after, len2, cnt : CARDINAL ;
    cont, ask, yes : BOOLEAN ;
    ch : CHAR ;
BEGIN
   IF NOT ReadStatus ("Find: ", TRUE, s) THEN StatusLine ; RETURN END ;
   StrClear (fnStr) ;
   i := 0 ;
   LOOP
      IF (i <= HIGH (s)) AND (i <= 30) AND (s [i] # 0C) THEN
         fnStr [i] := s [i] ;
         INC (i)
      ELSE
         EXIT
      END
   END ;
   IF NOT ReadStatus ("Replace with: ", TRUE, s) THEN StatusLine ; RETURN END ;
   StrClear (rpStr) ;
   i := 0 ;
   LOOP
      IF (i <= HIGH (s)) AND (i <= 30) AND (s [i] # 0C) THEN
         rpStr [i] := s [i] ;
         INC (i)
      ELSE
         EXIT
      END
   END ;
   IF NOT ReadStatus ("Options: ", FALSE, s) THEN StatusLine ; RETURN END ;
   ParseOptions (s) ;
   lastFind := TRUE ;
   lastIsReplace := TRUE ;
   IF optG THEN
      IF optB THEN from := Length () ELSE from := 0 END
   ELSIF optB THEN
      from := CursorOff ()
   ELSE
      from := CursorOff () + 1 ;
      IF from > Length () THEN from := Length () END
   END ;
   len2 := PatLen (fnStr) ;
   IF len2 = 0 THEN RETURN END ;
   cont := TRUE ;
   cnt := 0 ;
   LOOP
      IF NOT cont THEN EXIT END ;
      IF optB THEN m := FindBwd (from) ELSE m := FindFwd (from) END ;
      IF m = NoMark THEN EXIT END ;
      ask := NOT optN ;
      yes := optN ;
      IF ask THEN
         GotoXY (TopRow, 1) ;
         ScrnWide (Broad) ;
         GotoXY (TopRow, 1) ;
         PutStr ("Replace (Y/N)?") ;
         GetCh (ch) ;
         StatusLine ;
         IF ch = C_U THEN EXIT END ;
         yes := (ch = "Y") OR (ch = "y")
      END ;
      IF yes THEN
         INC (cnt) ;
         after := ReplAt (m) ;
         IF optB THEN
            from := m ;
            IF m = 0 THEN cont := FALSE END
         ELSE
            from := after
         END
      ELSE
         IF optB THEN
            from := m ;
            IF m = 0 THEN cont := FALSE END
         ELSE
            from := m + len2
         END
      END ;
      IF (optN2 > 0) AND (cnt >= optN2) THEN cont := FALSE END
   END ;
   StatusLine
END DoReplace ;

PROCEDURE RepeatLast ;
BEGIN
   IF NOT lastFind THEN RETURN END ;
   IF lastIsReplace THEN DoReplace ELSE DoFind END
END RepeatLast ;

(* ------------------------------------------------------------------ *)
(*  block file I/O                                                    *)
(* ------------------------------------------------------------------ *)

PROCEDURE HasDot (s : ARRAY OF CHAR) : BOOLEAN ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
      IF s [i] = "." THEN RETURN TRUE END ;
      INC (i)
   END ;
   RETURN FALSE
END HasDot ;

PROCEDURE ToFileName (VAR s : ARRAY OF CHAR) ;
VAR len2 : CARDINAL ;
BEGIN
   len2 := PatLen (s) ;
   IF len2 = 0 THEN RETURN END ;
   IF s [len2 - 1] = "." THEN
      s [len2 - 1] := 0C ;
      RETURN
   END ;
   IF NOT HasDot (s) THEN
      IF len2 + 4 <= HIGH (s) THEN
         s [len2] := "." ;
         s [len2 + 1] := "P" ;
         s [len2 + 2] := "A" ;
         s [len2 + 3] := "S" ;
         s [len2 + 4] := 0C
      END
   END
END ToFileName ;

PROCEDURE FileExists (s : ARRAY OF CHAR) : BOOLEAN ;
VAR fd : INTEGER ;
BEGIN
   fd := open (ADR (s), 0, 0) ;
   IF fd < 0 THEN RETURN FALSE END ;
   trash := close (fd) ;
   RETURN TRUE
END FileExists ;

PROCEDURE ReadFileAt (s : ARRAY OF CHAR ; at : CARDINAL) : BOOLEAN ;
VAR fd : INTEGER ;
    buf : ARRAY [0..1023] OF BYTE ;
    got, i : LONGINT ;
    n : CARDINAL ;
    pos : CARDINAL ;
    b : BYTE ;
    prevCR, huge, eof : BOOLEAN ;
BEGIN
   fd := open (ADR (s), 0, 0) ;
   IF fd < 0 THEN
      MsgWait ("File not found") ;
      RETURN FALSE
   END ;
   huge := FALSE ;
   pos := at ;
   prevCR := FALSE ;
   eof := FALSE ;
   LOOP
      IF eof THEN EXIT END ;
      got := read (fd, ADR (buf), 1024) ;
      IF got <= 0 THEN EXIT END ;
      n := VAL (CARDINAL, got) ;
      i := 0 ;
      WHILE i < VAL (LONGINT, n) DO
         b := buf [i] ;
         IF b = CHR (26) THEN
            eof := TRUE ;
            i := VAL (LONGINT, n)
         ELSE
            IF Length () >= TextLimit THEN
               huge := TRUE
            ELSE
               IF b = CHR (10) THEN
                  IF NOT prevCR THEN
                     InsertCh (pos, C_M) ;
                     Inserted (pos, 1) ;
                     INC (pos)
                  END ;
                  prevCR := FALSE
               ELSIF b = CHR (13) THEN
                  InsertCh (pos, C_M) ;
                  Inserted (pos, 1) ;
                  INC (pos) ;
                  prevCR := TRUE
               ELSE
                  InsertCh (pos, CHR (b)) ;
                  Inserted (pos, 1) ;
                  INC (pos) ;
                  prevCR := FALSE
               END
            END ;
            INC (i)
         END
      END
   END ;
   trash := close (fd) ;
   IF huge THEN MsgWait ("WARNING: Out of space") END ;
   RETURN TRUE
END ReadFileAt ;

PROCEDURE WriteBlockTo (s : ARRAY OF CHAR) ;
VAR fd : INTEGER ;
    i : CARDINAL ;
    b : BYTE ;
    ch : CHAR ;
BEGIN
   IF NOT (blkDef AND (blkE > blkB)) THEN RETURN END ;
   IF FileExists (s) THEN
      GotoXY (TopRow, 1) ;
      ScrnWide (Broad) ;
      GotoXY (TopRow, 1) ;
      PutStr ("Overwrite old ") ;
      PutStr (s) ;
      PutStr (" (Y/N)?") ;
      GetCh (ch) ;
      StatusLine ;
      IF NOT ((ch = "Y") OR (ch = "y")) THEN RETURN END
   END ;
   fd := open (ADR (s), 1 + 512 + 64, 420) ;
   IF fd < 0 THEN
      MsgWait ("Unable to create ") ;
      RETURN
   END ;
   i := blkB ;
   WHILE i < blkE DO
      IF CharAt (i) = C_M THEN
         b := CHR (13) ;
         trash := write (fd, ADR (b), 1) ;
         b := CHR (10) ;
         trash := write (fd, ADR (b), 1)
ELSE
          b := VAL (BYTE, ORD (CharAt (i))) ;
          trash := write (fd, ADR (b), 1)
       END ;
      INC (i)
   END ;
   trash := close (fd)
END WriteBlockTo ;

PROCEDURE ReadBlockToCursor ;
VAR s : ARRAY [0..255] OF CHAR ;
    at, startLen : CARDINAL ;
BEGIN
   IF NOT ReadStatus ("Read block from file ", FALSE, s) THEN
      StatusLine ;
      RETURN
   END ;
   ToFileName (s) ;
   startLen := Length () ;
   at := CursorOff () ;
   IF ReadFileAt (s, at) THEN
      blkDef := TRUE ;
      blkShown := TRUE ;
      blkB := at ;
      blkE := at + (Length () - startLen) ;
      modified := TRUE
   END ;
   StatusLine
END ReadBlockToCursor ;

PROCEDURE WriteBlockCmd ;
VAR s : ARRAY [0..255] OF CHAR ;
BEGIN
   IF NOT (blkDef AND (blkE > blkB)) THEN RETURN END ;
   IF NOT ReadStatus ("Write block to file ", FALSE, s) THEN
      StatusLine ;
      RETURN
   END ;
   ToFileName (s) ;
   WriteBlockTo (s) ;
   StatusLine
END WriteBlockCmd ;

(* ------------------------------------------------------------------ *)
(*  key handling                                                      *)
(* ------------------------------------------------------------------ *)

PROCEDURE AutoTab ;
VAR ln, i, nextCol : CARDINAL ;
    started : BOOLEAN ;
BEGIN
   IF curLine = 0 THEN Beep ; RETURN END ;
   ln := curLine - 1 ;
   started := FALSE ;
   nextCol := 0 ;
   i := curCol ;
   LOOP
      IF i >= LineLen (ln) THEN EXIT END ;
      IF NOT IsSep (CharAt (LineStart (ln) + i)) THEN
         nextCol := i ;
         started := TRUE ;
         EXIT
      END ;
      INC (i)
   END ;
   IF NOT started THEN Beep ; RETURN END ;
   curCol := nextCol ;
   IF curCol > LineLen (curLine) THEN curCol := LineLen (curLine) END
END AutoTab ;

PROCEDURE HandleEsc ;
VAR k : CHAR ;
BEGIN
   GetKey (k) ;
   IF k = "[" THEN
      GetCh (k) ;
      IF k = "A" THEN
         LineUp
      ELSIF k = "B" THEN
         LineDown
      ELSIF k = "C" THEN
         CharRight
      ELSIF k = "D" THEN
         CharLeft
      ELSIF k = "H" THEN
         HomeLine
      ELSIF k = "F" THEN
         EndLine
      ELSIF k = "3" THEN
         GetCh (k) ;
         DeleteChar
      ELSIF k = "5" THEN
         GetCh (k) ;
         PageUp
      ELSIF k = "6" THEN
         GetCh (k) ;
         PageDown
      ELSIF k = "Z" THEN
         AutoTab
      END
   END
END HandleEsc ;

PROCEDURE Up (ch : CHAR) : CHAR ;
BEGIN
   IF (ch >= "a") AND (ch <= "z") THEN
      RETURN CHR (ORD (ch) - 32)
   END ;
   RETURN ch
END Up ;

PROCEDURE KCommand ;
VAR ch : CHAR ;
BEGIN
   GetCh (ch) ;
   IF ch = Esc THEN RETURN END ;
   ch := Up (ch) ;
   IF ch = C_D THEN
      ch := "D"          (* tolerate the held-Ctrl chord Ctrl-K-Ctrl-D *)
   ELSIF ch = C_X THEN
      ch := "X"          (* tolerate Ctrl-K-Ctrl-X as well *)
   END ;
   IF ch = "B" THEN
      MarkBlockB
   ELSIF ch = "K" THEN
      MarkBlockE
   ELSIF ch = "T" THEN
      MarkWord
   ELSIF ch = "H" THEN
      ToggleBlock
   ELSIF ch = "C" THEN
      CopyBlockCmd
   ELSIF ch = "V" THEN
      MoveBlockCmd
   ELSIF ch = "Y" THEN
      DeleteBlockCmd
   ELSIF ch = "R" THEN
      ReadBlockToCursor
   ELSIF ch = "W" THEN
      WriteBlockCmd
   ELSIF ch = "D" THEN
      endEdit := TRUE
   ELSE
      Beep
   END
END KCommand ;

PROCEDURE QCommand ;
VAR ch : CHAR ;
BEGIN
   GetCh (ch) ;
   IF ch = Esc THEN RETURN END ;
   ch := Up (ch) ;
   IF ch = "S" THEN
      HomeLine
   ELSIF ch = "D" THEN
      EndLine
   ELSIF ch = "E" THEN
      HomeScreen
   ELSIF ch = "X" THEN
      EndScreen
   ELSIF ch = "R" THEN
      HomeFile
   ELSIF ch = "C" THEN
      EndFile
   ELSIF ch = "B" THEN
      ToBlockB
   ELSIF ch = "K" THEN
      ToBlockE
   ELSIF ch = "P" THEN
      ToLastPos
   ELSIF ch = "Y" THEN
      DeleteToEOL
   ELSIF ch = "L" THEN
      RestoreLine
   ELSIF ch = "I" THEN
      autoIndent := NOT autoIndent
   ELSIF ch = "F" THEN
      DoFind
   ELSIF ch = "A" THEN
      DoReplace
   ELSE
      Beep
   END
END QCommand ;

PROCEDURE MainLoop ;
VAR ch : CHAR ;
BEGIN
   endEdit := FALSE ;
   LOOP
      DrawScreen ;
      PositionCursor ;
      GetCh (ch) ;
      IF ch = Esc THEN
         HandleEsc
      ELSIF ch = keys.quit THEN
         QCommand
      ELSIF ch = keys.prefix THEN
         KCommand
      ELSIF ch = keys.literal THEN
         GetCh (ch) ;
         IF NOT ((ch = Esc) OR (ch = keys.charLeft)) THEN
            BufInsert (CursorOff (), ch) ;
            INC (curCol) ;
            restoreOn := FALSE ;
            modified := TRUE
         END
      ELSIF ch = keys.wordLeft THEN
         WordLeft
      ELSIF ch = keys.charLeft THEN
         CharLeft
      ELSIF ch = keys.charRight THEN
         CharRight
      ELSIF ch = keys.wordRight THEN
         WordRight
      ELSIF ch = keys.lineUp THEN
         LineUp
      ELSIF ch = keys.lineDown THEN
         LineDown
      ELSIF ch = keys.scrollUp THEN
         ScrollUp
      ELSIF ch = keys.scrollDown THEN
         ScrollDown
      ELSIF ch = keys.pageUp THEN
         PageUp
      ELSIF ch = keys.pageDown THEN
         PageDown
      ELSIF ch = keys.insertToggle THEN
         insertMode := NOT insertMode
      ELSIF ch = keys.deleteChar THEN
         DeleteChar
      ELSIF (ch = Del) OR (ch = keys.deleteLeft) THEN
         DeleteLeft
      ELSIF ch = keys.deleteWord THEN
         DeleteWord
      ELSIF ch = keys.insertBreak THEN
         InsertBreak
      ELSIF ch = keys.deleteLine THEN
         DeleteLine
      ELSIF ch = keys.repeatLast THEN
         RepeatLast
      ELSIF ch = keys.cancel THEN
         Beep
      ELSIF ch = keys.autoTab THEN
         AutoTab
      ELSIF (ch = keys.newLine) OR (ch = C_J) THEN
         NewLine
      ELSIF (ch >= " ") AND (ch <= "~") THEN
         TypeChar (ch)
      END ;
      IF endEdit THEN EXIT END
   END
END MainLoop ;

(* ------------------------------------------------------------------ *)

PROCEDURE Run (drv : CHAR ; VAR fileName : ARRAY OF CHAR ;
               VAR changed : BOOLEAN) ;
VAR i : CARDINAL ;
    kok : BOOLEAN ;
BEGIN
   (* The key map: TP3.KEY beside the shell, or the built-in defaults.  Read
      once per Run (the file can change between edits without restarting). *)
   Keys.Load ("TP3.KEY", keys, kok) ;
   drive := drv ;
   i := 0 ;
   LOOP
      fname [i] := fileName [i] ;
      IF (i >= HIGH (fname)) OR (i >= HIGH (fileName))
         OR (fileName [i] = 0C) THEN EXIT END ;
      INC (i)
   END ;

   IF gotoPend THEN
      gotoPend := FALSE ;
      OffToPos (gotoOff, curLine, curCol) ;
      ClampCursor
   ELSE
      curLine := 0 ;
      curCol := 0
   END ;
   topLine := 0 ;
   colOff := 0 ;
   insertMode := TRUE ;
   autoIndent := TRUE ;
   haveLast := FALSE ;
   blkDef := FALSE ;
   blkShown := FALSE ;
   restoreOn := FALSE ;
   lastFind := FALSE ;
   modified := FALSE ;

   MainLoop ;

   changed := modified
END Run ;

END Editor.