Controllers.txt 50 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633
  1. MODULE TextControllers;
  2. (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Text/Mod/Controllers.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT
  5. Services, Stores, Ports, Models, Views, Dialog, Controllers, Properties, Containers,
  6. TextModels, TextRulers, TextSetters, TextViews;
  7. CONST
  8. noAutoScroll* = 16; noAutoIndent* = 17;
  9. (** Controller.SetCaret pos; Controller.SetSelection beg, end **)
  10. none* = -1;
  11. (* Track mode *)
  12. chars = 0; words = 1; lines = 2; (* plus "none", defined above *)
  13. enter = 3X; rdel = 7X; ldel = 8X;
  14. aL = 1CX; aR = 1DX; aU = 1EX; aD = 1FX;
  15. pL = 10X; pR = 11X; pU = 12X; pD = 13X;
  16. dL = 14X; dR = 15X; dU = 16X; dD = 17X;
  17. viewcode = TextModels.viewcode;
  18. tab = TextModels.tab; line = TextModels.line; para = TextModels.para;
  19. point = Ports.point; mm = Ports.mm; inch16 = Ports.inch DIV 16;
  20. boundCaret = TRUE;
  21. lenCutoff = 2000; (* max run length inspected to fetch properties *)
  22. attrChangeKey = "#Text:AttributeChange";
  23. resizingKey = "#System:Resizing";
  24. insertingKey = "#System:Inserting";
  25. deletingKey = "#System:Deleting";
  26. movingKey = "#System:Moving";
  27. copyingKey = "#System:Copying";
  28. linkingKey = "#System:Linking";
  29. replacingKey = "#System:Replacing";
  30. minVersion = 0; maxVersion = 0; maxStdVersion = 0;
  31. TYPE
  32. Controller* = POINTER TO ABSTRACT RECORD (Containers.Controller)
  33. view-: TextViews.View;
  34. text-: TextModels.Model (** view # NIL => text = view.ThisText() **)
  35. END;
  36. Directory* = POINTER TO ABSTRACT RECORD (Containers.Directory) END;
  37. FilterPref* = RECORD (Properties.Preference)
  38. controller*: Controller; (** IN, set to text controller asking for filter **)
  39. frame*: Views.Frame; (** IN, set to frame of controlled text view **)
  40. x*, y*: INTEGER; (** IN, set to coordinates of cursor in frame space **)
  41. filter*: BOOLEAN (** preset to FALSE **)
  42. END;
  43. FilterPollCursorMsg* = RECORD (Controllers.Message)
  44. controller*: Controller; (** IN, set to text controller asking for filter **)
  45. x*, y*: INTEGER;
  46. cursor*: INTEGER; (** as for Controllers.PollCursorMsg **)
  47. done*: BOOLEAN (** OUT; initialized to FALSE **)
  48. END;
  49. FilterTrackMsg* = RECORD (Controllers.Message)
  50. controller*: Controller; (** IN, set to text controller asking for filter **)
  51. x*, y*: INTEGER;
  52. modifiers*: SET; (** as for Controllers.TrackMsg **)
  53. done*: BOOLEAN (** OUT; initialized to FALSE **)
  54. END;
  55. StdCtrl = POINTER TO RECORD (Controller)
  56. (* general state *)
  57. cachedRd: TextModels.Reader;
  58. cachedWr: TextModels.Writer;
  59. insAttr: TextModels.Attributes; (* preset attrs for next typed char *)
  60. autoBeg, autoEnd: INTEGER; (* lazy auto-scrolling;
  61. invalid if (-1, .); initially (MAX(LONGINT), 0) *)
  62. (* caret *)
  63. carPos: INTEGER; (* HasCaret() iff 0 <= carPos <= text.Length() *)
  64. carLast: INTEGER; (* used to recover caret at meaningful position *)
  65. carX, lastX: INTEGER; (* arrow up/down anti-aliasing *)
  66. carTick: LONGINT; (* next tick to invert flashing caret mark *)
  67. carVisible: BOOLEAN; (* caret currently visible - used for flashing caret *)
  68. (* selection *)
  69. selBeg, selEnd: INTEGER; (* HasSel() iff 0 <= selBeg < selEnd <= text.Length() *)
  70. aliasSelBeg, aliasSelEnd: INTEGER; (* need lazy synchronization? *)
  71. selPin0, selPin1: INTEGER; (* anchor points of selection *)
  72. (* most recent scroll-while-tracking step *)
  73. lastStep: LONGINT
  74. END;
  75. StdDirectory = POINTER TO RECORD (Directory) END;
  76. (* messages *)
  77. ModelMessage* = ABSTRACT RECORD (Models.Message) END;
  78. (** messages to control virtual model extensions, such as marks **)
  79. SetCaretMsg* = EXTENSIBLE RECORD (ModelMessage)
  80. pos*: INTEGER
  81. END;
  82. SetSelectionMsg* = EXTENSIBLE RECORD (ModelMessage)
  83. beg*, end*: INTEGER
  84. END;
  85. ViewMessage = ABSTRACT RECORD (Views.Message) END;
  86. CaretMsg = RECORD (ViewMessage)
  87. show: BOOLEAN
  88. END;
  89. SelectionMsg = RECORD (ViewMessage)
  90. beg, end: INTEGER;
  91. show: BOOLEAN
  92. END;
  93. (* miscellaneous *)
  94. TrackState = RECORD
  95. x, y: INTEGER;
  96. toggle: BOOLEAN
  97. END;
  98. VAR
  99. dir-, stdDir-: Directory;
  100. PROCEDURE CachedReader (c: StdCtrl): TextModels.Reader;
  101. VAR rd: TextModels.Reader;
  102. BEGIN
  103. rd := c.text.NewReader(c.cachedRd); c.cachedRd := NIL; RETURN rd
  104. END CachedReader;
  105. PROCEDURE CacheReader (c: StdCtrl; rd: TextModels.Reader);
  106. BEGIN
  107. c.cachedRd := rd
  108. END CacheReader;
  109. PROCEDURE CachedWriter (c: StdCtrl; attr: TextModels.Attributes): TextModels.Writer;
  110. VAR wr: TextModels.Writer;
  111. BEGIN
  112. wr := c.text.NewWriter(c.cachedWr); wr.SetAttr(attr);
  113. c.cachedRd := NIL; RETURN wr
  114. END CachedWriter;
  115. PROCEDURE CacheWriter (c: StdCtrl; wr: TextModels.Writer);
  116. BEGIN
  117. c.cachedWr := wr
  118. END CacheWriter;
  119. (** Controller **)
  120. PROCEDURE (c: Controller) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE;
  121. VAR v: INTEGER;
  122. BEGIN
  123. (* c.Internalize^(rd); *)
  124. rd.ReadVersion(minVersion, maxVersion, v)
  125. END Internalize2;
  126. PROCEDURE (c: Controller) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE;
  127. BEGIN
  128. (* c.Externalize^(wr); *)
  129. wr.WriteVersion(maxVersion)
  130. END Externalize2;
  131. PROCEDURE (c: Controller) InitView2* (v: Views.View), EXTENSIBLE;
  132. BEGIN
  133. ASSERT((v = NIL) # (c.view = NIL), 21);
  134. IF c.view = NIL THEN ASSERT(v IS TextViews.View, 22) END;
  135. (* c.InitView^(v); *)
  136. IF v # NIL THEN c.view := v(TextViews.View); c.text := c.view.ThisModel()
  137. ELSE c.view := NIL; c.text := NIL
  138. END
  139. END InitView2;
  140. PROCEDURE (c: Controller) ThisView* (): TextViews.View, EXTENSIBLE;
  141. BEGIN
  142. RETURN c.view
  143. END ThisView;
  144. (** caret **)
  145. PROCEDURE (c: Controller) CaretPos* (): INTEGER, NEW, ABSTRACT;
  146. PROCEDURE (c: Controller) SetCaret* (pos: INTEGER), NEW, ABSTRACT;
  147. (** pre: pos = none OR 0 <= pos <= c.text.Length() **)
  148. (** post: c.carPos = pos **)
  149. (** selection **)
  150. PROCEDURE (c: Controller) GetSelection* (OUT beg, end: INTEGER), NEW, ABSTRACT;
  151. (** post: beg = end OR 0 <= beg <= end <= c.text.Length() **)
  152. PROCEDURE (c: Controller) SetSelection* (beg, end: INTEGER), NEW, ABSTRACT;
  153. (** pre: beg = end OR 0 <= beg < end <= c.text.Length() **)
  154. (** post: c.selBeg = beg, c.selEnd = end **)
  155. (** Directory **)
  156. PROCEDURE (d: Directory) NewController* (opts: SET): Controller, ABSTRACT;
  157. PROCEDURE (d: Directory) New* (): Controller, EXTENSIBLE;
  158. BEGIN
  159. RETURN d.NewController({})
  160. END New;
  161. (** miscellaneous **)
  162. PROCEDURE SetDir* (d: Directory);
  163. BEGIN
  164. ASSERT(d # NIL, 20); dir := d
  165. END SetDir;
  166. PROCEDURE Install*;
  167. BEGIN
  168. TextViews.SetCtrlDir(dir)
  169. END Install;
  170. PROCEDURE Focus* (): Controller;
  171. VAR v: Views.View; c: Containers.Controller;
  172. BEGIN
  173. v := Controllers.FocusView();
  174. IF (v # NIL) & (v IS TextViews.View) THEN
  175. c := v(TextViews.View).ThisController();
  176. IF (c # NIL) & (c IS Controller) THEN RETURN c(Controller)
  177. ELSE RETURN NIL
  178. END
  179. ELSE RETURN NIL
  180. END
  181. END Focus;
  182. PROCEDURE SetCaret* (text: TextModels.Model; pos: INTEGER);
  183. (** pre: text # NIL, pos = none OR 0 <= pos <= text.Length() **)
  184. VAR cm: SetCaretMsg;
  185. BEGIN
  186. ASSERT(text # NIL, 20); ASSERT(none <= pos, 21); ASSERT(pos <= text.Length(), 22);
  187. cm.pos := pos; Models.Broadcast(text, cm)
  188. END SetCaret;
  189. PROCEDURE SetSelection* (text: TextModels.Model; beg, end: INTEGER);
  190. (** pre: text # NIL, beg = end OR 0 <= beg < end <= text.Length() **)
  191. VAR sm: SetSelectionMsg;
  192. BEGIN
  193. ASSERT(text # NIL, 20);
  194. IF beg # end THEN
  195. ASSERT(0 <= beg, 21); ASSERT(beg < end, 22); ASSERT(end <= text.Length(), 23)
  196. END;
  197. sm.beg := beg; sm.end := end; Models.Broadcast(text, sm)
  198. END SetSelection;
  199. (* support for cursor/selection/focus marking *)
  200. PROCEDURE BlinkCaret (c: StdCtrl; f: Views.Frame; tick: INTEGER);
  201. VAR vis: BOOLEAN;
  202. BEGIN
  203. IF (c.carPos # none) & f.front & (tick >= c.carTick) THEN
  204. IF c.carVisible THEN
  205. c.MarkCaret(f, Containers.hide); c.carVisible := FALSE
  206. ELSE
  207. c.carVisible := TRUE; c.MarkCaret(f, Containers.show)
  208. END;
  209. c.carTick := tick + Dialog.caretPeriod
  210. END
  211. END BlinkCaret;
  212. PROCEDURE FlipCaret (c: StdCtrl; show: BOOLEAN);
  213. VAR msg: CaretMsg;
  214. BEGIN
  215. msg.show := show;
  216. Views.Broadcast(c.view, msg)
  217. END FlipCaret;
  218. PROCEDURE CheckCaret (c: StdCtrl);
  219. VAR text: TextModels.Model; len, pos: INTEGER;
  220. BEGIN
  221. IF ~(Containers.noCaret IN c.opts) THEN
  222. IF (c.carPos = none) & ~(boundCaret & (c.selBeg # c.selEnd)) & (c.ThisFocus() = NIL) THEN
  223. text := c.text; len := text.Length(); pos := c.carLast;
  224. IF pos < 0 THEN pos := 0 ELSIF pos > len THEN pos := len END;
  225. (* c.carVisible := FALSE; c.carTick := 0; (* force visible mark *) *)
  226. SetCaret(text, pos)
  227. END
  228. ELSE c.carPos := none
  229. END
  230. END CheckCaret;
  231. PROCEDURE HiliteRect (f: Views.Frame; l, t, r, b, s: INTEGER; show: BOOLEAN);
  232. BEGIN
  233. IF s = Ports.fill THEN
  234. f.MarkRect(l, t, r, b, Ports.fill, Ports.hilite, show)
  235. ELSE
  236. f.MarkRect(l, t, r - s, t + s, s, Ports.hilite, show);
  237. f.MarkRect(l, t + s, l + s, b - s, s, Ports.hilite, show);
  238. f.MarkRect(l + s, b - s, r, b, s, Ports.hilite, show);
  239. f.MarkRect(r - s, t + s, r, b - s, s, Ports.hilite, show)
  240. END
  241. END HiliteRect;
  242. PROCEDURE MarkSelRange (c: StdCtrl; f: Views.Frame; b, e: TextViews.Location;
  243. front, show: BOOLEAN
  244. );
  245. VAR fw, ff, r, t: INTEGER;
  246. BEGIN
  247. IF front THEN fw := 0; ff := Ports.fill ELSE fw := f.dot; ff := fw END;
  248. IF b.start # e.start THEN
  249. r := f.r; t := b.y + b.asc + b.dsc;
  250. HiliteRect(f, b.x, b.y, r + fw, t + fw, ff, show);
  251. IF t < e.y THEN HiliteRect(f, 0, t, r + fw, e.y + fw, ff, show) END;
  252. b.x := f.l; b.y := e.y
  253. END;
  254. HiliteRect(f, b.x, b.y, e.x + fw, e.y + e.asc + e.dsc + fw, ff, show)
  255. END MarkSelRange;
  256. PROCEDURE MarkSelection (c: StdCtrl; f: Views.Frame; beg, end: INTEGER; show: BOOLEAN);
  257. VAR b, e: TextViews.Location; s: Views.View;
  258. BEGIN
  259. IF (beg # end) & f.mark THEN
  260. ASSERT(beg < end, 20);
  261. s := c.Singleton();
  262. IF s # NIL THEN
  263. IF beg + 1 = end THEN Containers.MarkSingleton(c, f, show) END
  264. ELSE
  265. c.view.GetThisLocation(f, beg, b); c.view.GetThisLocation(f, end, e);
  266. IF (b.pos < e.pos) OR (b.pos = e.pos) & (b.x < e.x) THEN
  267. MarkSelRange(c, f, b, e, f.front, show)
  268. END
  269. END
  270. END
  271. END MarkSelection;
  272. PROCEDURE FlipSelection (c: StdCtrl; beg, end: INTEGER; show: BOOLEAN);
  273. VAR msg: SelectionMsg;
  274. BEGIN
  275. msg.beg := beg; msg.end := end; msg.show := show;
  276. Views.Broadcast(c.view, msg)
  277. END FlipSelection;
  278. PROCEDURE InitMarks (c: StdCtrl);
  279. BEGIN
  280. c.autoBeg := MAX(INTEGER); c.autoEnd := 0;
  281. c.carPos := none; c.carVisible := FALSE; c.carLast := none; c.carTick := 0; c.carX := -1;
  282. c.selBeg := none; c.selEnd := none;
  283. c.lastStep := 0
  284. END InitMarks;
  285. PROCEDURE AutoShowRange (c: StdCtrl; beg, end: INTEGER);
  286. BEGIN
  287. IF (beg <= c.autoBeg) & (c.autoEnd <= end) THEN
  288. c.autoBeg := beg; c.autoEnd := end (* new range includes old range: expand *)
  289. ELSE
  290. c.autoBeg := -1 (* schizopheric scroll request -> don't scroll at all *)
  291. END
  292. END AutoShowRange;
  293. PROCEDURE UpdateMarks (c: StdCtrl; op: INTEGER; beg, end, delta: INTEGER);
  294. (* ensure that marks are valid after updates *)
  295. BEGIN
  296. CASE op OF
  297. TextModels.insert:
  298. c.carLast := end; c.selBeg := end; c.selEnd := end; beg := end
  299. | TextModels.delete:
  300. c.carLast := beg; c.selBeg := beg; c.selEnd := beg; end := beg
  301. | TextModels.replace:
  302. ELSE
  303. HALT(100)
  304. END;
  305. AutoShowRange(c, beg, end)
  306. END UpdateMarks;
  307. (* support for smart cut/copy/paste and attributing *)
  308. PROCEDURE LegalChar (ch: CHAR): BOOLEAN;
  309. BEGIN
  310. IF ch < 100X THEN
  311. CASE ORD(ch) OF
  312. ORD(viewcode),
  313. ORD(tab), ORD(line), ORD(para),
  314. ORD(" ") .. 7EH, 80H .. 0FFH: RETURN TRUE
  315. ELSE RETURN FALSE
  316. END
  317. ELSE RETURN TRUE
  318. END
  319. END LegalChar;
  320. PROCEDURE LeftTerminator (ch: CHAR): BOOLEAN;
  321. BEGIN
  322. IF ch < 100X THEN
  323. CASE ch OF
  324. viewcode, tab, line, para, '"', "'", "(", "[", "{": RETURN TRUE
  325. ELSE RETURN FALSE
  326. END
  327. ELSE RETURN TRUE
  328. END
  329. END LeftTerminator;
  330. PROCEDURE RightTerminator (ch, ch1: CHAR): BOOLEAN;
  331. BEGIN
  332. IF ch < 100X THEN
  333. CASE ch OF
  334. 0X, viewcode, tab, line, para,
  335. "!", '"', "'", "(", ")", ",", ";", "?", "[", "]", "{", "}": RETURN TRUE
  336. | ".", ":":
  337. CASE ch1 OF
  338. 0X, viewcode, tab, line, para, " ": RETURN TRUE
  339. ELSE RETURN FALSE
  340. END
  341. ELSE RETURN FALSE
  342. END
  343. ELSE RETURN TRUE
  344. END
  345. END RightTerminator;
  346. PROCEDURE ReadLeft (rd: TextModels.Reader; pos: INTEGER; OUT ch: CHAR);
  347. BEGIN
  348. IF pos > 0 THEN rd.SetPos(pos - 1); rd.ReadChar(ch)
  349. ELSE rd.SetPos(pos); ch := " "
  350. END
  351. END ReadLeft;
  352. PROCEDURE SmartRange (c: StdCtrl; VAR beg, end: INTEGER);
  353. (* if possible and whole words are covered,
  354. extend [beg, end) to encompass either a leading or a trailing blank *)
  355. VAR rd: TextModels.Reader; we, be: INTEGER; ch, ch0, ch1: CHAR; rightTerm: BOOLEAN;
  356. BEGIN
  357. (*
  358. disable intelligent delete/cut/move for now
  359. rd := CachedReader(c); ReadLeft(rd, beg, ch0); rd.ReadChar(ch);
  360. IF ((ch0 <= " ") OR LeftTerminator(ch0)) & (ch # " ") THEN
  361. (* range covers beg of word *)
  362. we := beg; be := beg;
  363. WHILE (ch # 0X) & (be <= end) DO
  364. ch1 := ch; rd.ReadChar(ch); INC(be);
  365. IF (ch1 # " ") & ((be <= end) OR ~RightTerminator(ch1, ch)) THEN we := be END
  366. END;
  367. rightTerm := RightTerminator(ch1, ch);
  368. IF (beg < we) & (we = end) & ((we < be) OR rightTerm) THEN
  369. (* range covers end of word *)
  370. IF (we < be) & (ch1 = " ") THEN
  371. INC(end) (* include trailing blank *)
  372. ELSIF (beg > 0) & rightTerm & (ch0 = " ") THEN
  373. DEC(beg) (* include leading blank *)
  374. END
  375. END
  376. END;
  377. CacheReader(c, rd)
  378. *)
  379. END SmartRange;
  380. PROCEDURE OnlyWords (c: StdCtrl; beg, end: INTEGER): BOOLEAN;
  381. VAR rd: TextModels.Reader; we, be: INTEGER; ch, ch0, ch1: CHAR;
  382. rightTerm, words: BOOLEAN;
  383. BEGIN
  384. words := FALSE;
  385. rd := CachedReader(c); ReadLeft(rd, beg, ch0); rd.ReadChar(ch);
  386. IF ((ch0 <= " ") OR LeftTerminator(ch0)) & (ch # " ") THEN (* range covers beg of word *)
  387. we := beg; be := beg;
  388. WHILE (ch # 0X) & (be <= end) DO
  389. ch1 := ch; rd.ReadChar(ch); INC(be);
  390. IF (ch1 # " ") & ((be <= end) OR ~RightTerminator(ch1, ch)) THEN
  391. we := be
  392. END
  393. END;
  394. rightTerm := RightTerminator(ch1, ch);
  395. IF (beg < we) & (we = end) & ((we < be) OR rightTerm) THEN (* range covers end of word *)
  396. words := TRUE
  397. END
  398. END;
  399. CacheReader(c, rd);
  400. RETURN words
  401. END OnlyWords;
  402. PROCEDURE GetTargetField (t: TextModels.Model; pos: INTEGER;
  403. VAR touchL, touchM, touchR: BOOLEAN
  404. );
  405. VAR rd: TextModels.Reader; ch0, ch1: CHAR; leftTerm, rightTerm: BOOLEAN;
  406. BEGIN
  407. rd := t.NewReader(NIL); ReadLeft(rd, pos, ch0); rd.ReadChar(ch1);
  408. leftTerm := (ch0 <= " ") OR LeftTerminator(ch0);
  409. rightTerm := (ch1 <= " ") OR RightTerminator(ch1, 0X);
  410. touchL := ~leftTerm & rightTerm;
  411. touchM := ~leftTerm & ~rightTerm;
  412. touchR := leftTerm & ~rightTerm
  413. END GetTargetField;
  414. PROCEDURE LeftExtend (t: TextModels.Model; attr: TextModels.Attributes);
  415. VAR wr: TextModels.Writer;
  416. BEGIN
  417. wr := t.NewWriter(NIL); wr.SetAttr(attr); wr.SetPos(0); wr.WriteChar(" ")
  418. END LeftExtend;
  419. PROCEDURE RightExtend (t: TextModels.Model; attr: TextModels.Attributes);
  420. VAR wr: TextModels.Writer;
  421. BEGIN
  422. wr := t.NewWriter(NIL); wr.SetPos(t.Length()); wr.SetAttr(attr); wr.WriteChar(" ")
  423. END RightExtend;
  424. PROCEDURE MergeAdjust (target, inset: TextModels.Model; pos: INTEGER; OUT start: INTEGER);
  425. VAR rd: TextModels.Reader; a: TextModels.Attributes; ch, ch1: CHAR;
  426. touchL, touchM, touchR: BOOLEAN;
  427. BEGIN
  428. start := pos;
  429. (*
  430. disable intelligent paste for now
  431. GetTargetField(target, pos, touchL, touchM, touchR);
  432. IF touchL THEN
  433. rd := inset.NewReader(NIL); rd.SetPos(0);
  434. rd.ReadChar(ch); a := rd.attr; rd.ReadChar(ch1);
  435. IF (ch > " ") & ~RightTerminator(ch, ch1) THEN LeftExtend(inset, a); INC(start) END
  436. END;
  437. IF touchR & (inset.Length() > 0) THEN
  438. rd := inset.NewReader(rd); rd.SetPos(inset.Length() - 1); rd.ReadChar(ch);
  439. IF (ch > " ") & ~LeftTerminator(ch) THEN RightExtend(inset, rd.attr) END
  440. END
  441. *)
  442. END MergeAdjust;
  443. PROCEDURE InsertionAttr (c: StdCtrl): TextModels.Attributes;
  444. VAR rd: TextModels.Reader; r: TextRulers.Ruler; a: TextModels.Attributes; ch: CHAR;
  445. BEGIN
  446. a := c.insAttr;
  447. IF a = NIL THEN
  448. rd := CachedReader(c); a := NIL;
  449. IF c.carPos # none THEN
  450. ReadLeft(rd, c.carPos, ch); a := rd.attr;
  451. IF ((ch <= " ") OR (ch = TextModels.nbspace)) & (c.carPos < c.text.Length()) THEN
  452. rd.ReadChar(ch);
  453. IF ch > " " THEN a := rd.attr END
  454. END
  455. ELSIF boundCaret & (c.selBeg # c.selEnd) THEN
  456. rd.SetPos(c.selBeg); rd.ReadChar(ch); a := rd.attr;
  457. c.insAttr := a
  458. END;
  459. IF a = NIL THEN c.view.PollDefaults(r, a) END;
  460. CacheReader(c, rd)
  461. END;
  462. RETURN a
  463. END InsertionAttr;
  464. PROCEDURE GetTargetRange (c: StdCtrl; OUT beg, end: INTEGER);
  465. BEGIN
  466. IF boundCaret & (c.selBeg # c.selEnd) THEN
  467. beg := c.selBeg; end := c.selEnd
  468. ELSE
  469. beg := c.carPos; end := beg
  470. END
  471. END GetTargetRange;
  472. PROCEDURE DoEdit (name: Stores.OpName;
  473. c: StdCtrl; beg, end: INTEGER;
  474. attr: TextModels.Attributes; ch: CHAR; view: Views.View; w, h: INTEGER;
  475. buf: TextModels.Model; bufbeg, bufend: INTEGER; (* buf # NIL & bufend < 0: bufend = buf.Length() *)
  476. pos: INTEGER
  477. );
  478. VAR script: Stores.Operation; wr: TextModels.Writer; cluster: BOOLEAN;
  479. BEGIN
  480. IF (beg < end) (* something to delete *)
  481. OR (attr # NIL) (* something new to write *)
  482. OR (buf # NIL) (* something new to insert *)
  483. THEN
  484. cluster := (beg < end) OR (attr = NIL) OR (view # NIL);
  485. (* don't script when typing a single character -> TextModels will bunch if possible *)
  486. (* ~cluster => name is reverted to #System.Inserting by TextModels *)
  487. IF cluster THEN Models.BeginScript(c.text, name, script) END;
  488. IF beg < end THEN
  489. c.text.Delete(beg, end);
  490. IF pos > beg THEN DEC(pos, end - beg) END
  491. END;
  492. IF attr # NIL THEN
  493. ASSERT(buf = NIL, 20);
  494. wr := CachedWriter(c, attr); wr.SetPos(pos);
  495. IF view # NIL THEN wr.WriteView(view, w, h) ELSE wr.WriteChar(ch) END;
  496. CacheWriter(c, wr)
  497. ELSIF buf # NIL THEN
  498. IF bufend < 0 THEN bufend := buf.Length() END;
  499. c.text.Insert(pos, buf, bufbeg, bufend)
  500. END;
  501. IF cluster THEN Models.EndScript(c.text, script) END;
  502. CheckCaret(c)
  503. END
  504. END DoEdit;
  505. (* editing *)
  506. PROCEDURE ThisPos (v: TextViews.View; f: Views.Frame; x, y: INTEGER): INTEGER;
  507. VAR loc: TextViews.Location; pos: INTEGER;
  508. BEGIN
  509. pos := v.ThisPos(f, x, y); v.GetThisLocation(f, pos, loc);
  510. IF (loc.view # NIL) & (x > (loc.l + loc.r) DIV 2) THEN INC(pos) END;
  511. RETURN pos
  512. END ThisPos;
  513. PROCEDURE ShowPos (c: StdCtrl; beg, end: INTEGER);
  514. BEGIN
  515. IF ~(noAutoScroll IN c.opts) THEN
  516. c.view.ShowRange(beg, end, TextViews.focusOnly)
  517. END
  518. END ShowPos;
  519. PROCEDURE Indentation (c: StdCtrl; pos: INTEGER): TextModels.Model;
  520. (* pre: c.carPos # none *)
  521. VAR st: TextSetters.Setter; buf: TextModels.Model; rd: TextModels.Reader;
  522. wr: TextModels.Writer; ch: CHAR; spos: INTEGER;
  523. BEGIN
  524. buf := NIL;
  525. rd := CachedReader(c);
  526. st := c.view.ThisSetter(); spos := st.ThisSequence(pos); rd.SetPos(spos); rd.ReadChar(ch);
  527. IF (ch = tab) & (spos < pos) THEN
  528. buf := TextModels.CloneOf(c.text); wr := buf.NewWriter(NIL); wr.SetPos(buf.Length());
  529. wr.SetAttr(InsertionAttr(c));
  530. wr.WriteChar(line);
  531. REPEAT wr.WriteChar(tab); rd.ReadChar(ch) UNTIL (ch # tab) OR (rd.Pos() > pos)
  532. END;
  533. CacheReader(c, rd);
  534. RETURN buf
  535. END Indentation;
  536. PROCEDURE InsertChar (c: StdCtrl; ch: CHAR);
  537. VAR buf: TextModels.Model; attr: TextModels.Attributes;
  538. beg, end: INTEGER; legal: BOOLEAN; name: Stores.OpName;
  539. BEGIN
  540. attr := NIL; buf := NIL;
  541. IF ch < 100X THEN legal := LegalChar(ch) ELSE legal := TRUE END; (* should check Unicode *)
  542. IF (ch = ldel) OR (ch = rdel) THEN name := deletingKey ELSE name := replacingKey END;
  543. IF boundCaret & (c.selBeg # c.selEnd) & (legal OR (ch = ldel) OR (ch = rdel) OR (ch = enter)) THEN
  544. beg := c.selBeg; end := c.selEnd;
  545. IF (ch = ldel) OR (ch = rdel) THEN SmartRange(c, beg, end); ch := 0X END
  546. ELSE
  547. beg := c.carPos; end := beg
  548. END;
  549. IF (c.carPos # none) OR boundCaret & (c.selBeg # c.selEnd) THEN
  550. IF (ch = line) OR (ch = enter) THEN
  551. IF noAutoIndent IN c.opts THEN buf := NIL ELSE buf := Indentation(c, beg) END;
  552. IF buf = NIL THEN ch := line; legal := TRUE ELSE ch := 0X; legal := FALSE END
  553. END;
  554. IF legal THEN
  555. attr := InsertionAttr(c)
  556. ELSIF (ch = ldel) & (c.carPos > 0) THEN
  557. beg := c.carPos - 1; end := c.carPos
  558. ELSIF (ch = rdel) & (c.carPos < c.text.Length()) THEN
  559. beg := c.carPos; end := c.carPos + 1
  560. END
  561. END;
  562. DoEdit(name, c, beg, end, attr, ch, NIL, 0, 0, buf, 0, -1, beg)
  563. END InsertChar;
  564. PROCEDURE InsertText (c: StdCtrl; beg, end: INTEGER; text: TextModels.Model; OUT start: INTEGER);
  565. VAR buf: TextModels.Model;
  566. BEGIN
  567. buf := TextModels.CloneOf(text); buf.InsertCopy(0, text, 0, text.Length());
  568. IF beg = end THEN MergeAdjust(c.text, buf, beg, start) ELSE start := beg END;
  569. DoEdit(insertingKey, c, beg, end, NIL, 0X, NIL, 0, 0, buf, 0, -1, beg)
  570. END InsertText;
  571. PROCEDURE InsertView (c: StdCtrl; beg, end: INTEGER; v: Views.View; w, h: INTEGER);
  572. BEGIN
  573. DoEdit(insertingKey, c, beg, end, InsertionAttr(c), 0X, v, w, h, NIL, 0, 0, beg)
  574. END InsertView;
  575. PROCEDURE InSubFrame (f, f1: Views.Frame; x, y: INTEGER): BOOLEAN;
  576. BEGIN
  577. INC(x, f.gx - f1.gx); INC(y, f.gy - f1.gy);
  578. RETURN (f1.l <= x) & (x < f1.r) & (f1.t <= y) & (y < f1.b)
  579. END InSubFrame;
  580. PROCEDURE InFrame (f: Views.Frame; x, y: INTEGER): BOOLEAN;
  581. BEGIN
  582. RETURN (f.l <= x) & (x < f.r) & (f.t <= y) & (y < f.b)
  583. END InFrame;
  584. (* filtered tracking *)
  585. PROCEDURE IsFilter (v: Views.View; c: StdCtrl; f: Views.Frame; x, y: INTEGER): BOOLEAN;
  586. VAR pref: FilterPref;
  587. BEGIN
  588. pref.controller := c; pref.frame := f; pref.x := x; pref.y := y;
  589. pref.filter := FALSE;
  590. Views.HandlePropMsg(v, pref);
  591. RETURN pref.filter
  592. END IsFilter;
  593. PROCEDURE FindFilter (c: StdCtrl; f: Views.Frame; x, y: INTEGER; OUT filter: Views.View);
  594. CONST catchRange = 1000;
  595. VAR rd: TextModels.Reader; pos, beg, end: INTEGER; isF: BOOLEAN;
  596. BEGIN
  597. c.view.GetRange(f, beg, end); DEC(beg, catchRange);
  598. pos := c.view.ThisPos(f, x, y);
  599. IF pos < c.text.Length() THEN INC(pos) END; (* let filter handle itself *)
  600. rd := CachedReader(c); rd.SetPos(pos);
  601. REPEAT
  602. rd.ReadPrevView(filter);
  603. isF := (filter # NIL) & IsFilter(filter, c, f, x, y);
  604. UNTIL isF OR rd.eot OR (rd.Pos() < beg);
  605. IF ~isF THEN filter := NIL END;
  606. CacheReader(c, rd)
  607. END FindFilter;
  608. PROCEDURE FilteredPollCursor (c: StdCtrl; f: Views.Frame;
  609. VAR msg: Controllers.PollCursorMsg; VAR done: BOOLEAN
  610. );
  611. VAR filter, focus: Views.View; x, y: INTEGER; modifiers: SET; isDown: BOOLEAN; fmsg: FilterPollCursorMsg;
  612. BEGIN
  613. FindFilter(c, f, msg.x, msg.y, filter);
  614. IF filter # NIL THEN
  615. (* f.Input(x, y, modifiers, isDown); *)
  616. fmsg.x := msg.x; fmsg.y := msg.y; fmsg.cursor := msg.cursor;
  617. fmsg.controller := c; fmsg.done := FALSE;
  618. (*Views.ForwardCtrlMsg(f, fmsg) - does not work f.view # filter !!*)
  619. focus := NIL;
  620. filter.HandleCtrlMsg(f, fmsg, focus);
  621. IF fmsg.done THEN msg.cursor := fmsg.cursor END;
  622. done := fmsg.done
  623. END
  624. END FilteredPollCursor;
  625. PROCEDURE FilteredTrack (c: StdCtrl; f: Views.Frame;
  626. VAR msg: Controllers.TrackMsg; VAR done: BOOLEAN
  627. );
  628. VAR filter, focus: Views.View; fmsg: FilterTrackMsg;
  629. BEGIN
  630. FindFilter(c, f, msg.x, msg.y, filter);
  631. IF filter # NIL THEN
  632. fmsg.x := msg.x; fmsg.y := msg.y; fmsg.modifiers := msg.modifiers;
  633. fmsg.controller := c; fmsg.done := FALSE;
  634. (*Views.ForwardCtrlMsg(f, fmsg) - does not work f.view # filter !!*)
  635. focus := NIL; filter.HandleCtrlMsg(f, fmsg, focus);
  636. done := fmsg.done
  637. END
  638. END FilteredTrack;
  639. (* StdCtrl *)
  640. PROCEDURE (c: StdCtrl) Internalize2 (VAR rd: Stores.Reader);
  641. VAR thisVersion: INTEGER;
  642. BEGIN
  643. c.Internalize2^(rd);
  644. IF rd.cancelled THEN RETURN END;
  645. rd.ReadVersion(minVersion, maxStdVersion, thisVersion);
  646. IF rd.cancelled THEN RETURN END;
  647. InitMarks(c)
  648. END Internalize2;
  649. PROCEDURE (c: StdCtrl) Externalize2 (VAR wr: Stores.Writer);
  650. BEGIN
  651. c.Externalize2^(wr);
  652. wr.WriteVersion(maxStdVersion)
  653. END Externalize2;
  654. PROCEDURE (c: StdCtrl) CopyFrom (source: Stores.Store);
  655. BEGIN
  656. c.CopyFrom^(source); InitMarks(c)
  657. END CopyFrom;
  658. PROCEDURE (c: StdCtrl) Neutralize2;
  659. BEGIN
  660. (* c.Neutralize^; *)
  661. c.SetCaret(none)
  662. END Neutralize2;
  663. PROCEDURE (c: StdCtrl) GetContextType (OUT type: Stores.TypeName);
  664. BEGIN
  665. type := "TextViews.View"
  666. END GetContextType;
  667. PROCEDURE (c: StdCtrl) GetValidOps (OUT valid: SET);
  668. BEGIN
  669. valid := {};
  670. IF (c.carPos # none) OR (boundCaret & (c.selBeg # c.selEnd)) THEN
  671. valid := valid + {Controllers.pasteChar, Controllers.paste}
  672. END;
  673. IF c.selBeg # c.selEnd THEN
  674. valid := valid + {Controllers.cut, Controllers.copy}
  675. END
  676. END GetValidOps;
  677. PROCEDURE (c: StdCtrl) NativeModel (m: Models.Model): BOOLEAN;
  678. BEGIN
  679. ASSERT(m # NIL, 20);
  680. RETURN m IS TextModels.Model
  681. END NativeModel;
  682. PROCEDURE (c: StdCtrl) NativeView (v: Views.View): BOOLEAN;
  683. BEGIN
  684. ASSERT(v # NIL, 20);
  685. RETURN v IS TextViews.View
  686. END NativeView;
  687. PROCEDURE (c: StdCtrl) NativeCursorAt (f: Views.Frame; x, y: INTEGER): INTEGER;
  688. BEGIN
  689. RETURN Ports.textCursor
  690. END NativeCursorAt;
  691. PROCEDURE (c: StdCtrl) PollNativeProp (selection: BOOLEAN;
  692. VAR p: Properties.Property; VAR truncated: BOOLEAN
  693. );
  694. VAR beg, end: INTEGER;
  695. BEGIN
  696. IF selection & (c.selBeg = c.selEnd) THEN
  697. p := InsertionAttr(c).Prop(); truncated := FALSE
  698. ELSE
  699. IF selection THEN beg := c.selBeg; end := c.selEnd
  700. ELSE beg := 0; end := c.text.Length()
  701. END;
  702. (*
  703. truncated := (end - beg > lenCutoff);
  704. IF truncated THEN end := beg + lenCutoff END;
  705. *)
  706. p := c.text.Prop(beg, end)
  707. END
  708. END PollNativeProp;
  709. PROCEDURE (c: StdCtrl) SetNativeProp (selection: BOOLEAN; old, p: Properties.Property);
  710. VAR t: TextModels.Model; beg, end: INTEGER;
  711. BEGIN
  712. t := c.text;
  713. IF selection THEN beg := c.selBeg; end := c.selEnd ELSE beg := 0; end := t.Length() END;
  714. IF beg < end THEN
  715. t.Modify(beg, end, old, p);
  716. IF selection THEN c.SetSelection(beg, end) END
  717. ELSIF selection THEN
  718. c.insAttr := TextModels.ModifiedAttr(InsertionAttr(c), p)
  719. END
  720. END SetNativeProp;
  721. PROCEDURE (c: StdCtrl) MakeViewVisible (v: Views.View);
  722. VAR pos: INTEGER;
  723. BEGIN
  724. ASSERT(v # NIL, 20);
  725. ASSERT(v.context # NIL, 21);
  726. ASSERT(v.context.ThisModel() = c.text, 22);
  727. pos := v.context(TextModels.Context).Pos();
  728. ShowPos(c, pos, pos + 1)
  729. END MakeViewVisible;
  730. PROCEDURE (c: StdCtrl) GetFirstView (selection: BOOLEAN; OUT v: Views.View);
  731. VAR rd: TextModels.Reader; beg, end: INTEGER;
  732. BEGIN
  733. IF selection THEN beg := c.selBeg; end := c.selEnd
  734. ELSE beg := 0; end := c.text.Length()
  735. END;
  736. IF beg < end THEN
  737. rd := CachedReader(c); rd.SetPos(beg); rd.ReadView(v);
  738. IF rd.Pos() > end THEN v := NIL END;
  739. CacheReader(c, rd)
  740. ELSE v := NIL
  741. END
  742. END GetFirstView;
  743. PROCEDURE (c: StdCtrl) GetNextView (selection: BOOLEAN; VAR v: Views.View);
  744. VAR con: Models.Context; rd: TextModels.Reader; beg, end, pos: INTEGER;
  745. BEGIN
  746. ASSERT(v # NIL, 20); con := v.context;
  747. ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
  748. IF selection THEN beg := c.selBeg; end := c.selEnd
  749. ELSE beg := 0; end := c.text.Length()
  750. END;
  751. pos := con(TextModels.Context).Pos();
  752. IF (beg <= pos) & (pos < end) THEN
  753. rd := CachedReader(c); rd.SetPos(pos + 1); rd.ReadView(v);
  754. IF rd.Pos() > end THEN v := NIL END;
  755. CacheReader(c, rd)
  756. ELSE v := NIL
  757. END
  758. END GetNextView;
  759. PROCEDURE (c: StdCtrl) GetPrevView (selection: BOOLEAN; VAR v: Views.View);
  760. VAR con: Models.Context; rd: TextModels.Reader; beg, end, pos: INTEGER;
  761. BEGIN
  762. ASSERT(v # NIL, 20); con := v.context;
  763. ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
  764. IF selection THEN beg := c.selBeg; end := c.selEnd
  765. ELSE beg := 0; end := c.text.Length()
  766. END;
  767. pos := con(TextModels.Context).Pos();
  768. IF (beg < pos) & (pos <= end) THEN
  769. rd := CachedReader(c); rd.SetPos(pos); rd.ReadPrevView(v);
  770. IF rd.Pos() < beg THEN v := NIL END;
  771. CacheReader(c, rd)
  772. ELSE v := NIL
  773. END
  774. END GetPrevView;
  775. PROCEDURE (c: StdCtrl) GetSelectionBounds (f: Views.Frame; OUT x, y, w, h: INTEGER);
  776. VAR b, e: TextViews.Location;
  777. BEGIN
  778. c.GetSelectionBounds^(f, x, y, w, h);
  779. IF w = Views.undefined THEN
  780. c.view.GetThisLocation(f, c.selBeg, b);
  781. c.view.GetThisLocation(f, c.selEnd, e);
  782. IF b.start = e.start THEN x := b.x; w := e.x - b.x;
  783. ELSE x := f.l; w := f.r - f.l;
  784. END;
  785. y := b.y; h := e.y + e.asc + e.dsc - b.y
  786. END
  787. END GetSelectionBounds;
  788. PROCEDURE (c: StdCtrl) MarkPickTarget (source, f: Views.Frame;
  789. sx, sy, x, y: INTEGER; show: BOOLEAN
  790. );
  791. VAR b, e: TextViews.Location; pos: INTEGER;
  792. BEGIN
  793. pos := c.view.ThisPos(f, x, y);
  794. IF pos < c.text.Length() THEN
  795. c.view.GetThisLocation(f, pos, b);
  796. c.view.GetThisLocation(f, pos + 1, e);
  797. IF (b.pos < e.pos) OR (b.pos = e.pos) & (b.x < e.x) THEN
  798. MarkSelRange(c, f, b, e, TRUE, show)
  799. END
  800. END
  801. END MarkPickTarget;
  802. PROCEDURE (c: StdCtrl) MarkDropTarget (source, f: Views.Frame;
  803. sx, sy, dx, dy, w, h, rx, ry: INTEGER; type: Stores.TypeName; isSingle, show: BOOLEAN
  804. );
  805. VAR loc: TextViews.Location; pos: INTEGER;
  806. BEGIN
  807. pos := c.view.ThisPos(f, dx, dy);
  808. IF (source # NIL) & ((source.view = f.view) OR (source.view.ThisModel() = f.view.ThisModel()))
  809. & (c.selBeg < pos) & (pos < c.selEnd) THEN
  810. pos := c.selBeg
  811. END;
  812. c.view.GetThisLocation(f, pos, loc);
  813. f.MarkRect(loc.x, loc.y, loc.x + f.unit, loc.y + loc.asc + loc.dsc, Ports.fill, Ports.invert, show);
  814. IF (isSingle OR ~Services.Extends(type, "TextViews.View")) & (w > 0) & (h > 0) THEN
  815. DEC(dx, rx); DEC(dy, ry);
  816. f.MarkRect(dx, dy, dx + w, dy + h, 0, Ports.dim25, show)
  817. END
  818. END MarkDropTarget;
  819. PROCEDURE GetThisLine (c: StdCtrl; pos: INTEGER; OUT beg, end: INTEGER);
  820. VAR st: TextSetters.Setter;
  821. BEGIN
  822. st := c.view.ThisSetter();
  823. beg := st.ThisLine(pos); end := st.NextLine(beg);
  824. IF end = beg THEN end := c.text.Length() END;
  825. END GetThisLine;
  826. PROCEDURE GetThisChunk (c: StdCtrl; f: Views.Frame;
  827. VAR s: TrackState; OUT beg, end: INTEGER; OUT mode: INTEGER
  828. );
  829. VAR v: TextViews.View; b, e: TextViews.Location;
  830. st: TextSetters.Setter; ruler: TextRulers.Ruler; ra: TextRulers.Attributes;
  831. pos, r: INTEGER;
  832. BEGIN
  833. v := c.view; st := v.ThisSetter(); pos := ThisPos(v, f, s.x, s.y);
  834. ruler := TextViews.ThisRuler(v, pos); ra := ruler.style.attr;
  835. r := ra.right; IF ~(TextRulers.rightFixed IN ra.opts) OR (r > f.r) THEN r := f.r END;
  836. st.GetWord(pos, beg, end);
  837. v.GetThisLocation(f, beg, b); v.GetThisLocation(f, end, e);
  838. IF (s.x < f.l) OR (s.x >= r) THEN (* outside of line box: whole line *)
  839. GetThisLine(c, pos, beg, end);
  840. mode := lines
  841. ELSIF (s.y < b.y) OR (s.y < b.y + b.asc + b.dsc) & (s.x < b.x)
  842. OR (s.y >= e.y) & (s.x >= e.x) OR (s.y >= e.y + e.asc + e.dsc) THEN
  843. (* outside of word: single char *)
  844. beg := ThisPos(v, f, s.x, s.y); v.GetThisLocation(f, beg, b);
  845. IF (b.x > s.x) & (beg > 0) THEN DEC(beg) END;
  846. IF beg < c.text.Length() THEN end := beg + 1 ELSE end := beg END;
  847. mode := words
  848. ELSE (* whole word *)
  849. mode := words
  850. END
  851. END GetThisChunk;
  852. PROCEDURE SetSel (c: StdCtrl; beg, end: INTEGER);
  853. (* pre: ~(Containers.noSelection IN c.opts) *)
  854. BEGIN
  855. IF beg >= end THEN c.SetCaret(beg) ELSE c.SetSelection(beg, end) END
  856. END SetSel;
  857. PROCEDURE PrepareToTrack (c: StdCtrl; f: Views.Frame;
  858. VAR s: TrackState; mode: INTEGER;
  859. VAR pin0, pin1, pos: INTEGER
  860. );
  861. VAR loc: TextViews.Location; beg, end: INTEGER; m: INTEGER;
  862. BEGIN
  863. pos := ThisPos(c.view, f, s.x, s.y);
  864. IF mode IN {chars, words, lines} THEN
  865. GetThisChunk(c, f, s, pin0, pin1, m)
  866. ELSE pin0 := pos; pin1 := pos
  867. END;
  868. IF s.toggle & ((c.selBeg # c.selEnd) OR boundCaret & (c.carPos # none))
  869. & ~(Containers.noSelection IN c.opts) THEN (* modify existing selection *)
  870. IF c.selBeg # c.selEnd THEN
  871. beg := c.selBeg; end := c.selEnd
  872. ELSE
  873. beg := c.carPos; end := beg; c.selPin0 := beg; c.selPin1 := beg
  874. END;
  875. IF pin1 > c.selPin0 THEN
  876. end := pin1; pin0 := beg
  877. ELSIF pin0 < c.selPin1 THEN
  878. beg := pin0; pin0 := end
  879. END;
  880. SetSel(c, beg, end);
  881. pin1 := pin0
  882. ELSIF mode IN {chars, words, lines} THEN
  883. SetSel(c, pin0, pin1);
  884. pos := pin1
  885. ELSE
  886. SetCaret(c.text, pos)
  887. END;
  888. c.lastStep := Services.Ticks()
  889. END PrepareToTrack;
  890. PROCEDURE ScrollDelay (d: INTEGER): INTEGER;
  891. VAR second, delay: INTEGER;
  892. BEGIN
  893. second := Services.resolution;
  894. IF d < 2 * mm THEN delay := second DIV 2
  895. ELSIF d < 4 * mm THEN delay := second DIV 3
  896. ELSIF d < 6 * mm THEN delay := second DIV 5
  897. ELSIF d < 8 * mm THEN delay := second DIV 10
  898. ELSE delay := second DIV 20
  899. END;
  900. RETURN delay
  901. END ScrollDelay;
  902. PROCEDURE ScrollWhileTracking (c: StdCtrl; f: Views.Frame; VAR x0, y0, x, y: INTEGER);
  903. (* currently, there are no provisions to scroll while tracking inside an embedded view *)
  904. VAR now: LONGINT; (* normalize: BOOLEAN; *) scr: Controllers.ScrollMsg;
  905. BEGIN
  906. (* normalize := c.view.context.Normalize(); *)
  907. now := Services.Ticks();
  908. IF x < f.l THEN x0 := x; x := f.l ELSIF x > f.r THEN x0 := x; x := f.r END;
  909. IF (y < f.t) (* & normalize*) THEN
  910. IF c.lastStep + ScrollDelay(f.t - y) <= now THEN
  911. c.lastStep := now;
  912. scr.focus := TRUE; scr.vertical := TRUE; scr.op := Controllers.decLine;
  913. scr.done := FALSE;
  914. Controllers.ForwardVia(Controllers.frontPath, scr)
  915. END
  916. ELSIF (y > f.b) (* & normalize *) THEN
  917. IF c.lastStep + ScrollDelay(y - f.b) <= now THEN
  918. c.lastStep := now;
  919. scr.focus := TRUE; scr.vertical := TRUE; scr.op := Controllers.incLine;
  920. scr.done := FALSE;
  921. Controllers.ForwardVia(Controllers.frontPath, scr)
  922. END
  923. ELSE
  924. y0 := y
  925. END
  926. END ScrollWhileTracking;
  927. PROCEDURE (c: StdCtrl) TrackMarks (f: Views.Frame; x, y: INTEGER; units, extend, add: BOOLEAN);
  928. VAR s: TrackState; pos, beg, end, pin0, pin1, p, p1: INTEGER;
  929. modifiers: SET; mode, m: INTEGER; isDown, noSel: BOOLEAN;
  930. BEGIN
  931. IF c.opts * Containers.mask # Containers.mask THEN (* track caret or selection *)
  932. s.x := x; s.y := y; s.toggle := extend;
  933. noSel := Containers.noSelection IN c.opts;
  934. IF units & ~noSel THEN (* select units, i.e. words or lines *)
  935. GetThisChunk(c, f, s, beg, end, mode)
  936. ELSE (* set caret or selection *)
  937. mode := none
  938. END;
  939. PrepareToTrack(c, f, s, mode, pin0, pin1, p); x := s.x; y := s.y;
  940. beg := pin0; end := pin1;
  941. IF p < pin0 THEN beg := p ELSIF p > pin1 THEN end := p END;
  942. p := -1;
  943. f.Input(s.x, s.y, modifiers, isDown);
  944. WHILE isDown DO
  945. (*
  946. REPEAT
  947. f.Input(s.x, s.y, modifiers, isDown);
  948. *)
  949. IF (s.x # x) OR (s.y # y) THEN
  950. ScrollWhileTracking(c, f, x, y, s.x, s.y);
  951. p1 := ThisPos(c.view, f, s.x, s.y);
  952. IF p1 # p THEN
  953. p := p1;
  954. IF mode IN {words, lines} THEN
  955. IF mode = words THEN
  956. GetThisChunk(c, f, s, beg, end, m)
  957. ELSE
  958. GetThisLine(c, p, beg, end)
  959. END;
  960. IF p > pin0 THEN pos := end ELSE pos := beg END
  961. ELSE pos := p
  962. END;
  963. beg := pin0; end := pin1;
  964. IF noSel THEN
  965. c.SetCaret(pos)
  966. ELSE
  967. IF pos < pin0 THEN beg := pos ELSIF pos > pin1 THEN end := pos END;
  968. SetSel(c, beg, end);
  969. IF c.selPin0 = c.selPin1 THEN
  970. IF pos < pin0 THEN c.selPin0 := pos; c.selPin1 := pin1
  971. ELSIF pos > pin1 THEN c.selPin0 := pin0; c.selPin1 := pos
  972. END
  973. END
  974. END
  975. END
  976. END;
  977. f.Input(s.x, s.y, modifiers, isDown)
  978. END
  979. (*
  980. UNTIL ~isDown
  981. *)
  982. END
  983. END TrackMarks;
  984. PROCEDURE (c: StdCtrl) Resize (v: Views.View; l, t, r, b: INTEGER);
  985. VAR con: Models.Context;
  986. BEGIN
  987. ASSERT(v # NIL, 20); con := v.context;
  988. ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
  989. con.SetSize(r - l, b - t)
  990. END Resize;
  991. PROCEDURE (c: StdCtrl) DeleteSelection;
  992. VAR beg, end: INTEGER;
  993. BEGIN
  994. beg := c.selBeg; end := c.selEnd;
  995. IF beg # end THEN
  996. SmartRange(c, beg, end);
  997. DoEdit(deletingKey, c, beg, end, NIL, 0X, NIL, 0, 0, NIL, 0, 0, 0)
  998. END
  999. END DeleteSelection;
  1000. PROCEDURE (c: StdCtrl) MoveLocalSelection (f, dest: Views.Frame; x, y, dx, dy: INTEGER);
  1001. VAR buf: TextModels.Model; pos, beg0, end0, beg, end, start, len: INTEGER;
  1002. BEGIN
  1003. pos := dest.view(TextViews.View).ThisPos(dest, dx, dy);
  1004. (* smart move disabled for now --> use true move instead of copy
  1005. beg0 := c.selBeg; end0 := c.selEnd; beg := beg0; end := end0;
  1006. SmartRange(c, beg, end);
  1007. IF (beg < pos) & (pos < end) THEN pos := beg END;
  1008. buf := TextModels.CloneOf(c.text); buf.CopyFrom(0, c.text, beg0, end0);
  1009. IF OnlyWords(c, beg0, end0) THEN MergeAdjust(c.text, buf, pos, start) ELSE start := pos END;
  1010. len := end0 - beg0;
  1011. IF start >= end THEN DEC(start, end - beg) END;
  1012. IF pos # beg THEN
  1013. DoEdit(movingKey, c, beg, end, NIL, 0X, NIL, 0, 0, buf, pos);
  1014. SetSelection(c.text, start, start + len);
  1015. AutoShowRange(c, start, start + len)
  1016. END
  1017. *)
  1018. beg := c.selBeg; end := c.selEnd;
  1019. IF (pos < beg) OR (pos > end) THEN
  1020. len := end - beg; start := pos;
  1021. IF start >= end THEN DEC(start, len) END;
  1022. DoEdit(movingKey, c, 0, 0, NIL, 0X, NIL, 0, 0, c.text, beg, end, pos);
  1023. SetSelection(c.text, start, start + len);
  1024. AutoShowRange(c, start, start + len)
  1025. END
  1026. END MoveLocalSelection;
  1027. PROCEDURE (c: StdCtrl) CopyLocalSelection (f, dest: Views.Frame; x, y, dx, dy: INTEGER);
  1028. VAR buf: TextModels.Model; pos, beg, end, start, len: INTEGER;
  1029. BEGIN
  1030. pos := dest.view(TextViews.View).ThisPos(dest, dx, dy);
  1031. beg := c.selBeg; end := c.selEnd;
  1032. IF (beg < pos) & (pos < end) THEN pos := beg END;
  1033. buf := TextModels.CloneOf(c.text); buf.InsertCopy(0, c.text, beg, end);
  1034. IF OnlyWords(c, beg, end) THEN MergeAdjust(c.text, buf, pos, start) ELSE start := pos END;
  1035. len := end - beg;
  1036. DoEdit(copyingKey, c, 0, 0, NIL, 0X, NIL, 0, 0, buf, 0, -1, pos);
  1037. SetSelection(c.text, start, start + len);
  1038. AutoShowRange(c, start, start + len)
  1039. END CopyLocalSelection;
  1040. PROCEDURE (c: StdCtrl) SelectionCopy (): Containers.Model;
  1041. VAR t: TextModels.Model;
  1042. BEGIN
  1043. IF c.selBeg # c.selEnd THEN
  1044. t := TextModels.CloneOf(c.text); t.InsertCopy(0, c.text, c.selBeg, c.selEnd);
  1045. ELSE t := NIL
  1046. END;
  1047. RETURN t
  1048. END SelectionCopy;
  1049. PROCEDURE (c: StdCtrl) NativePaste (m: Models.Model; f: Views.Frame);
  1050. VAR beg, end, start: INTEGER;
  1051. BEGIN
  1052. WITH m: TextModels.Model DO
  1053. GetTargetRange(c, beg, end);
  1054. IF beg # none THEN InsertText(c, beg, end, m, start) END
  1055. END
  1056. END NativePaste;
  1057. PROCEDURE (c: StdCtrl) ArrowChar (f: Views.Frame; ch: CHAR; units, select: BOOLEAN);
  1058. VAR st: TextSetters.Setter; v: TextViews.View; loc: TextViews.Location;
  1059. org, len, p, pos, b, e, beg, end, d, d0, edge, x, dy: INTEGER;
  1060. change, rightEdge, rightDir: BOOLEAN;
  1061. scroll: Controllers.ScrollMsg;
  1062. BEGIN
  1063. c.insAttr := NIL;
  1064. Models.StopBunching(c.text);
  1065. v := c.view; st := v.ThisSetter();
  1066. change := select OR (c.selBeg = c.selEnd);
  1067. IF c.selBeg # c.selEnd THEN beg := c.selBeg; end := c.selEnd
  1068. ELSE beg := c.carPos; end := beg; c.carLast := beg
  1069. END;
  1070. len := c.text.Length();
  1071. rightDir := (ch = aR) OR (ch = pR) OR (ch = dR) OR (ch = aD) OR (ch = pD) OR (ch = dD);
  1072. rightEdge := change & (c.carLast < end)
  1073. OR rightDir & (~change OR (beg = end) & (c.carLast = end));
  1074. IF rightEdge THEN edge := end ELSE edge := beg END;
  1075. ShowPos(c, edge, edge);
  1076. b := beg; e := end; d := edge; d0 := edge;
  1077. CASE ch OF
  1078. | aL:
  1079. IF units THEN
  1080. p := d; e := d;
  1081. WHILE (p > 0) & ((edge = d) OR (edge = e)) DO DEC(p); st.GetWord(p, edge, e) END;
  1082. ELSIF change THEN DEC(edge)
  1083. END
  1084. | pL, dL:
  1085. v.GetThisLocation(f, edge, loc); edge := loc.start
  1086. | aR:
  1087. IF units THEN
  1088. p := d; e := edge;
  1089. WHILE (p < len) & ((edge <= d) OR (edge = e)) DO INC(p); st.GetWord(p, edge, e) END
  1090. ELSIF change THEN INC(edge)
  1091. END
  1092. | pR, dR:
  1093. v.GetThisLocation(f, edge, loc); p := st.NextLine(loc.start);
  1094. IF p = loc.start THEN p := len ELSE DEC(p) END;
  1095. IF p > edge THEN edge := p END
  1096. | aU:
  1097. IF units THEN
  1098. p := st.ThisSequence(edge);
  1099. IF p < edge THEN edge := p ELSE edge := st.PreviousSequence(edge) END
  1100. ELSE
  1101. v.PollOrigin(org, dy); v.GetThisLocation(f, edge, loc);
  1102. IF c.lastX >= 0 THEN x := c.lastX ELSE x := loc.x END;
  1103. c.carX := x;
  1104. IF loc.start > 0 THEN
  1105. edge := v.ThisPos(f, x, loc.y - 1);
  1106. IF (edge >= loc.start) & (org > 0) THEN
  1107. v.SetOrigin(org - 1, 0);
  1108. v.GetThisLocation(f, edge, loc);
  1109. edge := v.ThisPos(f, x, loc.y - 1)
  1110. END
  1111. END
  1112. END
  1113. | pU:
  1114. v.PollOrigin(org, dy);
  1115. IF edge > org THEN edge := org
  1116. ELSIF org > 0 THEN
  1117. scroll.focus := TRUE; scroll.vertical := TRUE; scroll.op := Controllers.decPage;
  1118. scroll.done := FALSE;
  1119. Views.ForwardCtrlMsg(f, scroll);
  1120. v.PollOrigin(edge, dy)
  1121. END
  1122. | dU:
  1123. edge := 0
  1124. | aD:
  1125. IF units THEN
  1126. p := st.NextSequence(st.ThisSequence(edge));
  1127. IF p > edge THEN edge := p ELSE edge := st.NextSequence(p) END
  1128. ELSE
  1129. v.GetThisLocation(f, edge, loc);
  1130. IF c.lastX >= 0 THEN x := c.lastX ELSE x := loc.x END;
  1131. c.carX := x;
  1132. edge := v.ThisPos(f, x, loc.y + loc.asc + loc.dsc + 1)
  1133. END
  1134. | pD:
  1135. v.GetRange(f, b, e);
  1136. IF e < len THEN
  1137. scroll.focus := TRUE; scroll.vertical := TRUE; scroll.op := Controllers.incPage;
  1138. scroll.done := FALSE;
  1139. Views.ForwardCtrlMsg(f, scroll);
  1140. v.GetRange(f, edge, e)
  1141. ELSE edge := len
  1142. END
  1143. | dD:
  1144. edge := len
  1145. END;
  1146. IF rightEdge THEN end := edge ELSE beg := edge END;
  1147. IF ~select THEN
  1148. IF rightDir THEN beg := edge ELSE end := edge END
  1149. END;
  1150. IF beg < 0 THEN beg := 0 ELSIF beg > len THEN beg := len END;
  1151. IF end < beg THEN end := beg ELSIF end > len THEN end := len END;
  1152. IF beg = end THEN
  1153. ShowPos(c, beg, end)
  1154. ELSE
  1155. IF rightEdge THEN ShowPos(c, end - 1, end) ELSE ShowPos(c, beg, beg + 1) END
  1156. END;
  1157. SetSel(c, beg, end)
  1158. END ArrowChar;
  1159. PROCEDURE (c: StdCtrl) ControlChar (f: Views.Frame; ch: CHAR);
  1160. BEGIN
  1161. InsertChar(c, ch)
  1162. END ControlChar;
  1163. PROCEDURE (c: StdCtrl) PasteChar (ch: CHAR);
  1164. BEGIN
  1165. InsertChar(c, ch)
  1166. END PasteChar;
  1167. PROCEDURE (c: StdCtrl) PasteView (f: Views.Frame; v: Views.View; w, h: INTEGER);
  1168. VAR t: TextModels.Model; pos, start, beg, end, len: INTEGER;
  1169. BEGIN
  1170. GetTargetRange(c, beg, end);
  1171. IF beg # none THEN InsertView(c, beg, end, v, w, h) END
  1172. END PasteView;
  1173. PROCEDURE (c: StdCtrl) Drop (src, f: Views.Frame; sx, sy, x, y, w, h, rx, ry: INTEGER;
  1174. v: Views.View; isSingle: BOOLEAN
  1175. );
  1176. VAR t: TextModels.Model; pos, start, beg, end, len: INTEGER;
  1177. BEGIN
  1178. pos := ThisPos(c.view, f, x, y);
  1179. WITH v: TextViews.View DO t := v.ThisModel() ELSE t := NIL END;
  1180. IF (t # NIL) & ~isSingle THEN
  1181. InsertText(c, pos, pos, t, start); len := t.Length()
  1182. ELSE
  1183. InsertView(c, pos, pos, v, w, h); start := pos; len := 1
  1184. END;
  1185. SetSelection(c.text, start, start + len);
  1186. AutoShowRange(c, start, start + len)
  1187. END Drop;
  1188. PROCEDURE (c: StdCtrl) PickNativeProp (f: Views.Frame; x, y: INTEGER; VAR p: Properties.Property);
  1189. VAR rd: TextModels.Reader;
  1190. BEGIN
  1191. rd := CachedReader(c); rd.SetPos(ThisPos(c.view, f, x, y)); rd.Read;
  1192. IF ~rd.eot THEN p := rd.attr.Prop() ELSE p := NIL END;
  1193. CacheReader(c, rd)
  1194. END PickNativeProp;
  1195. PROCEDURE (c: StdCtrl) HandleModelMsg (VAR msg: Models.Message);
  1196. VAR done: BOOLEAN;
  1197. BEGIN
  1198. c.HandleModelMsg^(msg);
  1199. IF msg.model = c.text THEN
  1200. WITH msg: Models.UpdateMsg DO
  1201. WITH msg: TextModels.UpdateMsg DO
  1202. CASE msg.op OF
  1203. TextModels.insert, TextModels.delete, TextModels.replace:
  1204. UpdateMarks(c, msg.op, msg.beg, msg.end, msg.delta)
  1205. ELSE (* unknown text op happened *)
  1206. c.view.Neutralize
  1207. END
  1208. ELSE (* unknown text update happened *)
  1209. c.view.Neutralize
  1210. END
  1211. | msg: ModelMessage DO
  1212. WITH msg: SetCaretMsg DO
  1213. c.SetCaret(msg.pos)
  1214. | msg: SetSelectionMsg DO
  1215. c.SetSelection(msg.beg, msg.end)
  1216. ELSE
  1217. END
  1218. ELSE
  1219. END
  1220. END
  1221. END HandleModelMsg;
  1222. PROCEDURE (c: StdCtrl) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
  1223. BEGIN
  1224. c.HandleViewMsg^(f, msg);
  1225. IF msg.view = c.view THEN
  1226. WITH msg: ViewMessage DO
  1227. WITH msg: CaretMsg DO
  1228. c.MarkCaret(f, msg.show)
  1229. | msg: SelectionMsg DO
  1230. MarkSelection(c, f, msg.beg, msg.end, msg.show)
  1231. END
  1232. ELSE
  1233. END
  1234. END
  1235. END HandleViewMsg;
  1236. PROCEDURE (c: StdCtrl) HandleCtrlMsg (f: Views.Frame;
  1237. VAR msg: Controllers.Message; VAR focus: Views.View
  1238. );
  1239. VAR g: Views.Frame; beg, end: INTEGER; done: BOOLEAN;
  1240. BEGIN
  1241. IF (msg IS Controllers.MarkMsg) OR (msg IS Controllers.TickMsg) THEN
  1242. beg := c.autoBeg; end := c.autoEnd;
  1243. c.autoBeg := MAX(INTEGER); c.autoEnd := 0
  1244. END;
  1245. WITH msg: Controllers.TickMsg DO
  1246. IF ~(noAutoScroll IN c.opts)
  1247. & (0 <= beg) & (beg <= end) & (end <= c.text.Length())
  1248. & c.view.context.Normalize()
  1249. THEN
  1250. c.view.ShowRange(beg, end, TextViews.focusOnly)
  1251. END;
  1252. IF focus = NIL THEN
  1253. CheckCaret(c); BlinkCaret(c, f, msg.tick);
  1254. IF (c.selBeg # c.aliasSelBeg) OR (c.selEnd # c.aliasSelEnd) THEN
  1255. (* lazy update of text-synchronous alias marks *)
  1256. c.aliasSelBeg := c.selBeg; c.aliasSelEnd := c.selEnd;
  1257. SetSelection(c.text, c.selBeg, c.selEnd)
  1258. END
  1259. END
  1260. | msg: Controllers.MarkMsg DO
  1261. c.carX := -1;
  1262. IF msg.show THEN c.carVisible := TRUE; c.carTick := 0 END
  1263. | msg: Controllers.TrackMsg DO
  1264. c.insAttr := NIL; c.carX := -1; Models.StopBunching(c.text)
  1265. | msg: Controllers.EditMsg DO
  1266. c.lastX := c.carX; c.carX := -1;
  1267. IF focus = NIL THEN CheckCaret(c) END
  1268. | msg: Controllers.ReplaceViewMsg DO
  1269. c.carX := -1
  1270. | msg: Controllers.TransferMessage DO
  1271. c.carX := -1
  1272. | msg: Properties.EmitMsg DO
  1273. c.carX := -1
  1274. ELSE
  1275. END;
  1276. done := FALSE;
  1277. WITH msg: Controllers.CursorMessage DO
  1278. IF TRUE (* Containers.noCaret IN c.opts *) THEN (* mask or browser mode *)
  1279. g := Views.FrameAt(f, msg.x, msg.y);
  1280. IF (g = NIL) OR IsFilter(g.view, c, f, msg.x, msg.y) THEN
  1281. WITH msg: Controllers.PollCursorMsg DO
  1282. FilteredPollCursor(c, f, msg, done)
  1283. | msg: Controllers.TrackMsg DO
  1284. FilteredTrack(c, f, msg, done)
  1285. ELSE
  1286. END
  1287. END
  1288. END
  1289. ELSE
  1290. END;
  1291. IF ~done THEN c.HandleCtrlMsg^(f, msg, focus) END
  1292. END HandleCtrlMsg;
  1293. (* caret *)
  1294. PROCEDURE (c: StdCtrl) HasCaret (): BOOLEAN;
  1295. BEGIN
  1296. RETURN c.carPos # none
  1297. END HasCaret;
  1298. PROCEDURE (c: StdCtrl) MarkCaret (f: Views.Frame; show: BOOLEAN);
  1299. CONST carW = 1; carMinH = 7; (* in frame dots *)
  1300. VAR loc: TextViews.Location; pos, beg, end, u, x, y, w, h: INTEGER; fm: INTEGER;
  1301. BEGIN
  1302. pos := c.carPos;
  1303. IF (pos # none) & f.mark & (f.front & c.carVisible OR ~f.front) THEN
  1304. c.view.GetRange(f, beg, end);
  1305. IF (beg <= pos) & (pos <= end) THEN
  1306. u := f.dot;
  1307. c.view.GetThisLocation(f, pos, loc);
  1308. IF f.front THEN fm := Ports.invert ELSE fm := Ports.dim50 END;
  1309. x := loc.x; y := loc.y; h := loc.asc + loc.dsc;
  1310. IF Dialog.thickCaret THEN w := 2 * carW * u ELSE w := carW * u END;
  1311. IF x >= f.r - w THEN DEC(x, w) END;
  1312. IF h < carMinH * u THEN h := carMinH * u END; (* special caret in lines of (almost) zero height *)
  1313. f.MarkRect(x, y, x + w, y + h, Ports.fill, fm, show)
  1314. END
  1315. END
  1316. END MarkCaret;
  1317. PROCEDURE (c: StdCtrl) CaretPos (): INTEGER;
  1318. BEGIN
  1319. RETURN c.carPos
  1320. END CaretPos;
  1321. PROCEDURE (c: StdCtrl) SetCaret (pos: INTEGER);
  1322. BEGIN
  1323. ASSERT(none <= pos, 20); ASSERT(pos <= c.text.Length(), 21);
  1324. c.insAttr := NIL;
  1325. IF pos # c.carPos THEN
  1326. IF (pos # none) & (c.carPos = none) THEN
  1327. IF boundCaret THEN c.SetSelection(none, none) END;
  1328. c.SetFocus(NIL)
  1329. END;
  1330. IF Containers.noCaret IN c.opts THEN pos := none END;
  1331. IF c.carPos # none THEN
  1332. c.carLast := c.carPos; FlipCaret(c, Containers.hide)
  1333. END;
  1334. c.carPos := pos;
  1335. IF pos # none THEN
  1336. c.carVisible := TRUE; c.carTick := Services.Ticks() + Dialog.caretPeriod; FlipCaret(c, Containers.show)
  1337. END
  1338. END
  1339. END SetCaret;
  1340. (* selection *)
  1341. PROCEDURE (c: StdCtrl) HasSelection (): BOOLEAN;
  1342. BEGIN
  1343. RETURN c.selBeg # c.selEnd
  1344. END HasSelection;
  1345. PROCEDURE (c: StdCtrl) Selectable (): BOOLEAN;
  1346. BEGIN
  1347. RETURN c.text.Length() > 0
  1348. END Selectable;
  1349. PROCEDURE (c: StdCtrl) SetSingleton (s: Views.View);
  1350. VAR s0: Views.View;
  1351. BEGIN
  1352. s0 := c.Singleton();
  1353. c.SetSingleton^(s);
  1354. s := c.Singleton();
  1355. IF s # s0 THEN
  1356. c.insAttr := NIL;
  1357. IF s # NIL THEN
  1358. c.selBeg := s.context(TextModels.Context).Pos(); c.selEnd := c.selBeg + 1;
  1359. c.selPin0 := c.selBeg; c.selPin1 := c.selEnd
  1360. ELSE c.selBeg := none; c.selEnd := none
  1361. END
  1362. END
  1363. END SetSingleton;
  1364. PROCEDURE (c: StdCtrl) SelectAll (select: BOOLEAN);
  1365. (** extended by subclass to include intrinsic selections **)
  1366. BEGIN
  1367. IF select THEN c.SetSelection(0, c.text.Length()) ELSE c.SetSelection(none, none) END
  1368. END SelectAll;
  1369. PROCEDURE (c: StdCtrl) InSelection (f: Views.Frame; x, y: INTEGER): BOOLEAN;
  1370. (* pre: c.selBeg # c.selEnd *)
  1371. (* post: (x, y) in c.selection *)
  1372. VAR b, e: TextViews.Location; y0, y1, y2, y3: INTEGER;
  1373. BEGIN
  1374. c.view.GetThisLocation(f, c.selBeg, b); y0 := b.y; y1 := y0 + b.asc + b.dsc;
  1375. c.view.GetThisLocation(f, c.selEnd, e); y2 := e.y; y3 := y2 + e.asc + e.dsc;
  1376. RETURN ((y >= y0) & (x >= b.x) OR (y >= y1)) & ((y < y2) OR (y < y3) & (x < e.x))
  1377. END InSelection;
  1378. PROCEDURE (c: StdCtrl) MarkSelection (f: Views.Frame; show: BOOLEAN);
  1379. BEGIN
  1380. MarkSelection(c, f, c.selBeg, c.selEnd, show)
  1381. END MarkSelection;
  1382. PROCEDURE (c: StdCtrl) GetSelection (OUT beg, end: INTEGER);
  1383. BEGIN
  1384. beg := c.selBeg; end := c.selEnd
  1385. END GetSelection;
  1386. PROCEDURE (c: StdCtrl) SetSelection (beg, end: INTEGER);
  1387. VAR t: TextModels.Model; rd: TextModels.Reader;
  1388. beg0, end0, p: INTEGER; singleton: BOOLEAN;
  1389. BEGIN
  1390. t := c.text; ASSERT(t # NIL, 20);
  1391. IF Containers.noSelection IN c.opts THEN end := beg
  1392. ELSIF beg # end THEN
  1393. ASSERT(0 <= beg, 21); ASSERT(beg < end, 22); ASSERT(end <= t.Length(), 23)
  1394. END;
  1395. beg0 := c.selBeg; end0 := c.selEnd;
  1396. c.insAttr := NIL;
  1397. IF (beg # beg0) OR (end # end0) THEN
  1398. IF (beg # end) & (c.selBeg = c.selEnd) THEN
  1399. IF boundCaret THEN
  1400. IF c.carPos = end THEN p := c.carPos ELSE p := beg END;
  1401. c.SetCaret(none); c.carLast := p
  1402. END;
  1403. c.SetFocus(NIL);
  1404. c.selPin0 := beg; c.selPin1 := end
  1405. ELSIF boundCaret & (beg = end) THEN
  1406. c.selPin1 := c.selPin0 (* clear selection anchors *)
  1407. END;
  1408. IF beg + 1 = end THEN
  1409. rd := CachedReader(c);
  1410. rd.SetPos(beg); rd.Read; singleton := rd.view # NIL;
  1411. CacheReader(c, rd)
  1412. ELSE singleton := FALSE
  1413. END;
  1414. IF singleton THEN (* native or singleton -> singleton *)
  1415. IF rd.view # c.Singleton() THEN c.SetSingleton(rd.view) END
  1416. ELSIF c.Singleton() # NIL THEN (* singleton -> native *)
  1417. c.SetSingleton(NIL);
  1418. c.selBeg := beg; c.selEnd := end;
  1419. FlipSelection(c, beg, end, Containers.show)
  1420. ELSE (* native -> native *)
  1421. c.selBeg := beg; c.selEnd := end;
  1422. IF (beg0 <= beg) & (end <= end0) THEN (* reduce *)
  1423. p := end0; end0 := beg; beg := end; end := p
  1424. ELSIF (beg <= beg0) & (end0 <= end) THEN (* extend *)
  1425. p := end; end := beg0; beg0 := end0; end0 := p
  1426. ELSIF (beg <= beg0) & (beg0 <= end) THEN (* shift left *)
  1427. p := end; end := beg0; beg0 := p
  1428. ELSIF (end >= end0) & (beg <= end0) THEN (* shift right *)
  1429. p := end0; end0 := beg; beg := p
  1430. END;
  1431. IF beg0 < end0 THEN FlipSelection(c, beg0, end0, Containers.show) END;
  1432. IF beg < end THEN FlipSelection(c, beg, end, Containers.show) END
  1433. END
  1434. END
  1435. END SetSelection;
  1436. (* StdDirectory *)
  1437. PROCEDURE (d: StdDirectory) NewController (opts: SET): Controller;
  1438. VAR c: StdCtrl;
  1439. BEGIN
  1440. NEW(c); c.SetOpts(opts); InitMarks(c); RETURN c
  1441. END NewController;
  1442. PROCEDURE Init;
  1443. VAR d: StdDirectory;
  1444. BEGIN
  1445. NEW(d); dir := d; stdDir := d
  1446. END Init;
  1447. BEGIN
  1448. Init
  1449. END TextControllers.