Editor.mod 37 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586
  1. IMPLEMENTATION MODULE Editor ;
  2. FROM Term IMPORT
  3. GotoXY, PutCh, PutStr, PutCard, ScrnWide, Marked, Normal,
  4. GetCh, Avail, GetKey, Beep ;
  5. FROM TextBuf IMPORT
  6. TextLimit, CharAt, InsertCh, OverwriteCh, DeleteFromTo, Length ;
  7. FROM Posix IMPORT
  8. open, close, read, write ;
  9. FROM SYSTEM IMPORT ADR, BYTE ;
  10. CONST
  11. Broad = 80 ; (* columns on the screen *)
  12. TopRow = 1 ;
  13. NBufRows = 23 ; (* text rows: screen rows 2..24 *)
  14. FirstRow = 2 ;
  15. MaxCol = 125 ; (* max chars per line before CR *)
  16. NoMark = 0FFFFFFFFH ; (* not-found / not-set value *)
  17. (* control keys *)
  18. C_A = CHR (1) ; C_C = CHR (3) ; C_D = CHR (4) ; C_E = CHR (5) ;
  19. C_F = CHR (6) ; C_G = CHR (7) ; C_H = CHR (8) ; C_I = CHR (9) ;
  20. C_J = CHR (10) ; C_K = CHR (11) ; C_L = CHR (12) ; C_M = CHR (13) ;
  21. C_N = CHR (14) ; C_P = CHR (16) ; C_Q = CHR (17) ; C_R = CHR (18) ;
  22. C_S = CHR (19) ; C_T = CHR (20) ; C_U = CHR (21) ; C_V = CHR (22) ;
  23. C_W = CHR (23) ; C_X = CHR (24) ; C_Y = CHR (25) ; C_Z = CHR (26) ;
  24. Esc = CHR (27) ; Del = CHR (127) ;
  25. VAR
  26. drive : CHAR ;
  27. fname : ARRAY [0..255] OF CHAR ;
  28. modified : BOOLEAN ;
  29. curLine, curCol : CARDINAL ; (* 0-based cursor *)
  30. topLine : CARDINAL ; (* first visible line *)
  31. colOff : CARDINAL ; (* horizontal scroll *)
  32. insertMode : BOOLEAN ;
  33. autoIndent : BOOLEAN ;
  34. haveLast : BOOLEAN ; (* last cursor position remembered *)
  35. lastLine, lastCol : CARDINAL ;
  36. blkDef : BOOLEAN ; (* a block has been marked *)
  37. blkShown : BOOLEAN ; (* block is displayed *)
  38. blkB, blkE : CARDINAL ; (* block byte offsets [blkB, blkE) *)
  39. restoreOn : BOOLEAN ; (* current line snapshot exists *)
  40. restoreLine : CARDINAL ;
  41. restoreText : ARRAY [0..MaxCol + 2] OF CHAR ;
  42. restoreLen : CARDINAL ;
  43. lastFind : BOOLEAN ; (* a search was issued *)
  44. fnStr : ARRAY [0..31] OF CHAR ;
  45. rpStr : ARRAY [0..31] OF CHAR ;
  46. optB, optG, optU, optW, optN : BOOLEAN ;
  47. optN2 : CARDINAL ;
  48. lastIsReplace : BOOLEAN ;
  49. endEdit : BOOLEAN ; (* Ctrl-K-D pressed *)
  50. trash : LONGINT ; (* discarded syscall result *)
  51. PROCEDURE StrClear (VAR s : ARRAY OF CHAR) ;
  52. BEGIN
  53. s [0] := 0C
  54. END StrClear ;
  55. PROCEDURE PatLen (s : ARRAY OF CHAR) : CARDINAL ;
  56. VAR p : CARDINAL ;
  57. BEGIN
  58. p := 0 ;
  59. WHILE (p <= HIGH (s)) AND (s [p] # 0C) DO
  60. INC (p)
  61. END ;
  62. RETURN p
  63. END PatLen ;
  64. (* ------------------------------------------------------------------ *)
  65. (* buffer geometry (lines are CR-terminated) *)
  66. (* ------------------------------------------------------------------ *)
  67. PROCEDURE LineCount () : CARDINAL ;
  68. VAR n, i : CARDINAL ;
  69. BEGIN
  70. n := 1 ;
  71. i := 0 ;
  72. WHILE i < Length () DO
  73. IF CharAt (i) = C_M THEN
  74. INC (n)
  75. END ;
  76. INC (i)
  77. END ;
  78. RETURN n
  79. END LineCount ;
  80. PROCEDURE LineStart (l : CARDINAL) : CARDINAL ;
  81. VAR i, n : CARDINAL ;
  82. BEGIN
  83. i := 0 ;
  84. n := 0 ;
  85. WHILE (n < l) AND (i < Length ()) DO
  86. IF CharAt (i) = C_M THEN
  87. INC (n)
  88. END ;
  89. INC (i)
  90. END ;
  91. RETURN i
  92. END LineStart ;
  93. PROCEDURE LineEnd (l : CARDINAL) : CARDINAL ;
  94. (* byte offset of the CR terminating line l, or Length for the last *)
  95. VAR i : CARDINAL ;
  96. BEGIN
  97. i := LineStart (l) ;
  98. WHILE (i < Length ()) AND (CharAt (i) # C_M) DO
  99. INC (i)
  100. END ;
  101. RETURN i
  102. END LineEnd ;
  103. PROCEDURE LineLen (l : CARDINAL) : CARDINAL ;
  104. BEGIN
  105. RETURN LineEnd (l) - LineStart (l)
  106. END LineLen ;
  107. PROCEDURE LastLine () : CARDINAL ;
  108. VAR c : CARDINAL ;
  109. BEGIN
  110. c := LineCount () ;
  111. IF c = 0 THEN
  112. RETURN 0
  113. END ;
  114. RETURN c - 1
  115. END LastLine ;
  116. PROCEDURE OffToPos (off : CARDINAL ; VAR ln, cl : CARDINAL) ;
  117. VAR l, ls, le : CARDINAL ;
  118. BEGIN
  119. IF off > Length () THEN
  120. off := Length ()
  121. END ;
  122. l := 0 ;
  123. LOOP
  124. ls := LineStart (l) ;
  125. le := LineEnd (l) ;
  126. IF off <= le THEN
  127. ln := l ;
  128. cl := off - ls ;
  129. RETURN
  130. END ;
  131. INC (l)
  132. END
  133. END OffToPos ;
  134. PROCEDURE ClampCursor ;
  135. VAR last : CARDINAL ;
  136. BEGIN
  137. last := LastLine () ;
  138. IF curLine > last THEN
  139. curLine := last
  140. END ;
  141. IF curCol > LineLen (curLine) THEN
  142. curCol := LineLen (curLine)
  143. END
  144. END ClampCursor ;
  145. PROCEDURE CursorOff () : CARDINAL ;
  146. BEGIN
  147. RETURN LineStart (curLine) + curCol
  148. END CursorOff ;
  149. (* ------------------------------------------------------------------ *)
  150. (* block marker maintenance *)
  151. (* ------------------------------------------------------------------ *)
  152. PROCEDURE Inserted (at, n : CARDINAL) ;
  153. BEGIN
  154. IF NOT blkDef THEN RETURN END ;
  155. IF at <= blkB THEN blkB := blkB + n END ;
  156. IF at <= blkE THEN blkE := blkE + n END
  157. END Inserted ;
  158. PROCEDURE Deleted (at, n : CARDINAL) ;
  159. VAR end2 : CARDINAL ;
  160. BEGIN
  161. IF NOT blkDef THEN RETURN END ;
  162. end2 := at + n ;
  163. IF at < blkB THEN
  164. IF end2 < blkB THEN
  165. blkB := blkB - n
  166. ELSE
  167. blkB := at
  168. END
  169. END ;
  170. IF at < blkE THEN
  171. IF end2 < blkE THEN
  172. blkE := blkE - n
  173. ELSE
  174. blkE := at
  175. END
  176. END
  177. END Deleted ;
  178. PROCEDURE BufInsert (at : CARDINAL ; ch : CHAR) ;
  179. BEGIN
  180. InsertCh (at, ch) ;
  181. Inserted (at, 1)
  182. END BufInsert ;
  183. PROCEDURE BufDeleteN (at, n : CARDINAL) ;
  184. BEGIN
  185. Deleted (at, n) ;
  186. DeleteFromTo (at, n)
  187. END BufDeleteN ;
  188. (* ------------------------------------------------------------------ *)
  189. (* screen *)
  190. (* ------------------------------------------------------------------ *)
  191. PROCEDURE StatusLine ;
  192. BEGIN
  193. GotoXY (TopRow, 1) ;
  194. PutStr ("Line ") ;
  195. PutCard (curLine + 1) ;
  196. PutStr (" Col ") ;
  197. PutCard (curCol + 1) ;
  198. IF insertMode THEN
  199. PutStr (" Insert ")
  200. ELSE
  201. PutStr (" Overwrite ")
  202. END ;
  203. IF autoIndent THEN
  204. PutStr (" Indent ")
  205. ELSE
  206. PutStr (" ")
  207. END ;
  208. PutCh (drive) ;
  209. PutCh (":") ;
  210. PutStr (fname)
  211. END StatusLine ;
  212. PROCEDURE DrawRow (row, ln : CARDINAL) ;
  213. VAR start, i, x, off : CARDINAL ;
  214. shown : BOOLEAN ;
  215. BEGIN
  216. GotoXY (row, 1) ;
  217. start := LineStart (ln) ;
  218. shown := blkDef AND blkShown ;
  219. i := colOff ;
  220. x := 0 ;
  221. WHILE (i < LineLen (ln)) AND (x < Broad) DO
  222. off := start + i ;
  223. IF shown AND (off >= blkB) AND (off < blkE) THEN
  224. Marked
  225. ELSE
  226. Normal
  227. END ;
  228. PutCh (CharAt (off)) ;
  229. INC (i) ;
  230. INC (x)
  231. END ;
  232. Normal ;
  233. IF x < Broad THEN
  234. ScrnWide (Broad - x)
  235. END
  236. END DrawRow ;
  237. PROCEDURE DrawScreen ;
  238. VAR r : CARDINAL ;
  239. BEGIN
  240. StatusLine ;
  241. r := 0 ;
  242. WHILE (r < NBufRows) AND (topLine + r <= LastLine ()) DO
  243. DrawRow (FirstRow + r, topLine + r) ;
  244. INC (r)
  245. END ;
  246. WHILE r < NBufRows DO
  247. GotoXY (FirstRow + r, 1) ;
  248. ScrnWide (Broad) ;
  249. INC (r)
  250. END
  251. END DrawScreen ;
  252. PROCEDURE PositionCursor ;
  253. VAR row, col : CARDINAL ;
  254. BEGIN
  255. IF curLine < topLine THEN topLine := curLine END ;
  256. IF curLine >= topLine + NBufRows THEN
  257. topLine := curLine - NBufRows + 1
  258. END ;
  259. IF curCol < colOff THEN colOff := curCol END ;
  260. IF curCol >= colOff + Broad THEN colOff := curCol - Broad + 1 END ;
  261. row := FirstRow + (curLine - topLine) ;
  262. col := curCol - colOff + 1 ;
  263. GotoXY (row, col)
  264. END PositionCursor ;
  265. PROCEDURE MsgWait (msg : ARRAY OF CHAR) ;
  266. VAR ch : CHAR ;
  267. BEGIN
  268. GotoXY (TopRow, 1) ;
  269. ScrnWide (Broad) ;
  270. GotoXY (TopRow, 1) ;
  271. PutStr (msg) ;
  272. GetCh (ch) ;
  273. StatusLine
  274. END MsgWait ;
  275. (* ------------------------------------------------------------------ *)
  276. (* status line input *)
  277. (* ------------------------------------------------------------------ *)
  278. PROCEDURE ReadStatus (prompt : ARRAY OF CHAR ; prefix : BOOLEAN ;
  279. VAR s : ARRAY OF CHAR) : BOOLEAN ;
  280. VAR len : CARDINAL ;
  281. ch : CHAR ;
  282. BEGIN
  283. GotoXY (TopRow, 1) ;
  284. ScrnWide (Broad) ;
  285. GotoXY (TopRow, 1) ;
  286. PutStr (prompt) ;
  287. len := 0 ;
  288. LOOP
  289. GetCh (ch) ;
  290. IF (ch = C_M) OR (ch = C_J) THEN
  291. EXIT
  292. ELSIF (ch = C_U) OR (ch = Esc) THEN
  293. RETURN FALSE
  294. ELSIF (ch = C_H) OR (ch = Del) THEN
  295. IF len > 0 THEN
  296. DEC (len) ;
  297. PutCh (CHR (8)) ;
  298. PutCh (" ") ;
  299. PutCh (CHR (8))
  300. END
  301. ELSIF ch = C_P THEN
  302. IF prefix THEN
  303. GetCh (ch) ;
  304. IF (ch = Esc) OR (ch = C_U) THEN
  305. RETURN FALSE
  306. END ;
  307. IF len < HIGH (s) THEN
  308. s [len] := ch ;
  309. INC (len) ;
  310. PutCh (ch)
  311. END
  312. END
  313. ELSIF (ch >= " ") AND (ch <= "~") AND (len < HIGH (s)) THEN
  314. s [len] := ch ;
  315. INC (len) ;
  316. PutCh (ch)
  317. END
  318. END ;
  319. s [len] := 0C ;
  320. StatusLine ;
  321. RETURN TRUE
  322. END ReadStatus ;
  323. (* ------------------------------------------------------------------ *)
  324. (* word boundaries *)
  325. (* ------------------------------------------------------------------ *)
  326. PROCEDURE IsSep (ch : CHAR) : BOOLEAN ;
  327. BEGIN
  328. IF (ch = " ") OR (ch = C_M) OR (ch = C_J) THEN RETURN TRUE END ;
  329. IF (ch = "<") OR (ch = ">") OR (ch = ",") OR (ch = ";") OR
  330. (ch = ".") OR (ch = "(") OR (ch = ")") OR (ch = "[") OR
  331. (ch = "]") OR (ch = "*") OR (ch = "+") OR (ch = "-") OR
  332. (ch = "/") OR (ch = "$") OR (ch = "=") OR (ch = ":") OR
  333. (ch = "{") OR (ch = "}") OR (ch = "^") OR (ch = "#") OR
  334. (ch = "&") OR (ch = "'") THEN RETURN TRUE END ;
  335. RETURN FALSE
  336. END IsSep ;
  337. PROCEDURE NextWord (from : CARDINAL) : CARDINAL ;
  338. (* offset of the first non-separator at or after "from" *)
  339. VAR i : CARDINAL ;
  340. BEGIN
  341. i := from ;
  342. WHILE (i < Length ()) AND IsSep (CharAt (i)) DO INC (i) END ;
  343. RETURN i
  344. END NextWord ;
  345. PROCEDURE EndWord (from : CARDINAL) : CARDINAL ;
  346. (* offset past the last non-separator starting at "from" *)
  347. VAR i : CARDINAL ;
  348. BEGIN
  349. i := from ;
  350. WHILE (i < Length ()) AND NOT IsSep (CharAt (i)) DO INC (i) END ;
  351. RETURN i
  352. END EndWord ;
  353. PROCEDURE PrevWord (from : CARDINAL) : CARDINAL ;
  354. (* start of the word to the left of "from" *)
  355. VAR i : CARDINAL ;
  356. BEGIN
  357. i := from ;
  358. WHILE (i > 0) AND IsSep (CharAt (i - 1)) DO DEC (i) END ;
  359. WHILE (i > 0) AND NOT IsSep (CharAt (i - 1)) DO DEC (i) END ;
  360. RETURN i
  361. END PrevWord ;
  362. (* ------------------------------------------------------------------ *)
  363. (* cursor movement *)
  364. (* ------------------------------------------------------------------ *)
  365. PROCEDURE SavePos ;
  366. BEGIN
  367. haveLast := TRUE ;
  368. lastLine := curLine ;
  369. lastCol := curCol
  370. END SavePos ;
  371. PROCEDURE TakeSnapshot ;
  372. VAR i : CARDINAL ;
  373. BEGIN
  374. restoreOn := TRUE ;
  375. restoreLine := curLine ;
  376. restoreLen := LineLen (curLine) ;
  377. i := 0 ;
  378. WHILE i < restoreLen DO
  379. restoreText [i] := CharAt (LineStart (curLine) + i) ;
  380. INC (i)
  381. END
  382. END TakeSnapshot ;
  383. PROCEDURE ToPos (ln, cl : CARDINAL) ;
  384. BEGIN
  385. IF ln # curLine THEN TakeSnapshot END ;
  386. curLine := ln ;
  387. curCol := cl ;
  388. ClampCursor
  389. END ToPos ;
  390. PROCEDURE CharLeft ;
  391. BEGIN
  392. IF curCol > 0 THEN DEC (curCol) ELSE Beep END
  393. END CharLeft ;
  394. PROCEDURE CharRight ;
  395. BEGIN
  396. IF curCol < LineLen (curLine) THEN INC (curCol) ELSE Beep END
  397. END CharRight ;
  398. PROCEDURE WordLeft ;
  399. VAR off, ln, cl : CARDINAL ;
  400. BEGIN
  401. off := PrevWord (CursorOff ()) ;
  402. OffToPos (off, ln, cl) ;
  403. ToPos (ln, cl)
  404. END WordLeft ;
  405. PROCEDURE WordRight ;
  406. VAR off, ln, cl : CARDINAL ;
  407. BEGIN
  408. off := NextWord (CursorOff ()) ;
  409. OffToPos (off, ln, cl) ;
  410. ToPos (ln, cl)
  411. END WordRight ;
  412. PROCEDURE LineUp ;
  413. BEGIN
  414. IF curLine > 0 THEN ToPos (curLine - 1, curCol) ELSE Beep END
  415. END LineUp ;
  416. PROCEDURE LineDown ;
  417. BEGIN
  418. IF curLine < LastLine () THEN ToPos (curLine + 1, curCol) ELSE Beep END
  419. END LineDown ;
  420. PROCEDURE ScrollUp ;
  421. BEGIN
  422. IF topLine > 0 THEN
  423. DEC (topLine) ;
  424. IF curLine = topLine + NBufRows THEN DEC (curLine) END
  425. ELSE
  426. Beep
  427. END
  428. END ScrollUp ;
  429. PROCEDURE ScrollDown ;
  430. BEGIN
  431. IF topLine < LastLine () THEN
  432. INC (topLine) ;
  433. IF curLine < topLine THEN INC (curLine) END
  434. ELSE
  435. Beep
  436. END
  437. END ScrollDown ;
  438. PROCEDURE PageUp ;
  439. VAR target : CARDINAL ;
  440. BEGIN
  441. SavePos ;
  442. target := NBufRows - 1 ;
  443. IF curLine > target THEN
  444. ToPos (curLine - target, curCol)
  445. ELSE
  446. ToPos (0, curCol)
  447. END ;
  448. IF curLine < topLine THEN topLine := curLine END
  449. END PageUp ;
  450. PROCEDURE PageDown ;
  451. VAR target, last : CARDINAL ;
  452. BEGIN
  453. SavePos ;
  454. target := NBufRows - 1 ;
  455. last := LastLine () ;
  456. IF curLine + target <= last THEN
  457. ToPos (curLine + target, curCol)
  458. ELSE
  459. ToPos (last, curCol)
  460. END ;
  461. IF curLine >= topLine + NBufRows THEN
  462. topLine := curLine - NBufRows + 1
  463. END
  464. END PageDown ;
  465. PROCEDURE HomeLine ;
  466. BEGIN
  467. curCol := 0
  468. END HomeLine ;
  469. PROCEDURE EndLine ;
  470. BEGIN
  471. curCol := LineLen (curLine)
  472. END EndLine ;
  473. PROCEDURE HomeScreen ;
  474. BEGIN
  475. ToPos (topLine, 0)
  476. END HomeScreen ;
  477. PROCEDURE EndScreen ;
  478. BEGIN
  479. ToPos (topLine + NBufRows - 1, 0)
  480. END EndScreen ;
  481. PROCEDURE HomeFile ;
  482. BEGIN
  483. SavePos ;
  484. ToPos (0, 0) ;
  485. topLine := 0
  486. END HomeFile ;
  487. PROCEDURE EndFile ;
  488. BEGIN
  489. SavePos ;
  490. ToPos (LastLine (), LineLen (LastLine ())) ;
  491. IF curLine >= topLine + NBufRows THEN
  492. topLine := curLine - NBufRows + 1
  493. END
  494. END EndFile ;
  495. PROCEDURE ToBlockB ;
  496. VAR ln, cl : CARDINAL ;
  497. BEGIN
  498. IF blkDef THEN
  499. SavePos ;
  500. OffToPos (blkB, ln, cl) ;
  501. ToPos (ln, cl)
  502. END
  503. END ToBlockB ;
  504. PROCEDURE ToBlockE ;
  505. VAR ln, cl : CARDINAL ;
  506. BEGIN
  507. IF blkDef THEN
  508. SavePos ;
  509. OffToPos (blkE, ln, cl) ;
  510. ToPos (ln, cl)
  511. END
  512. END ToBlockE ;
  513. PROCEDURE ToLastPos ;
  514. BEGIN
  515. IF haveLast THEN ToPos (lastLine, lastCol) END
  516. END ToLastPos ;
  517. (* ------------------------------------------------------------------ *)
  518. (* editing *)
  519. (* ------------------------------------------------------------------ *)
  520. PROCEDURE NewLine ;
  521. VAR indentCol, i, at : CARDINAL ;
  522. BEGIN
  523. at := CursorOff () ;
  524. InsertCh (at, C_M) ;
  525. Inserted (at, 1) ;
  526. IF autoIndent THEN
  527. indentCol := 0 ;
  528. i := 0 ;
  529. WHILE (i < curCol) AND (CharAt (LineStart (curLine) + i) = " ") DO
  530. INC (i)
  531. END ;
  532. indentCol := i
  533. ELSE
  534. indentCol := 0
  535. END ;
  536. INC (curLine) ;
  537. curCol := indentCol ;
  538. IF indentCol > 0 THEN
  539. at := LineStart (curLine) ;
  540. i := 0 ;
  541. WHILE i < indentCol DO
  542. InsertCh (at + i, " ") ;
  543. Inserted (at + i, 1) ;
  544. INC (i)
  545. END
  546. END ;
  547. restoreOn := FALSE ;
  548. modified := TRUE
  549. END NewLine ;
  550. PROCEDURE InsertBreak ;
  551. VAR at, ln, cl : CARDINAL ;
  552. BEGIN
  553. at := CursorOff () ;
  554. InsertCh (at, C_M) ;
  555. Inserted (at, 1) ;
  556. OffToPos (at, ln, cl) ;
  557. ToPos (ln, cl) ;
  558. restoreOn := FALSE ;
  559. modified := TRUE
  560. END InsertBreak ;
  561. PROCEDURE TypeChar (ch : CHAR) ;
  562. VAR at : CARDINAL ;
  563. BEGIN
  564. IF insertMode THEN
  565. IF LineLen (curLine) >= MaxCol THEN
  566. MsgWait ("Line too long - CR inserted") ;
  567. NewLine ;
  568. at := CursorOff () ;
  569. InsertCh (at, ch) ;
  570. Inserted (at, 1) ;
  571. INC (curCol)
  572. ELSE
  573. at := CursorOff () ;
  574. InsertCh (at, ch) ;
  575. Inserted (at, 1) ;
  576. INC (curCol)
  577. END
  578. ELSE
  579. IF curCol < LineLen (curLine) THEN
  580. at := CursorOff () ;
  581. OverwriteCh (at, ch) ;
  582. INC (curCol)
  583. ELSE
  584. at := CursorOff () ;
  585. InsertCh (at, ch) ;
  586. Inserted (at, 1) ;
  587. INC (curCol)
  588. END
  589. END ;
  590. restoreOn := FALSE ;
  591. modified := TRUE
  592. END TypeChar ;
  593. PROCEDURE DeleteLeft ;
  594. VAR off : CARDINAL ;
  595. BEGIN
  596. IF CursorOff () = 0 THEN Beep ; RETURN END ;
  597. IF curCol > 0 THEN
  598. DEC (curCol) ;
  599. off := CursorOff () ;
  600. BufDeleteN (off, 1)
  601. ELSE
  602. off := CursorOff () - 1 ; (* the CR ending the previous line *)
  603. BufDeleteN (off, 1) ;
  604. DEC (curLine) ;
  605. curCol := LineLen (curLine)
  606. END ;
  607. restoreOn := FALSE ;
  608. modified := TRUE
  609. END DeleteLeft ;
  610. PROCEDURE DeleteChar ;
  611. VAR off : CARDINAL ;
  612. BEGIN
  613. IF curCol >= LineLen (curLine) THEN Beep ; RETURN END ;
  614. off := CursorOff () ;
  615. BufDeleteN (off, 1) ;
  616. restoreOn := FALSE ;
  617. modified := TRUE
  618. END DeleteChar ;
  619. PROCEDURE DeleteWord ;
  620. VAR from, ew : CARDINAL ;
  621. BEGIN
  622. from := CursorOff () ;
  623. ew := EndWord (from) ;
  624. IF ew = from THEN ew := NextWord (from) END ;
  625. IF ew > from THEN
  626. BufDeleteN (from, ew - from) ;
  627. restoreOn := FALSE ;
  628. modified := TRUE
  629. END
  630. END DeleteWord ;
  631. PROCEDURE DeleteLine ;
  632. VAR s, e, last : CARDINAL ;
  633. BEGIN
  634. s := LineStart (curLine) ;
  635. e := LineEnd (curLine) ;
  636. IF e < Length () THEN INC (e) END ; (* include the CR *)
  637. BufDeleteN (s, e - s) ;
  638. last := LastLine () ;
  639. IF curLine > last THEN curLine := last END ;
  640. curCol := 0 ;
  641. restoreOn := FALSE ;
  642. modified := TRUE
  643. END DeleteLine ;
  644. PROCEDURE DeleteToEOL ;
  645. VAR to, at : CARDINAL ;
  646. BEGIN
  647. at := CursorOff () ;
  648. to := LineEnd (curLine) ;
  649. IF to > at THEN
  650. BufDeleteN (at, to - at) ;
  651. restoreOn := FALSE ;
  652. modified := TRUE
  653. END
  654. END DeleteToEOL ;
  655. PROCEDURE RestoreLine ;
  656. VAR s, i : CARDINAL ;
  657. BEGIN
  658. IF NOT (restoreOn AND (restoreLine = curLine)) THEN Beep ; RETURN END ;
  659. s := LineStart (curLine) ;
  660. BufDeleteN (s, LineLen (curLine)) ;
  661. i := 0 ;
  662. WHILE i < restoreLen DO
  663. InsertCh (s + i, restoreText [i]) ;
  664. Inserted (s + i, 1) ;
  665. INC (i)
  666. END ;
  667. IF curCol > restoreLen THEN curCol := restoreLen END
  668. END RestoreLine ;
  669. PROCEDURE MarkBlockB ;
  670. BEGIN
  671. blkDef := TRUE ;
  672. blkShown := TRUE ;
  673. blkB := CursorOff () ;
  674. blkE := CursorOff ()
  675. END MarkBlockB ;
  676. PROCEDURE MarkBlockE ;
  677. BEGIN
  678. blkDef := TRUE ;
  679. blkShown := TRUE ;
  680. blkE := CursorOff () ;
  681. IF blkE < blkB THEN blkE := blkB END
  682. END MarkBlockE ;
  683. PROCEDURE MarkWord ;
  684. VAR b, e : CARDINAL ;
  685. BEGIN
  686. b := CursorOff () ;
  687. e := EndWord (b) ;
  688. IF e = b THEN
  689. b := PrevWord (b) ;
  690. e := EndWord (b)
  691. END ;
  692. blkDef := TRUE ;
  693. blkShown := TRUE ;
  694. blkB := b ;
  695. blkE := e
  696. END MarkWord ;
  697. PROCEDURE ToggleBlock ;
  698. BEGIN
  699. IF blkDef THEN blkShown := NOT blkShown END
  700. END ToggleBlock ;
  701. PROCEDURE CopyBlock (VAR dst : ARRAY OF CHAR) : CARDINAL ;
  702. VAR i : CARDINAL ;
  703. BEGIN
  704. i := 0 ;
  705. WHILE (blkB + i < blkE) AND (i < HIGH (dst)) DO
  706. dst [i] := CharAt (blkB + i) ;
  707. INC (i)
  708. END ;
  709. RETURN i
  710. END CopyBlock ;
  711. PROCEDURE CopyBlockCmd ;
  712. VAR buf : ARRAY [0..MaxCol * 4 + 8] OF CHAR ;
  713. n, at, i : CARDINAL ;
  714. BEGIN
  715. IF NOT blkDef THEN RETURN END ;
  716. n := CopyBlock (buf) ;
  717. IF n = 0 THEN RETURN END ;
  718. at := CursorOff () ;
  719. i := 0 ;
  720. WHILE i < n DO
  721. InsertCh (at + i, buf [i]) ;
  722. INC (i)
  723. END ;
  724. Inserted (at, n) ;
  725. blkB := at ;
  726. blkE := at + n ;
  727. restoreOn := FALSE ;
  728. modified := TRUE
  729. END CopyBlockCmd ;
  730. PROCEDURE MoveBlockCmd ;
  731. VAR buf : ARRAY [0..MaxCol * 4 + 8] OF CHAR ;
  732. n, at, del : CARDINAL ;
  733. i : CARDINAL ;
  734. BEGIN
  735. IF NOT blkDef THEN RETURN END ;
  736. n := CopyBlock (buf) ;
  737. IF n = 0 THEN RETURN END ;
  738. at := CursorOff () ;
  739. IF (at >= blkB) AND (at <= blkE) THEN RETURN END ;
  740. del := blkE - blkB ;
  741. BufDeleteN (blkB, del) ;
  742. IF at > blkB THEN at := at - del END ;
  743. blkDef := FALSE ;
  744. i := 0 ;
  745. WHILE i < n DO
  746. InsertCh (at + i, buf [i]) ;
  747. INC (i)
  748. END ;
  749. Inserted (at, n) ;
  750. blkDef := TRUE ;
  751. blkB := at ;
  752. blkE := at + n ;
  753. restoreOn := FALSE ;
  754. modified := TRUE
  755. END MoveBlockCmd ;
  756. PROCEDURE DeleteBlockCmd ;
  757. BEGIN
  758. IF blkDef AND (blkE > blkB) THEN
  759. BufDeleteN (blkB, blkE - blkB) ;
  760. blkDef := FALSE ;
  761. restoreOn := FALSE ;
  762. modified := TRUE
  763. END
  764. END DeleteBlockCmd ;
  765. (* ------------------------------------------------------------------ *)
  766. (* find / replace *)
  767. (* ------------------------------------------------------------------ *)
  768. PROCEDURE MatchAt (at : CARDINAL ; pa : ARRAY OF CHAR ;
  769. ignoreCase : BOOLEAN) : BOOLEAN ;
  770. VAR b, q, len2 : CARDINAL ;
  771. c1, c2 : CHAR ;
  772. f, l : CARDINAL ;
  773. BEGIN
  774. len2 := PatLen (pa) ;
  775. IF len2 = 0 THEN RETURN FALSE END ;
  776. q := 0 ;
  777. b := at ;
  778. WHILE q < len2 DO
  779. IF (pa [q] = C_M) AND (q + 1 < len2) AND (pa [q + 1] = C_J) THEN
  780. (* pattern CR LF matches a single CR in the buffer *)
  781. IF b >= Length () THEN RETURN FALSE END ;
  782. IF CharAt (b) # C_M THEN RETURN FALSE END ;
  783. INC (b) ;
  784. INC (q, 2)
  785. ELSIF pa [q] = C_A THEN
  786. (* Ctrl-A wildcard: any character *)
  787. IF b >= Length () THEN RETURN FALSE END ;
  788. INC (b) ;
  789. INC (q)
  790. ELSE
  791. IF b >= Length () THEN RETURN FALSE END ;
  792. c1 := CharAt (b) ;
  793. c2 := pa [q] ;
  794. IF ignoreCase THEN
  795. f := ORD (c1) ;
  796. l := ORD (c2) ;
  797. IF (f >= ORD ("a")) AND (f <= ORD ("z")) THEN f := f - 32 END ;
  798. IF (l >= ORD ("a")) AND (l <= ORD ("z")) THEN l := l - 32 END ;
  799. IF f # l THEN RETURN FALSE END
  800. ELSIF c1 # c2 THEN
  801. RETURN FALSE
  802. END ;
  803. INC (b) ;
  804. INC (q)
  805. END
  806. END ;
  807. RETURN TRUE
  808. END MatchAt ;
  809. PROCEDURE WordBounded (at : CARDINAL) : BOOLEAN ;
  810. VAR len2 : CARDINAL ;
  811. c : CHAR ;
  812. BEGIN
  813. len2 := PatLen (fnStr) ;
  814. IF at = 0 THEN
  815. (* ok at start of buffer *)
  816. ELSE
  817. c := CharAt (at - 1) ;
  818. IF NOT IsSep (c) THEN RETURN FALSE END
  819. END ;
  820. IF at + len2 >= Length () THEN
  821. (* ok at end of buffer *)
  822. ELSE
  823. c := CharAt (at + len2) ;
  824. IF NOT IsSep (c) THEN RETURN FALSE END
  825. END ;
  826. RETURN TRUE
  827. END WordBounded ;
  828. PROCEDURE FindFwd (from : CARDINAL) : CARDINAL ;
  829. VAR i, len2 : CARDINAL ;
  830. found : BOOLEAN ;
  831. BEGIN
  832. len2 := PatLen (fnStr) ;
  833. IF len2 = 0 THEN RETURN NoMark END ;
  834. found := FALSE ;
  835. i := from ;
  836. WHILE (i + len2 <= Length ()) AND NOT found DO
  837. IF MatchAt (i, fnStr, optU) AND
  838. ((NOT optW) OR WordBounded (i)) THEN
  839. found := TRUE
  840. ELSE
  841. INC (i)
  842. END
  843. END ;
  844. IF found THEN RETURN i END ;
  845. RETURN NoMark
  846. END FindFwd ;
  847. PROCEDURE FindBwd (from : CARDINAL) : CARDINAL ;
  848. VAR i, len2 : CARDINAL ;
  849. found : CARDINAL ;
  850. BEGIN
  851. len2 := PatLen (fnStr) ;
  852. IF len2 = 0 THEN RETURN NoMark END ;
  853. IF from > Length () THEN from := Length () END ;
  854. found := NoMark ;
  855. i := 0 ;
  856. WHILE i + len2 <= from DO
  857. IF MatchAt (i, fnStr, optU) AND
  858. ((NOT optW) OR WordBounded (i)) THEN
  859. found := i
  860. END ;
  861. INC (i)
  862. END ;
  863. RETURN found
  864. END FindBwd ;
  865. PROCEDURE PutCursorAfter (m : CARDINAL) ;
  866. VAR len2, ln, cl : CARDINAL ;
  867. BEGIN
  868. len2 := PatLen (fnStr) ;
  869. OffToPos (m + len2, ln, cl) ;
  870. ToPos (ln, cl)
  871. END PutCursorAfter ;
  872. PROCEDURE DoSeek (global : BOOLEAN) : BOOLEAN ;
  873. VAR from, m : CARDINAL ;
  874. BEGIN
  875. IF PatLen (fnStr) = 0 THEN RETURN FALSE END ;
  876. IF global THEN
  877. IF optB THEN from := Length () ELSE from := 0 END
  878. ELSIF optB THEN
  879. from := CursorOff ()
  880. ELSE
  881. from := CursorOff () + 1 ;
  882. IF from > Length () THEN from := Length () END
  883. END ;
  884. IF optB THEN m := FindBwd (from) ELSE m := FindFwd (from) END ;
  885. IF m = NoMark THEN
  886. MsgWait ("Target not found") ;
  887. RETURN FALSE
  888. END ;
  889. PutCursorAfter (m) ;
  890. RETURN TRUE
  891. END DoSeek ;
  892. PROCEDURE ReplAt (m : CARDINAL) : CARDINAL ;
  893. VAR len2, rl, i, q : CARDINAL ;
  894. buf : ARRAY [0..64] OF CHAR ;
  895. BEGIN
  896. len2 := PatLen (fnStr) ;
  897. rl := PatLen (rpStr) ;
  898. i := 0 ;
  899. WHILE i < rl DO
  900. buf [i] := rpStr [i] ;
  901. INC (i)
  902. END ;
  903. BufDeleteN (m, len2) ;
  904. q := 0 ;
  905. i := 0 ;
  906. WHILE i < rl DO
  907. IF (buf [i] = C_M) AND (i + 1 < rl) AND (buf [i + 1] = C_J) THEN
  908. InsertCh (m + q, C_M) ;
  909. Inserted (m + q, 1) ;
  910. INC (q) ;
  911. INC (i, 2)
  912. ELSE
  913. InsertCh (m + q, buf [i]) ;
  914. Inserted (m + q, 1) ;
  915. INC (q) ;
  916. INC (i)
  917. END
  918. END ;
  919. modified := TRUE ;
  920. RETURN m + q
  921. END ReplAt ;
  922. PROCEDURE ParseOptions (s : ARRAY OF CHAR) ;
  923. VAR i, d, num : CARDINAL ;
  924. ch : CHAR ;
  925. BEGIN
  926. optB := FALSE ; optG := FALSE ; optU := FALSE ; optW := FALSE ;
  927. optN := FALSE ; optN2 := 0 ;
  928. i := 0 ;
  929. WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
  930. ch := s [i] ;
  931. IF (ch = "B") OR (ch = "b") THEN
  932. optB := TRUE
  933. ELSIF (ch = "G") OR (ch = "g") THEN
  934. optG := TRUE
  935. ELSIF (ch = "U") OR (ch = "u") THEN
  936. optU := TRUE
  937. ELSIF (ch = "W") OR (ch = "w") THEN
  938. optW := TRUE
  939. ELSIF (ch = "N") OR (ch = "n") THEN
  940. optN := TRUE
  941. ELSIF (ch >= "0") AND (ch <= "9") THEN
  942. num := 0 ;
  943. WHILE (i <= HIGH (s)) AND (s [i] >= "0") AND (s [i] <= "9") DO
  944. d := ORD (s [i]) - ORD ("0") ;
  945. num := num * 10 + d ;
  946. INC (i)
  947. END ;
  948. IF num > 0 THEN optN2 := num END ;
  949. DEC (i)
  950. END ;
  951. INC (i)
  952. END
  953. END ParseOptions ;
  954. PROCEDURE DoFind ;
  955. VAR s : ARRAY [0..255] OF CHAR ;
  956. i, n : CARDINAL ;
  957. BEGIN
  958. IF NOT ReadStatus ("Find: ", TRUE, s) THEN StatusLine ; RETURN END ;
  959. StrClear (fnStr) ;
  960. i := 0 ;
  961. LOOP
  962. IF (i <= HIGH (s)) AND (i <= 30) AND (s [i] # 0C) THEN
  963. fnStr [i] := s [i] ;
  964. INC (i)
  965. ELSE
  966. EXIT
  967. END
  968. END ;
  969. IF NOT ReadStatus ("Options: ", FALSE, s) THEN StatusLine ; RETURN END ;
  970. ParseOptions (s) ;
  971. lastFind := TRUE ;
  972. lastIsReplace := FALSE ;
  973. IF DoSeek (optG) THEN
  974. n := optN2 ;
  975. WHILE n > 1 DO
  976. IF NOT DoSeek (FALSE) THEN n := 1 END ;
  977. DEC (n)
  978. END
  979. END ;
  980. StatusLine
  981. END DoFind ;
  982. PROCEDURE DoReplace ;
  983. VAR s : ARRAY [0..255] OF CHAR ;
  984. i, from, m, after, len2, cnt : CARDINAL ;
  985. cont, ask, yes : BOOLEAN ;
  986. ch : CHAR ;
  987. BEGIN
  988. IF NOT ReadStatus ("Find: ", TRUE, s) THEN StatusLine ; RETURN END ;
  989. StrClear (fnStr) ;
  990. i := 0 ;
  991. LOOP
  992. IF (i <= HIGH (s)) AND (i <= 30) AND (s [i] # 0C) THEN
  993. fnStr [i] := s [i] ;
  994. INC (i)
  995. ELSE
  996. EXIT
  997. END
  998. END ;
  999. IF NOT ReadStatus ("Replace with: ", TRUE, s) THEN StatusLine ; RETURN END ;
  1000. StrClear (rpStr) ;
  1001. i := 0 ;
  1002. LOOP
  1003. IF (i <= HIGH (s)) AND (i <= 30) AND (s [i] # 0C) THEN
  1004. rpStr [i] := s [i] ;
  1005. INC (i)
  1006. ELSE
  1007. EXIT
  1008. END
  1009. END ;
  1010. IF NOT ReadStatus ("Options: ", FALSE, s) THEN StatusLine ; RETURN END ;
  1011. ParseOptions (s) ;
  1012. lastFind := TRUE ;
  1013. lastIsReplace := TRUE ;
  1014. IF optG THEN
  1015. IF optB THEN from := Length () ELSE from := 0 END
  1016. ELSIF optB THEN
  1017. from := CursorOff ()
  1018. ELSE
  1019. from := CursorOff () + 1 ;
  1020. IF from > Length () THEN from := Length () END
  1021. END ;
  1022. len2 := PatLen (fnStr) ;
  1023. IF len2 = 0 THEN RETURN END ;
  1024. cont := TRUE ;
  1025. cnt := 0 ;
  1026. LOOP
  1027. IF NOT cont THEN EXIT END ;
  1028. IF optB THEN m := FindBwd (from) ELSE m := FindFwd (from) END ;
  1029. IF m = NoMark THEN EXIT END ;
  1030. ask := NOT optN ;
  1031. yes := optN ;
  1032. IF ask THEN
  1033. GotoXY (TopRow, 1) ;
  1034. ScrnWide (Broad) ;
  1035. GotoXY (TopRow, 1) ;
  1036. PutStr ("Replace (Y/N)?") ;
  1037. GetCh (ch) ;
  1038. StatusLine ;
  1039. IF ch = C_U THEN EXIT END ;
  1040. yes := (ch = "Y") OR (ch = "y")
  1041. END ;
  1042. IF yes THEN
  1043. INC (cnt) ;
  1044. after := ReplAt (m) ;
  1045. IF optB THEN
  1046. from := m ;
  1047. IF m = 0 THEN cont := FALSE END
  1048. ELSE
  1049. from := after
  1050. END
  1051. ELSE
  1052. IF optB THEN
  1053. from := m ;
  1054. IF m = 0 THEN cont := FALSE END
  1055. ELSE
  1056. from := m + len2
  1057. END
  1058. END ;
  1059. IF (optN2 > 0) AND (cnt >= optN2) THEN cont := FALSE END
  1060. END ;
  1061. StatusLine
  1062. END DoReplace ;
  1063. PROCEDURE RepeatLast ;
  1064. BEGIN
  1065. IF NOT lastFind THEN RETURN END ;
  1066. IF lastIsReplace THEN DoReplace ELSE DoFind END
  1067. END RepeatLast ;
  1068. (* ------------------------------------------------------------------ *)
  1069. (* block file I/O *)
  1070. (* ------------------------------------------------------------------ *)
  1071. PROCEDURE HasDot (s : ARRAY OF CHAR) : BOOLEAN ;
  1072. VAR i : CARDINAL ;
  1073. BEGIN
  1074. i := 0 ;
  1075. WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
  1076. IF s [i] = "." THEN RETURN TRUE END ;
  1077. INC (i)
  1078. END ;
  1079. RETURN FALSE
  1080. END HasDot ;
  1081. PROCEDURE ToFileName (VAR s : ARRAY OF CHAR) ;
  1082. VAR len2 : CARDINAL ;
  1083. BEGIN
  1084. len2 := PatLen (s) ;
  1085. IF len2 = 0 THEN RETURN END ;
  1086. IF s [len2 - 1] = "." THEN
  1087. s [len2 - 1] := 0C ;
  1088. RETURN
  1089. END ;
  1090. IF NOT HasDot (s) THEN
  1091. IF len2 + 4 <= HIGH (s) THEN
  1092. s [len2] := "." ;
  1093. s [len2 + 1] := "P" ;
  1094. s [len2 + 2] := "A" ;
  1095. s [len2 + 3] := "S" ;
  1096. s [len2 + 4] := 0C
  1097. END
  1098. END
  1099. END ToFileName ;
  1100. PROCEDURE FileExists (s : ARRAY OF CHAR) : BOOLEAN ;
  1101. VAR fd : INTEGER ;
  1102. BEGIN
  1103. fd := open (ADR (s), 0, 0) ;
  1104. IF fd < 0 THEN RETURN FALSE END ;
  1105. trash := close (fd) ;
  1106. RETURN TRUE
  1107. END FileExists ;
  1108. PROCEDURE ReadFileAt (s : ARRAY OF CHAR ; at : CARDINAL) : BOOLEAN ;
  1109. VAR fd : INTEGER ;
  1110. buf : ARRAY [0..1023] OF BYTE ;
  1111. got, i : LONGINT ;
  1112. n : CARDINAL ;
  1113. pos : CARDINAL ;
  1114. b : BYTE ;
  1115. prevCR, huge, eof : BOOLEAN ;
  1116. BEGIN
  1117. fd := open (ADR (s), 0, 0) ;
  1118. IF fd < 0 THEN
  1119. MsgWait ("File not found") ;
  1120. RETURN FALSE
  1121. END ;
  1122. huge := FALSE ;
  1123. pos := at ;
  1124. prevCR := FALSE ;
  1125. eof := FALSE ;
  1126. LOOP
  1127. IF eof THEN EXIT END ;
  1128. got := read (fd, ADR (buf), 1024) ;
  1129. IF got <= 0 THEN EXIT END ;
  1130. n := VAL (CARDINAL, got) ;
  1131. i := 0 ;
  1132. WHILE i < VAL (LONGINT, n) DO
  1133. b := buf [i] ;
  1134. IF b = CHR (26) THEN
  1135. eof := TRUE ;
  1136. i := VAL (LONGINT, n)
  1137. ELSE
  1138. IF Length () >= TextLimit THEN
  1139. huge := TRUE
  1140. ELSE
  1141. IF b = CHR (10) THEN
  1142. IF NOT prevCR THEN
  1143. InsertCh (pos, C_M) ;
  1144. Inserted (pos, 1) ;
  1145. INC (pos)
  1146. END ;
  1147. prevCR := FALSE
  1148. ELSIF b = CHR (13) THEN
  1149. InsertCh (pos, C_M) ;
  1150. Inserted (pos, 1) ;
  1151. INC (pos) ;
  1152. prevCR := TRUE
  1153. ELSE
  1154. InsertCh (pos, CHR (b)) ;
  1155. Inserted (pos, 1) ;
  1156. INC (pos) ;
  1157. prevCR := FALSE
  1158. END
  1159. END ;
  1160. INC (i)
  1161. END
  1162. END
  1163. END ;
  1164. trash := close (fd) ;
  1165. IF huge THEN MsgWait ("WARNING: Out of space") END ;
  1166. RETURN TRUE
  1167. END ReadFileAt ;
  1168. PROCEDURE WriteBlockTo (s : ARRAY OF CHAR) ;
  1169. VAR fd : INTEGER ;
  1170. i : CARDINAL ;
  1171. b : BYTE ;
  1172. ch : CHAR ;
  1173. BEGIN
  1174. IF NOT (blkDef AND (blkE > blkB)) THEN RETURN END ;
  1175. IF FileExists (s) THEN
  1176. GotoXY (TopRow, 1) ;
  1177. ScrnWide (Broad) ;
  1178. GotoXY (TopRow, 1) ;
  1179. PutStr ("Overwrite old ") ;
  1180. PutStr (s) ;
  1181. PutStr (" (Y/N)?") ;
  1182. GetCh (ch) ;
  1183. StatusLine ;
  1184. IF NOT ((ch = "Y") OR (ch = "y")) THEN RETURN END
  1185. END ;
  1186. fd := open (ADR (s), 1 + 512 + 64, 420) ;
  1187. IF fd < 0 THEN
  1188. MsgWait ("Unable to create ") ;
  1189. RETURN
  1190. END ;
  1191. i := blkB ;
  1192. WHILE i < blkE DO
  1193. IF CharAt (i) = C_M THEN
  1194. b := CHR (13) ;
  1195. trash := write (fd, ADR (b), 1) ;
  1196. b := CHR (10) ;
  1197. trash := write (fd, ADR (b), 1)
  1198. ELSE
  1199. b := VAL (BYTE, ORD (CharAt (i))) ;
  1200. trash := write (fd, ADR (b), 1)
  1201. END ;
  1202. INC (i)
  1203. END ;
  1204. trash := close (fd)
  1205. END WriteBlockTo ;
  1206. PROCEDURE ReadBlockToCursor ;
  1207. VAR s : ARRAY [0..255] OF CHAR ;
  1208. at, startLen : CARDINAL ;
  1209. BEGIN
  1210. IF NOT ReadStatus ("Read block from file ", FALSE, s) THEN
  1211. StatusLine ;
  1212. RETURN
  1213. END ;
  1214. ToFileName (s) ;
  1215. startLen := Length () ;
  1216. at := CursorOff () ;
  1217. IF ReadFileAt (s, at) THEN
  1218. blkDef := TRUE ;
  1219. blkShown := TRUE ;
  1220. blkB := at ;
  1221. blkE := at + (Length () - startLen) ;
  1222. modified := TRUE
  1223. END ;
  1224. StatusLine
  1225. END ReadBlockToCursor ;
  1226. PROCEDURE WriteBlockCmd ;
  1227. VAR s : ARRAY [0..255] OF CHAR ;
  1228. BEGIN
  1229. IF NOT (blkDef AND (blkE > blkB)) THEN RETURN END ;
  1230. IF NOT ReadStatus ("Write block to file ", FALSE, s) THEN
  1231. StatusLine ;
  1232. RETURN
  1233. END ;
  1234. ToFileName (s) ;
  1235. WriteBlockTo (s) ;
  1236. StatusLine
  1237. END WriteBlockCmd ;
  1238. (* ------------------------------------------------------------------ *)
  1239. (* key handling *)
  1240. (* ------------------------------------------------------------------ *)
  1241. PROCEDURE AutoTab ;
  1242. VAR ln, i, nextCol : CARDINAL ;
  1243. started : BOOLEAN ;
  1244. BEGIN
  1245. IF curLine = 0 THEN Beep ; RETURN END ;
  1246. ln := curLine - 1 ;
  1247. started := FALSE ;
  1248. nextCol := 0 ;
  1249. i := curCol ;
  1250. LOOP
  1251. IF i >= LineLen (ln) THEN EXIT END ;
  1252. IF NOT IsSep (CharAt (LineStart (ln) + i)) THEN
  1253. nextCol := i ;
  1254. started := TRUE ;
  1255. EXIT
  1256. END ;
  1257. INC (i)
  1258. END ;
  1259. IF NOT started THEN Beep ; RETURN END ;
  1260. curCol := nextCol ;
  1261. IF curCol > LineLen (curLine) THEN curCol := LineLen (curLine) END
  1262. END AutoTab ;
  1263. PROCEDURE HandleEsc ;
  1264. VAR k : CHAR ;
  1265. BEGIN
  1266. GetKey (k) ;
  1267. IF k = "[" THEN
  1268. GetCh (k) ;
  1269. IF k = "A" THEN
  1270. LineUp
  1271. ELSIF k = "B" THEN
  1272. LineDown
  1273. ELSIF k = "C" THEN
  1274. CharRight
  1275. ELSIF k = "D" THEN
  1276. CharLeft
  1277. ELSIF k = "H" THEN
  1278. HomeLine
  1279. ELSIF k = "F" THEN
  1280. EndLine
  1281. ELSIF k = "3" THEN
  1282. GetCh (k) ;
  1283. DeleteChar
  1284. ELSIF k = "5" THEN
  1285. GetCh (k) ;
  1286. PageUp
  1287. ELSIF k = "6" THEN
  1288. GetCh (k) ;
  1289. PageDown
  1290. ELSIF k = "Z" THEN
  1291. AutoTab
  1292. END
  1293. END
  1294. END HandleEsc ;
  1295. PROCEDURE Up (ch : CHAR) : CHAR ;
  1296. BEGIN
  1297. IF (ch >= "a") AND (ch <= "z") THEN
  1298. RETURN CHR (ORD (ch) - 32)
  1299. END ;
  1300. RETURN ch
  1301. END Up ;
  1302. PROCEDURE KCommand ;
  1303. VAR ch : CHAR ;
  1304. BEGIN
  1305. GetCh (ch) ;
  1306. IF ch = Esc THEN RETURN END ;
  1307. ch := Up (ch) ;
  1308. IF ch = "B" THEN
  1309. MarkBlockB
  1310. ELSIF ch = "K" THEN
  1311. MarkBlockE
  1312. ELSIF ch = "T" THEN
  1313. MarkWord
  1314. ELSIF ch = "H" THEN
  1315. ToggleBlock
  1316. ELSIF ch = "C" THEN
  1317. CopyBlockCmd
  1318. ELSIF ch = "V" THEN
  1319. MoveBlockCmd
  1320. ELSIF ch = "Y" THEN
  1321. DeleteBlockCmd
  1322. ELSIF ch = "R" THEN
  1323. ReadBlockToCursor
  1324. ELSIF ch = "W" THEN
  1325. WriteBlockCmd
  1326. ELSIF ch = "D" THEN
  1327. endEdit := TRUE
  1328. ELSE
  1329. Beep
  1330. END
  1331. END KCommand ;
  1332. PROCEDURE QCommand ;
  1333. VAR ch : CHAR ;
  1334. BEGIN
  1335. GetCh (ch) ;
  1336. IF ch = Esc THEN RETURN END ;
  1337. ch := Up (ch) ;
  1338. IF ch = "S" THEN
  1339. HomeLine
  1340. ELSIF ch = "D" THEN
  1341. EndLine
  1342. ELSIF ch = "E" THEN
  1343. HomeScreen
  1344. ELSIF ch = "X" THEN
  1345. EndScreen
  1346. ELSIF ch = "R" THEN
  1347. HomeFile
  1348. ELSIF ch = "C" THEN
  1349. EndFile
  1350. ELSIF ch = "B" THEN
  1351. ToBlockB
  1352. ELSIF ch = "K" THEN
  1353. ToBlockE
  1354. ELSIF ch = "P" THEN
  1355. ToLastPos
  1356. ELSIF ch = "Y" THEN
  1357. DeleteToEOL
  1358. ELSIF ch = "L" THEN
  1359. RestoreLine
  1360. ELSIF ch = "I" THEN
  1361. autoIndent := NOT autoIndent
  1362. ELSIF ch = "F" THEN
  1363. DoFind
  1364. ELSIF ch = "A" THEN
  1365. DoReplace
  1366. ELSE
  1367. Beep
  1368. END
  1369. END QCommand ;
  1370. PROCEDURE MainLoop ;
  1371. VAR ch : CHAR ;
  1372. BEGIN
  1373. endEdit := FALSE ;
  1374. LOOP
  1375. DrawScreen ;
  1376. PositionCursor ;
  1377. GetCh (ch) ;
  1378. IF ch = Esc THEN
  1379. HandleEsc
  1380. ELSIF ch = C_Q THEN
  1381. QCommand
  1382. ELSIF ch = C_K THEN
  1383. KCommand
  1384. ELSIF ch = C_P THEN
  1385. GetCh (ch) ;
  1386. IF NOT ((ch = Esc) OR (ch = C_U)) THEN
  1387. BufInsert (CursorOff (), ch) ;
  1388. INC (curCol) ;
  1389. restoreOn := FALSE ;
  1390. modified := TRUE
  1391. END
  1392. ELSIF ch = C_A THEN
  1393. WordLeft
  1394. ELSIF ch = C_S THEN
  1395. CharLeft
  1396. ELSIF ch = C_D THEN
  1397. CharRight
  1398. ELSIF ch = C_F THEN
  1399. WordRight
  1400. ELSIF ch = C_E THEN
  1401. LineUp
  1402. ELSIF ch = C_X THEN
  1403. LineDown
  1404. ELSIF ch = C_W THEN
  1405. ScrollUp
  1406. ELSIF ch = C_Z THEN
  1407. ScrollDown
  1408. ELSIF ch = C_R THEN
  1409. PageUp
  1410. ELSIF ch = C_C THEN
  1411. PageDown
  1412. ELSIF ch = C_V THEN
  1413. insertMode := NOT insertMode
  1414. ELSIF ch = C_G THEN
  1415. DeleteChar
  1416. ELSIF ch = Del THEN
  1417. DeleteLeft
  1418. ELSIF ch = C_H THEN
  1419. DeleteLeft
  1420. ELSIF ch = C_T THEN
  1421. DeleteWord
  1422. ELSIF ch = C_N THEN
  1423. InsertBreak
  1424. ELSIF ch = C_Y THEN
  1425. DeleteLine
  1426. ELSIF ch = C_L THEN
  1427. RepeatLast
  1428. ELSIF ch = C_U THEN
  1429. Beep
  1430. ELSIF ch = C_I THEN
  1431. AutoTab
  1432. ELSIF (ch = C_M) OR (ch = C_J) THEN
  1433. NewLine
  1434. ELSIF (ch >= " ") AND (ch <= "~") THEN
  1435. TypeChar (ch)
  1436. END ;
  1437. IF endEdit THEN EXIT END
  1438. END
  1439. END MainLoop ;
  1440. (* ------------------------------------------------------------------ *)
  1441. PROCEDURE Run (drv : CHAR ; VAR fileName : ARRAY OF CHAR ;
  1442. VAR changed : BOOLEAN) ;
  1443. VAR i : CARDINAL ;
  1444. BEGIN
  1445. drive := drv ;
  1446. i := 0 ;
  1447. LOOP
  1448. fname [i] := fileName [i] ;
  1449. IF (i >= HIGH (fname)) OR (i >= HIGH (fileName))
  1450. OR (fileName [i] = 0C) THEN EXIT END ;
  1451. INC (i)
  1452. END ;
  1453. curLine := 0 ;
  1454. curCol := 0 ;
  1455. topLine := 0 ;
  1456. colOff := 0 ;
  1457. insertMode := TRUE ;
  1458. autoIndent := TRUE ;
  1459. haveLast := FALSE ;
  1460. blkDef := FALSE ;
  1461. blkShown := FALSE ;
  1462. restoreOn := FALSE ;
  1463. lastFind := FALSE ;
  1464. modified := FALSE ;
  1465. MainLoop ;
  1466. changed := modified
  1467. END Run ;
  1468. END Editor.