فهرست منبع

TP3-comp: WordStar-style editor with TextBuf-backed shell

- TextBuf.def/mod: shared CR-terminated buffer (Clear, CharAt, InsertCh,
  OverwriteCh, DeleteAt, DeleteFromTo), TextLimit 62903
- Posix.def/Posix.c: add poll() binding
- Term.def/mod: add Avail() and GetKey() (poll-based non-blocking raw input)
- Editor.def/mod: full-screen TP3 editor - status line, movement (char/word/
  line/page/screen/file), find/replace with options (B/G/n/U/W/N), block
  operations (mark/hide/copy/move/delete/write/read), auto-indent, insert/
  overwrite modes, CRLF file I/O, Ctrl-K-D returns to shell
- Shell.mod: switch work-file buffer from local byte array to TextBuf,
  normalize CRLF on load /\^Z save, run Editor via CmdEditor (prompts for
  work file when unset, kgetfn-style)
- untrack build artifacts (.o, tpshell)
Eric Streit 2 هفته پیش
والد
کامیت
570048cd3c
15فایلهای تغییر یافته به همراه1820 افزوده شده و 27 حذف شده
  1. 2 0
      .gitignore
  2. 11 0
      shell/Editor.def
  3. 1586 0
      shell/Editor.mod
  4. 9 3
      shell/Makefile
  5. 5 0
      shell/Posix.c
  6. 3 0
      shell/Posix.def
  7. BIN
      shell/Posix.o
  8. 50 23
      shell/Shell.mod
  9. BIN
      shell/Shell.o
  10. 6 0
      shell/Term.def
  11. 31 1
      shell/Term.mod
  12. BIN
      shell/Term.o
  13. 32 0
      shell/TextBuf.def
  14. 85 0
      shell/TextBuf.mod
  15. BIN
      shell/tpshell

+ 2 - 0
.gitignore

@@ -0,0 +1,2 @@
+*.o
+shell/tpshell

+ 11 - 0
shell/Editor.def

@@ -0,0 +1,11 @@
+DEFINITION MODULE Editor ;
+
+(* WordStar-style full-screen editor for the TP3 project.
+   Operates directly on TextBuf (the shared TP3 text buffer).
+   Returns to the menu on Ctrl-K-D; leaves the text in memory
+   and reports whether any editing happened via "changed". *)
+
+PROCEDURE Run (drive : CHAR ; VAR fileName : ARRAY OF CHAR ;
+               VAR changed : BOOLEAN) ;
+
+END Editor.

+ 1586 - 0
shell/Editor.mod

@@ -0,0 +1,1586 @@
+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 ;
+
+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 ;
+
+   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 *)
+
+   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 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 = "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 = C_Q THEN
+         QCommand
+      ELSIF ch = C_K THEN
+         KCommand
+      ELSIF ch = C_P THEN
+         GetCh (ch) ;
+         IF NOT ((ch = Esc) OR (ch = C_U)) THEN
+            BufInsert (CursorOff (), ch) ;
+            INC (curCol) ;
+            restoreOn := FALSE ;
+            modified := TRUE
+         END
+      ELSIF ch = C_A THEN
+         WordLeft
+      ELSIF ch = C_S THEN
+         CharLeft
+      ELSIF ch = C_D THEN
+         CharRight
+      ELSIF ch = C_F THEN
+         WordRight
+      ELSIF ch = C_E THEN
+         LineUp
+      ELSIF ch = C_X THEN
+         LineDown
+      ELSIF ch = C_W THEN
+         ScrollUp
+      ELSIF ch = C_Z THEN
+         ScrollDown
+      ELSIF ch = C_R THEN
+         PageUp
+      ELSIF ch = C_C THEN
+         PageDown
+      ELSIF ch = C_V THEN
+         insertMode := NOT insertMode
+      ELSIF ch = C_G THEN
+         DeleteChar
+      ELSIF ch = Del THEN
+         DeleteLeft
+      ELSIF ch = C_H THEN
+         DeleteLeft
+      ELSIF ch = C_T THEN
+         DeleteWord
+      ELSIF ch = C_N THEN
+         InsertBreak
+      ELSIF ch = C_Y THEN
+         DeleteLine
+      ELSIF ch = C_L THEN
+         RepeatLast
+      ELSIF ch = C_U THEN
+         Beep
+      ELSIF ch = C_I THEN
+         AutoTab
+      ELSIF (ch = C_M) 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 ;
+BEGIN
+   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 ;
+
+   curLine := 0 ;
+   curCol := 0 ;
+   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.

+ 9 - 3
shell/Makefile

@@ -4,15 +4,21 @@ FLAGS = -fiso
 
 all: tpshell
 
