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 *) 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 = 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 ; 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.