Editor.mod 37 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591
  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 = C_D THEN
  1309. ch := "D" (* tolerate the held-Ctrl chord Ctrl-K-Ctrl-D *)
  1310. ELSIF ch = C_X THEN
  1311. ch := "X" (* tolerate Ctrl-K-Ctrl-X as well *)
  1312. END ;
  1313. IF ch = "B" THEN
  1314. MarkBlockB
  1315. ELSIF ch = "K" THEN
  1316. MarkBlockE
  1317. ELSIF ch = "T" THEN
  1318. MarkWord
  1319. ELSIF ch = "H" THEN
  1320. ToggleBlock
  1321. ELSIF ch = "C" THEN
  1322. CopyBlockCmd
  1323. ELSIF ch = "V" THEN
  1324. MoveBlockCmd
  1325. ELSIF ch = "Y" THEN
  1326. DeleteBlockCmd
  1327. ELSIF ch = "R" THEN
  1328. ReadBlockToCursor
  1329. ELSIF ch = "W" THEN
  1330. WriteBlockCmd
  1331. ELSIF ch = "D" THEN
  1332. endEdit := TRUE
  1333. ELSE
  1334. Beep
  1335. END
  1336. END KCommand ;
  1337. PROCEDURE QCommand ;
  1338. VAR ch : CHAR ;
  1339. BEGIN
  1340. GetCh (ch) ;
  1341. IF ch = Esc THEN RETURN END ;
  1342. ch := Up (ch) ;
  1343. IF ch = "S" THEN
  1344. HomeLine
  1345. ELSIF ch = "D" THEN
  1346. EndLine
  1347. ELSIF ch = "E" THEN
  1348. HomeScreen
  1349. ELSIF ch = "X" THEN
  1350. EndScreen
  1351. ELSIF ch = "R" THEN
  1352. HomeFile
  1353. ELSIF ch = "C" THEN
  1354. EndFile
  1355. ELSIF ch = "B" THEN
  1356. ToBlockB
  1357. ELSIF ch = "K" THEN
  1358. ToBlockE
  1359. ELSIF ch = "P" THEN
  1360. ToLastPos
  1361. ELSIF ch = "Y" THEN
  1362. DeleteToEOL
  1363. ELSIF ch = "L" THEN
  1364. RestoreLine
  1365. ELSIF ch = "I" THEN
  1366. autoIndent := NOT autoIndent
  1367. ELSIF ch = "F" THEN
  1368. DoFind
  1369. ELSIF ch = "A" THEN
  1370. DoReplace
  1371. ELSE
  1372. Beep
  1373. END
  1374. END QCommand ;
  1375. PROCEDURE MainLoop ;
  1376. VAR ch : CHAR ;
  1377. BEGIN
  1378. endEdit := FALSE ;
  1379. LOOP
  1380. DrawScreen ;
  1381. PositionCursor ;
  1382. GetCh (ch) ;
  1383. IF ch = Esc THEN
  1384. HandleEsc
  1385. ELSIF ch = C_Q THEN
  1386. QCommand
  1387. ELSIF ch = C_K THEN
  1388. KCommand
  1389. ELSIF ch = C_P THEN
  1390. GetCh (ch) ;
  1391. IF NOT ((ch = Esc) OR (ch = C_U)) THEN
  1392. BufInsert (CursorOff (), ch) ;
  1393. INC (curCol) ;
  1394. restoreOn := FALSE ;
  1395. modified := TRUE
  1396. END
  1397. ELSIF ch = C_A THEN
  1398. WordLeft
  1399. ELSIF ch = C_S THEN
  1400. CharLeft
  1401. ELSIF ch = C_D THEN
  1402. CharRight
  1403. ELSIF ch = C_F THEN
  1404. WordRight
  1405. ELSIF ch = C_E THEN
  1406. LineUp
  1407. ELSIF ch = C_X THEN
  1408. LineDown
  1409. ELSIF ch = C_W THEN
  1410. ScrollUp
  1411. ELSIF ch = C_Z THEN
  1412. ScrollDown
  1413. ELSIF ch = C_R THEN
  1414. PageUp
  1415. ELSIF ch = C_C THEN
  1416. PageDown
  1417. ELSIF ch = C_V THEN
  1418. insertMode := NOT insertMode
  1419. ELSIF ch = C_G THEN
  1420. DeleteChar
  1421. ELSIF ch = Del THEN
  1422. DeleteLeft
  1423. ELSIF ch = C_H THEN
  1424. DeleteLeft
  1425. ELSIF ch = C_T THEN
  1426. DeleteWord
  1427. ELSIF ch = C_N THEN
  1428. InsertBreak
  1429. ELSIF ch = C_Y THEN
  1430. DeleteLine
  1431. ELSIF ch = C_L THEN
  1432. RepeatLast
  1433. ELSIF ch = C_U THEN
  1434. Beep
  1435. ELSIF ch = C_I THEN
  1436. AutoTab
  1437. ELSIF (ch = C_M) OR (ch = C_J) THEN
  1438. NewLine
  1439. ELSIF (ch >= " ") AND (ch <= "~") THEN
  1440. TypeChar (ch)
  1441. END ;
  1442. IF endEdit THEN EXIT END
  1443. END
  1444. END MainLoop ;
  1445. (* ------------------------------------------------------------------ *)
  1446. PROCEDURE Run (drv : CHAR ; VAR fileName : ARRAY OF CHAR ;
  1447. VAR changed : BOOLEAN) ;
  1448. VAR i : CARDINAL ;
  1449. BEGIN
  1450. drive := drv ;
  1451. i := 0 ;
  1452. LOOP
  1453. fname [i] := fileName [i] ;
  1454. IF (i >= HIGH (fname)) OR (i >= HIGH (fileName))
  1455. OR (fileName [i] = 0C) THEN EXIT END ;
  1456. INC (i)
  1457. END ;
  1458. curLine := 0 ;
  1459. curCol := 0 ;
  1460. topLine := 0 ;
  1461. colOff := 0 ;
  1462. insertMode := TRUE ;
  1463. autoIndent := TRUE ;
  1464. haveLast := FALSE ;
  1465. blkDef := FALSE ;
  1466. blkShown := FALSE ;
  1467. restoreOn := FALSE ;
  1468. lastFind := FALSE ;
  1469. modified := FALSE ;
  1470. MainLoop ;
  1471. changed := modified
  1472. END Run ;
  1473. END Editor.