-tpshell: Shell.mod Shell.o Term.o Posix.o
-	$(GM2) $(FLAGS) -o $@ Shell.mod Term.o Posix.o
+tpshell: Editor.mod Shell.mod Shell.o Term.o Posix.o TextBuf.o Editor.o
+	$(GM2) $(FLAGS) -o $@ Shell.mod Term.o Posix.o TextBuf.o Editor.o
 
-Shell.o: Shell.mod Term.def Posix.def
+Shell.o: Shell.mod Term.def Posix.def Editor.def TextBuf.def
 	$(GM2) $(FLAGS) -c Shell.mod
 
 Term.o: Term.mod Term.def Posix.def
 	$(GM2) $(FLAGS) -c Term.mod
 
+TextBuf.o: TextBuf.mod TextBuf.def
+	$(GM2) $(FLAGS) -c TextBuf.mod
+
+Editor.o: Editor.mod Editor.def Term.def TextBuf.def Posix.def
+	$(GM2) $(FLAGS) -c Editor.mod
+
 Posix.o: Posix.c
 	$(CC) -c Posix.c
 

+ 5 - 0
shell/Posix.c

@@ -1,5 +1,6 @@
 #include <dirent.h>
 #include <fcntl.h>
+#include <poll.h>
 #include <stdio.h>
 #include <sys/statvfs.h>
 #include <sys/stat.h>
