| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586 |
- 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.
|