| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591 |
- 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 = 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 ;
- 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.
|