@@ -67,4 +68,8 @@ int Posix_tcsetattr(int fd, int opt, void *t) {
 
 void Posix_cfmakeraw(void *t) {
     cfmakeraw((struct termios *)t);
+}
+
+int Posix_poll(void *fds, unsigned long nfds, int timeout) {
+    return poll(fds, nfds, timeout);
 }

+ 3 - 0
shell/Posix.def

@@ -50,4 +50,7 @@ PROCEDURE tcgetattr (fd : INTEGER ; t : ADDRESS) : INTEGER ;
 PROCEDURE tcsetattr (fd : INTEGER ; opt : INTEGER ; t : ADDRESS) : INTEGER ;
 PROCEDURE cfmakeraw (t : ADDRESS) ;
 
+(* poll(2): wait for readiness on pollfds (POLLIN = 1) *)
+PROCEDURE poll (fds : ADDRESS ; nfds : LONGCARD ; timeout : INTEGER) : INTEGER ;
+
 END Posix.

BIN
shell/Posix.o


+ 50 - 23
shell/Shell.mod

@@ -15,18 +15,20 @@ FROM Posix IMPORT
    getcwd, chdir, opendir, readdir, closedir, statvfs,
    Dir, dirent, statvfsbuf ;
 
+FROM Editor IMPORT Run ;
+
+FROM TextBuf IMPORT
+   TextLimit, Clear, Length, CharAt, InsertCh ;
+
 FROM SYSTEM IMPORT ADR, ADDRESS, BYTE ;
 
 CONST
-   TextLimit = 62903 ;
    O_RDONLY  = 0 ;      (* linux *)
 
 VAR
    drive     : CHAR ;
    workName  : ARRAY [0..255] OF CHAR ;
    mainName  : ARRAY [0..255] OF CHAR ;
-   txt       : ARRAY [0..TextLimit] OF BYTE ;
-   txtLen    : CARDINAL ;
    changed   : BOOLEAN ;
 
    codeDest  : CARDINAL ;        (* 0=Memory, 1=COM, 2=CHN *)
@@ -290,8 +292,16 @@ BEGIN
       RETURN
    END ;
    i := 0 ;
-   WHILE i < txtLen DO
-      w := write (fd, ADR (txt [i]), 1) ;
+   WHILE i < Length () DO
+      IF CharAt (i) = CHR (13) THEN
+         b := CHR (13) ;
+         w := write (fd, ADR (b), 1) ;
+         b := CHR (10) ;
+         w := write (fd, ADR (b), 1)
+      ELSE
+         b := VAL (BYTE, ORD (CharAt (i))) ;
+         w := write (fd, ADR (b), 1)
+      END ;
       INC (i)
    END ;
    b := CHR (26) ;                        (* EOF marker ^Z, TP3 style *)
@@ -308,10 +318,9 @@ END SaveWorkFile ;
 PROCEDURE LoadWorkFile ;
 VAR fd       : INTEGER ;
     path     : ARRAY [0..511] OF CHAR ;
-    n, i     : CARDINAL ;
     k        : LONGINT ;
     b        : BYTE ;
-    tooBig   : BOOLEAN ;
+    prevCR, tooBig : BOOLEAN ;
 BEGIN
    StrClear (path) ;
    StrAppend (path, workName) ;
@@ -319,16 +328,17 @@ BEGIN
    IF fd < 0 THEN
       PutStr ("New File") ;
       CrLf ;
-      txtLen := 0 ;
+      Clear ;
       changed := FALSE ;
       Pause ;
       RETURN
    END ;
 
    tooBig := FALSE ;
-   txtLen := 0 ;
+   prevCR := FALSE ;
+   Clear ;
    LOOP
-      IF txtLen >= TextLimit THEN
+      IF Length () >= TextLimit THEN
          tooBig := TRUE ;
          EXIT
       END ;
@@ -338,9 +348,18 @@ BEGIN
       END ;
       IF b = CHR (26) THEN
          EXIT
-      END ;
-      txt [txtLen] := b ;
-      INC (txtLen)
+      ELSIF b = CHR (10) THEN
+         IF NOT prevCR THEN
+            InsertCh (Length (), CHR (13))   (* lone LF -> CR *)
+         END ;
+         prevCR := FALSE
+      ELSIF b = CHR (13) THEN
+         InsertCh (Length (), CHR (13)) ;
+         prevCR := TRUE
+      ELSE
+         InsertCh (Length (), CHR (ORD (b))) ;
+         prevCR := FALSE
+      END
    END ;
    k := close (fd) ;
    IF tooBig THEN
@@ -505,10 +524,10 @@ BEGIN
 
    GotoXY (11, 1) ;
    PutStr ("Text: ") ;
-   PutCard (txtLen) ;
+   PutCard (Length ()) ;
    PutStr (" bytes") ;
 
-   freeB := TextLimit - txtLen ;
+   freeB := TextLimit - Length ();
    GotoXY (12, 1) ;
    PutStr ("Free: ") ;
    PutCard (freeB) ;
@@ -622,12 +641,20 @@ BEGIN
 END CmdRun ;
 
 PROCEDURE CmdEditor ;
+VAR edChanged : BOOLEAN ;
 BEGIN
-   ClrScr ;
-   GotoXY (1, 1) ;
-   PutStr ("Editor under construction - press ESC") ;
-   CrLf ;
-   WaitEsc
+   IF StrLen (workName) = 0 THEN
+      (* kgetfn: no work file yet -> prompt just like W does *)
+      CmdWorkFile ;
+      IF StrLen (workName) = 0 THEN
+         RETURN
+      END
+   END ;
+   edChanged := FALSE ;
+   Run (drive, workName, edChanged) ;
+   IF edChanged THEN
+      changed := TRUE
+   END
 END CmdEditor ;
 
 (* ------------------------------------------------------------------ *)
@@ -683,8 +710,8 @@ BEGIN
          PutStr ("Compile   ->   Memory")
       END ;
       CrLf ;
-      PutStr ("Text: ") ;
-      PutCard (txtLen) ;
+PutStr ("Text: ") ;
+   PutCard (Length ()) ;
       PutStr ("  Code: ") ;
       PutHex (minCode) ;
       PutStr ("  Data: ") ;
@@ -759,7 +786,7 @@ BEGIN
    StrClear (workName) ;
    StrClear (mainName) ;
    StrClear (paramLine) ;
-   txtLen := 0 ;
+   Clear ;
    changed := FALSE ;
 
    LOOP

BIN
shell/Shell.o


+ 6 - 0
shell/Term.def

@@ -34,6 +34,12 @@ PROCEDURE Normal ;   (* back to normal attribute *)
 PROCEDURE GetCh (VAR ch : CHAR) ;
 (* blocking read of a single raw key *)
 
+PROCEDURE Avail () : BOOLEAN ;
+(* true if a key is already waiting (non-blocking) *)
+
+PROCEDURE GetKey (VAR ch : CHAR) ;
+(* read one byte if available, else ch := 0C *)
+
 PROCEDURE Beep ;
 
 END Term.

+ 31 - 1
shell/Term.mod

@@ -2,7 +2,7 @@ IMPLEMENTATION MODULE Term ;
 
 (* termios-based raw keyboard + ANSI screen output. *)
 
-FROM Posix IMPORT read, write, tcgetattr, tcsetattr, cfmakeraw ;
+FROM Posix IMPORT read, write, tcgetattr, tcsetattr, cfmakeraw, poll ;
 FROM SYSTEM IMPORT ADR, ADDRESS, BYTE ;
 
 CONST
@@ -148,6 +148,36 @@ BEGIN
    END
 END GetCh ;
 
+PROCEDURE Avail () : BOOLEAN ;
+TYPE PollFd = RECORD
+   fd      : CARDINAL ;
+   events  : SHORTCARD ;
+   revents : SHORTCARD ;
+   END ;
+VAR pfd : PollFd ;
+    n   : INTEGER ;
+BEGIN
+   (* struct pollfd { int fd; short events; short revents; } *)
+   pfd.fd := STDIN ;
+   pfd.events := 1 ;             (* POLLIN *)
+   pfd.revents := 0 ;
+   n := poll (ADR (pfd), 1, 0) ;
+   RETURN n > 0
+END Avail ;
+
+PROCEDURE GetKey (VAR ch : CHAR) ;
+VAR n : LONGINT ;
+BEGIN
+   IF Avail () THEN
+      n := read (STDIN, ADR (ch), 1) ;
+      IF n # 1 THEN
+         ch := 0C
+      END
+   ELSE
+      ch := 0C
+   END
+END GetKey ;
+
 PROCEDURE Beep ;
 VAR n : LONGINT ;
     b  : CHAR ;

BIN
shell/Term.o


+ 32 - 0
shell/TextBuf.def

@@ -0,0 +1,32 @@
+DEFINITION MODULE TextBuf ;
+
+(* Shared TP3-style text buffer: an array of characters in which lines
+   are terminated by CR ($0D).  Used by the shell (load/save) and by the
+   editor.  The buffer never stores a trailing ^Z. *)
+
+CONST
+   TextLimit = 62903 ;
+
+PROCEDURE Clear ;
+(* reset the buffer to empty *)
+
+PROCEDURE Length () : CARDINAL ;
+(* number of characters currently stored *)
+
+PROCEDURE CharAt (i : CARDINAL) : CHAR ;
+(* character at offset i; 0 <= i < Length *)
+
+PROCEDURE InsertCh (i : CARDINAL ; ch : CHAR) ;
+(* insert one character at offset i, shifting text right.
+   Does nothing if the buffer is full. *)
+
+PROCEDURE OverwriteCh (i : CARDINAL ; ch : CHAR) ;
+(* replace the character at offset i (no insertion) *)
+
+PROCEDURE DeleteAt (i : CARDINAL) ;
+(* delete one character at offset i, shifting text left *)
+
+PROCEDURE DeleteFromTo (i, n : CARDINAL) ;
+(* delete n characters starting at offset i *)
+
+END TextBuf.

+ 85 - 0
shell/TextBuf.mod

@@ -0,0 +1,85 @@
+IMPLEMENTATION MODULE TextBuf ;
+
+VAR
+   buf : ARRAY [0..TextLimit] OF CHAR ;   (* we use Indx as the stored length,
+                                            no CR terminator needed *)
+   used : CARDINAL ;
+
+   (* The characters live in buf[0 .. used-1].  Lines end with CR. *)
+
+PROCEDURE Clear ;
+BEGIN
+   used := 0
+END Clear ;
+
+PROCEDURE Length () : CARDINAL ;
+BEGIN
+   RETURN used
+END Length ;
+
+PROCEDURE CharAt (i : CARDINAL) : CHAR ;
+BEGIN
+   RETURN buf [i]
+END CharAt ;
+
+PROCEDURE InsertCh (i : CARDINAL ; ch : CHAR) ;
+VAR j : CARDINAL ;
+BEGIN
+   IF used >= TextLimit THEN
+      RETURN
+   END ;
+   IF i > used THEN
+      i := used
+   END ;
+   j := used ;
+   WHILE j > i DO
+      buf [j] := buf [j - 1] ;
+      DEC (j)
+   END ;
+   buf [i] := ch ;
+   INC (used)
+END InsertCh ;
+
+PROCEDURE OverwriteCh (i : CARDINAL ; ch : CHAR) ;
+BEGIN
+   IF i < used THEN
+      buf [i] := ch
+   ELSE
+      InsertCh (i, ch)
+   END
+END OverwriteCh ;
+
+PROCEDURE DeleteAt (i : CARDINAL) ;
+VAR j : CARDINAL ;
+BEGIN
+   IF i >= used THEN
+      RETURN
+   END ;
+   j := i ;
+   WHILE j < used - 1 DO
+      buf [j] := buf [j + 1] ;
+      INC (j)
+   END ;
+   DEC (used)
+END DeleteAt ;
+
+PROCEDURE DeleteFromTo (i, n : CARDINAL) ;
+VAR j : CARDINAL ;
+BEGIN
+   IF i >= used THEN
+      RETURN
+   END ;
+   IF i + n > used THEN
+      n := used - i
+   END ;
+   j := i ;
+   WHILE j + n < used DO
+      buf [j] := buf [j + n] ;
+      INC (j)
+   END ;
+   DEC (used, n)
+END DeleteFromTo ;
+
+BEGIN
+   used := 0
+END TextBuf.

BIN
shell/tpshell