Containers.txt 45 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381
  1. MODULE Containers;
  2. (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Containers.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT Kernel, Services, Ports, Dialog, Stores, Models, Views, Controllers, Properties, Mechanisms;
  5. CONST
  6. (** Controller.opts **)
  7. noSelection* = 0; noFocus* = 1; noCaret* = 2;
  8. mask* = {noSelection, noCaret}; layout* = {noFocus};
  9. modeOpts = {noSelection, noFocus, noCaret};
  10. (** Controller.SelectAll select **)
  11. deselect* = FALSE; select* = TRUE;
  12. (** Controller.PollNativeProp/etc. selection **)
  13. any* = FALSE; selection* = TRUE;
  14. (** Mark/MarkCaret/MarkSelection/MarkSingleton show **)
  15. hide* = FALSE; show* = TRUE;
  16. indirect = FALSE; direct = TRUE;
  17. TAB = 9X; LTAB = 0AX; ENTER = 0DX; ESC = 01BX;
  18. PL = 10X; PR = 11X; PU = 12X; PD = 13X;
  19. DL = 14X; DR = 15; DU = 16X; DD = 17X;
  20. AL = 1CX; AR = 1DX; AU = 1EX; AD = 1FX;
  21. minVersion = 0; maxModelVersion = 0; maxViewVersion = 0; maxCtrlVersion = 0;
  22. (* buttons *)
  23. left = 16; middle = 17; right = 18; alt = 28; (* same as in HostPorts! *)
  24. TYPE
  25. Model* = POINTER TO ABSTRACT RECORD (Models.Model) END;
  26. View* = POINTER TO ABSTRACT RECORD (Views.View)
  27. model: Model;
  28. controller: Controller;
  29. alienCtrl: Stores.Store (* alienCtrl = NIL OR controller = NIL *)
  30. END;
  31. Controller* = POINTER TO ABSTRACT RECORD (Controllers.Controller)
  32. opts-: SET;
  33. model: Model; (* connected iff model # NIL *)
  34. view: View;
  35. focus, singleton: Views.View;
  36. bVis: BOOLEAN (* control visibility of focus/singleton border *)
  37. END;
  38. Directory* = POINTER TO ABSTRACT RECORD END;
  39. PollFocusMsg = RECORD (Controllers.PollFocusMsg)
  40. all: BOOLEAN;
  41. ctrl: Controller
  42. END;
  43. ViewOp = POINTER TO RECORD (Stores.Operation)
  44. v: View;
  45. controller: Controller; (* may be NIL *)
  46. alienCtrl: Stores.Store
  47. END;
  48. ControllerOp = POINTER TO RECORD (Stores.Operation)
  49. c: Controller;
  50. opts: SET
  51. END;
  52. ViewMessage = ABSTRACT RECORD (Views.Message) END;
  53. FocusMsg = RECORD (ViewMessage)
  54. set: BOOLEAN
  55. END;
  56. SingletonMsg = RECORD (ViewMessage)
  57. set: BOOLEAN
  58. END;
  59. FadeMsg = RECORD (ViewMessage)
  60. show: BOOLEAN
  61. END;
  62. DropPref* = RECORD (Properties.Preference)
  63. mode-: SET;
  64. okToDrop*: BOOLEAN
  65. END;
  66. GetOpts* = RECORD (Views.PropMessage)
  67. valid*, opts*: SET
  68. END;
  69. SetOpts* = RECORD (Views.PropMessage)
  70. valid*, opts*: SET
  71. END;
  72. PROCEDURE ^ (v: View) SetController* (c: Controller), NEW;
  73. PROCEDURE ^ (v: View) InitModel* (m: Model), NEW;
  74. PROCEDURE ^ Focus* (): Controller;
  75. PROCEDURE ^ ClaimFocus (v: Views.View): BOOLEAN;
  76. PROCEDURE ^ MarkFocus (c: Controller; f: Views.Frame; show: BOOLEAN);
  77. PROCEDURE ^ MarkSingleton* (c: Controller; f: Views.Frame; show: BOOLEAN);
  78. PROCEDURE ^ FadeMarks* (c: Controller; show: BOOLEAN);
  79. PROCEDURE ^ CopyView (source: Controller; VAR view: Views.View; VAR w, h: INTEGER);
  80. PROCEDURE ^ ThisProp (c: Controller; direct: BOOLEAN): Properties.Property;
  81. PROCEDURE ^ SetProp (c: Controller; old, p: Properties.Property; direct: BOOLEAN);
  82. PROCEDURE ^ (c: Controller) InitView* (v: Views.View), NEW;
  83. PROCEDURE (c: Controller) InitView2* (v: Views.View), NEW, EMPTY;
  84. PROCEDURE ^ (c: Controller) ThisView* (): View, NEW, EXTENSIBLE;
  85. PROCEDURE ^ (c: Controller) ThisFocus* (): Views.View, NEW, EXTENSIBLE;
  86. PROCEDURE ^ (c: Controller) ConsiderFocusRequestBy* (view: Views.View), NEW;
  87. PROCEDURE ^ (c: Controller) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER), NEW;
  88. PROCEDURE ^ (c: Controller) Neutralize*, NEW;
  89. (** called by view's Neutralize **)
  90. PROCEDURE ^ (c: Controller) HandleModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
  91. (** called by view's HandleModelMsg after handling msg **)
  92. PROCEDURE ^ (c: Controller) HandleViewMsg* (f: Views.Frame; VAR msg: Views.Message), NEW, EXTENSIBLE;
  93. (** called by view's HandleViewMsg after handling msg **)
  94. PROCEDURE ^ (c: Controller) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View), NEW, EXTENSIBLE;
  95. (** called by view's HandleCtrlMsg *before* handling msg; focus is respected/used by view **)
  96. PROCEDURE ^ (c: Controller) HandlePropMsg* (VAR msg: Views.PropMessage), NEW, EXTENSIBLE;
  97. (** called by view's HandlePropMsg after handling msg; controller can override view **)
  98. (** Model **)
  99. PROCEDURE (m: Model) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
  100. VAR thisVersion: INTEGER;
  101. BEGIN
  102. m.Internalize^(rd);
  103. IF rd.cancelled THEN RETURN END;
  104. rd.ReadVersion(minVersion, maxModelVersion, thisVersion)
  105. END Internalize;
  106. PROCEDURE (m: Model) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
  107. BEGIN
  108. m.Externalize^(wr);
  109. wr.WriteVersion(maxModelVersion)
  110. END Externalize;
  111. PROCEDURE (m: Model) GetEmbeddingLimits* (OUT minW, maxW, minH, maxH: INTEGER), NEW, ABSTRACT;
  112. PROCEDURE (m: Model) ReplaceView* (old, new: Views.View), NEW, ABSTRACT;
  113. PROCEDURE (m: Model) InitFrom- (source: Model), NEW, EMPTY;
  114. (** View **)
  115. PROCEDURE (v: View) AcceptableModel- (m: Model): BOOLEAN, NEW, ABSTRACT;
  116. PROCEDURE (v: View) InitModel2- (m: Model), NEW, EMPTY;
  117. PROCEDURE (v: View) InitModel* (m: Model), NEW;
  118. BEGIN
  119. ASSERT((v.model = NIL) OR (v.model = m), 20);
  120. ASSERT(m # NIL, 21);
  121. ASSERT(v.AcceptableModel(m), 22);
  122. v.model := m;
  123. Stores.Join(v, m);
  124. v.InitModel2(m)
  125. END InitModel;
  126. PROCEDURE (v: View) Externalize2- (VAR rd: Stores.Writer), NEW, EMPTY;
  127. PROCEDURE(v: View) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
  128. PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader);
  129. VAR st: Stores.Store; c: Controller; m: Model; thisVersion: INTEGER;
  130. BEGIN
  131. v.Internalize^(rd);
  132. IF rd.cancelled THEN RETURN END;
  133. rd.ReadVersion(minVersion, maxViewVersion, thisVersion);
  134. IF rd.cancelled THEN RETURN END;
  135. rd.ReadStore(st); ASSERT(st # NIL, 100);
  136. IF ~(st IS Model) THEN
  137. rd.TurnIntoAlien(Stores.alienComponent);
  138. Stores.Report("#System:AlienModel", "", "", "");
  139. RETURN
  140. END;
  141. m := st(Model);
  142. rd.ReadStore(st);
  143. IF st = NIL THEN c := NIL; v.alienCtrl := NIL
  144. ELSIF st IS Stores.Alien THEN
  145. c := NIL; v.alienCtrl := st; Stores.Join(v, v.alienCtrl);
  146. Stores.Report("#System:AlienControllerWarning", "", "", "")
  147. ELSE c := st(Controller); v.alienCtrl := NIL
  148. END;
  149. v.InitModel(m);
  150. IF c # NIL THEN v.SetController(c) ELSE v.controller := NIL END;
  151. v.Internalize2(rd)
  152. END Internalize;
  153. PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer);
  154. BEGIN
  155. ASSERT(v.model # NIL, 20);
  156. v.Externalize^(wr);
  157. wr.WriteVersion(maxViewVersion);
  158. wr.WriteStore(v.model);
  159. IF v.controller # NIL THEN wr.WriteStore(v.controller)
  160. ELSE wr.WriteStore(v.alienCtrl)
  161. END;
  162. v.Externalize2(wr)
  163. END Externalize;
  164. PROCEDURE (v: View) CopyFromModelView2- (source: Views.View; model: Models.Model), NEW, EMPTY;
  165. PROCEDURE (v: View) CopyFromModelView- (source: Views.View; model: Models.Model);
  166. VAR c: Controller;
  167. BEGIN
  168. WITH source: View DO
  169. v.InitModel(model(Model));
  170. IF source.controller # NIL THEN
  171. c := Stores.CopyOf(source.controller)(Controller)
  172. ELSE
  173. c := NIL
  174. END;
  175. IF source.alienCtrl # NIL THEN v.alienCtrl := Stores.CopyOf(source.alienCtrl)(Stores.Alien) END;
  176. IF c # NIL THEN v.SetController(c) ELSE v.controller := NIL END
  177. END;
  178. v.CopyFromModelView2(source, model)
  179. END CopyFromModelView;
  180. PROCEDURE (v: View) ThisModel* (): Model, EXTENSIBLE;
  181. BEGIN
  182. RETURN v.model
  183. END ThisModel;
  184. PROCEDURE (v: View) SetController* (c: Controller), NEW;
  185. VAR op: ViewOp;
  186. BEGIN
  187. ASSERT(v.model # NIL, 20);
  188. IF v.controller # c THEN
  189. Stores.Join(v, c);
  190. NEW(op); op.v := v; op.controller := c; op.alienCtrl := NIL;
  191. Views.Do(v, "#System:ViewSetting", op)
  192. END
  193. END SetController;
  194. PROCEDURE (v: View) ThisController* (): Controller, NEW, EXTENSIBLE;
  195. BEGIN
  196. RETURN v.controller
  197. END ThisController;
  198. PROCEDURE (v: View) GetRect* (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER), NEW, ABSTRACT;
  199. PROCEDURE (v: View) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER);
  200. BEGIN
  201. IF v.controller # NIL THEN v.controller.RestoreMarks(f, l, t, r, b) END
  202. END RestoreMarks;
  203. PROCEDURE (v: View) Neutralize*;
  204. BEGIN
  205. IF v.controller # NIL THEN v.controller.Neutralize END
  206. END Neutralize;
  207. PROCEDURE (v: View) ConsiderFocusRequestBy- (view: Views.View);
  208. BEGIN
  209. IF v.controller # NIL THEN v.controller.ConsiderFocusRequestBy(view) END
  210. END ConsiderFocusRequestBy;
  211. PROCEDURE (v: View) HandleModelMsg2- (VAR msg: Models.Message), NEW, EMPTY;
  212. PROCEDURE (v: View) HandleViewMsg2- (f: Views.Frame; VAR msg: Views.Message), NEW, EMPTY;
  213. PROCEDURE (v: View) HandlePropMsg2- (VAR p: Properties.Message), NEW, EMPTY;
  214. PROCEDURE (v: View) HandleCtrlMsg2- (f: Views.Frame; VAR msg: Controllers.Message;
  215. VAR focus: Views.View), NEW, EMPTY;
  216. PROCEDURE (v: View) HandleModelMsg- (VAR msg: Models.Message);
  217. BEGIN
  218. v.HandleModelMsg2(msg);
  219. IF v.controller # NIL THEN v.controller.HandleModelMsg(msg) END
  220. END HandleModelMsg;
  221. PROCEDURE (v: View) HandleViewMsg- (f: Views.Frame; VAR msg: Views.Message);
  222. BEGIN
  223. v.HandleViewMsg2(f, msg);
  224. IF v.controller # NIL THEN v.controller.HandleViewMsg(f, msg) END
  225. END HandleViewMsg;
  226. PROCEDURE (v: View) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
  227. BEGIN
  228. IF v.controller # NIL THEN v.controller.HandleCtrlMsg(f, msg, focus) END;
  229. v.HandleCtrlMsg2(f, msg, focus);
  230. WITH msg: Controllers.PollSectionMsg DO
  231. IF ~msg.focus THEN focus := NIL END
  232. | msg: Controllers.ScrollMsg DO
  233. IF ~msg.focus THEN focus := NIL END
  234. ELSE
  235. END
  236. END HandleCtrlMsg;
  237. PROCEDURE (v: View) HandlePropMsg- (VAR p: Properties.Message);
  238. BEGIN
  239. v.HandlePropMsg2(p);
  240. IF v.controller # NIL THEN v.controller.HandlePropMsg(p) END
  241. END HandlePropMsg ;
  242. (** Controller **)
  243. PROCEDURE (c: Controller) Externalize2- (VAR rd: Stores.Writer), NEW, EMPTY;
  244. PROCEDURE(c: Controller) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
  245. PROCEDURE (c: Controller) Internalize- (VAR rd: Stores.Reader);
  246. VAR v: INTEGER;
  247. BEGIN
  248. c.Internalize^(rd);
  249. IF rd.cancelled THEN RETURN END;
  250. rd.ReadVersion(minVersion, maxCtrlVersion, v);
  251. IF rd.cancelled THEN RETURN END;
  252. rd.ReadSet(c.opts);
  253. c.Internalize2(rd)
  254. END Internalize;
  255. PROCEDURE (c: Controller) Externalize- (VAR wr: Stores.Writer);
  256. BEGIN
  257. c.Externalize^(wr);
  258. wr.WriteVersion(maxCtrlVersion);
  259. wr.WriteSet(c.opts);
  260. c.Externalize2(wr)
  261. END Externalize;
  262. PROCEDURE (c: Controller) CopyFrom- (source: Stores.Store), EXTENSIBLE;
  263. BEGIN
  264. WITH source: Controller DO
  265. c.opts := source.opts;
  266. c.focus := NIL; c.singleton := NIL;
  267. c.bVis := FALSE
  268. END
  269. END CopyFrom;
  270. PROCEDURE (c: Controller) InitView* (v: Views.View), NEW;
  271. VAR view: View; model: Model;
  272. BEGIN
  273. ASSERT((v = NIL) # (c.view = NIL) OR (v = c.view), 21);
  274. IF c.view = NIL THEN
  275. ASSERT(v IS View, 22); (* subclass may assert narrower type *)
  276. view := v(View);
  277. model := view.ThisModel(); ASSERT(model # NIL, 24);
  278. c.view := view; c.model := model;
  279. Stores.Join(c, c.view)
  280. ELSE
  281. c.view.Neutralize; c.view := NIL; c.model := NIL
  282. END;
  283. c.focus := NIL; c.singleton := NIL; c.bVis := FALSE;
  284. c.InitView2(v)
  285. END InitView;
  286. PROCEDURE (c: Controller) ThisView* (): View, NEW, EXTENSIBLE;
  287. BEGIN
  288. RETURN c.view
  289. END ThisView;
  290. (** options **)
  291. PROCEDURE (c: Controller) SetOpts* (opts: SET), NEW, EXTENSIBLE;
  292. VAR op: ControllerOp;
  293. BEGIN
  294. IF c.view # NIL THEN
  295. NEW(op); op.c := c; op.opts := opts;
  296. Views.Do(c.view, "#System:ChangeOptions", op)
  297. ELSE
  298. c.opts := opts
  299. END
  300. END SetOpts;
  301. (** subclass hooks **)
  302. PROCEDURE (c: Controller) GetContextType* (OUT type: Stores.TypeName), NEW, ABSTRACT;
  303. PROCEDURE (c: Controller) GetValidOps* (OUT valid: SET), NEW, ABSTRACT;
  304. PROCEDURE (c: Controller) NativeModel* (m: Models.Model): BOOLEAN, NEW, ABSTRACT;
  305. PROCEDURE (c: Controller) NativeView* (v: Views.View): BOOLEAN, NEW, ABSTRACT;
  306. PROCEDURE (c: Controller) NativeCursorAt* (f: Views.Frame; x, y: INTEGER): INTEGER, NEW, ABSTRACT;
  307. PROCEDURE (c: Controller) PickNativeProp* (f: Views.Frame; x, y: INTEGER; VAR p: Properties.Property), NEW, EMPTY;
  308. PROCEDURE (c: Controller) PollNativeProp* (selection: BOOLEAN; VAR p: Properties.Property; VAR truncated: BOOLEAN), NEW, EMPTY;
  309. PROCEDURE (c: Controller) SetNativeProp* (selection: BOOLEAN; old, p: Properties.Property), NEW, EMPTY;
  310. PROCEDURE (c: Controller) MakeViewVisible* (v: Views.View), NEW, EMPTY;
  311. PROCEDURE (c: Controller) GetFirstView* (selection: BOOLEAN; OUT v: Views.View), NEW, ABSTRACT;
  312. PROCEDURE (c: Controller) GetNextView* (selection: BOOLEAN; VAR v: Views.View), NEW, ABSTRACT;
  313. PROCEDURE (c: Controller) GetPrevView* (selection: BOOLEAN; VAR v: Views.View), NEW, EXTENSIBLE;
  314. VAR p, q: Views.View;
  315. BEGIN
  316. ASSERT(v # NIL, 20);
  317. c.GetFirstView(selection, p);
  318. IF p # v THEN
  319. WHILE (p # NIL) & (p # v) DO q := p; c.GetNextView(selection, p) END;
  320. ASSERT(p # NIL, 21);
  321. v := q
  322. ELSE
  323. v := NIL
  324. END
  325. END GetPrevView;
  326. PROCEDURE (c: Controller) CanDrop* (f: Views.Frame; x, y: INTEGER): BOOLEAN, NEW, EXTENSIBLE;
  327. BEGIN
  328. RETURN TRUE
  329. END CanDrop;
  330. PROCEDURE (c: Controller) GetSelectionBounds* (f: Views.Frame; OUT x, y, w, h: INTEGER), NEW, EXTENSIBLE;
  331. VAR g: Views.Frame; v: Views.View;
  332. BEGIN
  333. x := 0; y := 0; w := 0; h := 0;
  334. v := c.singleton;
  335. IF v # NIL THEN
  336. g := Views.ThisFrame(f, v);
  337. IF g # NIL THEN
  338. x := g.gx - f.gx; y := g.gy - f.gy;
  339. v.context.GetSize(w, h)
  340. END
  341. END
  342. END GetSelectionBounds;
  343. PROCEDURE (c: Controller) MarkDropTarget* (src, dst: Views.Frame;
  344. sx, sy, dx, dy, w, h, rx, ry: INTEGER;
  345. type: Stores.TypeName;
  346. isSingle, show: BOOLEAN), NEW, EMPTY;
  347. PROCEDURE (c: Controller) Drop* (src, dst: Views.Frame; sx, sy, dx, dy, w, h, rx, ry: INTEGER;
  348. view: Views.View; isSingle: BOOLEAN), NEW, ABSTRACT;
  349. PROCEDURE (c: Controller) MarkPickTarget* (src, dst: Views.Frame;
  350. sx, sy, dx, dy: INTEGER; show: BOOLEAN), NEW, EMPTY;
  351. PROCEDURE (c: Controller) TrackMarks* (f: Views.Frame; x, y: INTEGER; units, extend, add: BOOLEAN), NEW, ABSTRACT;
  352. PROCEDURE (c: Controller) Resize* (view: Views.View; l, t, r, b: INTEGER), NEW, ABSTRACT;
  353. PROCEDURE (c: Controller) DeleteSelection*, NEW, ABSTRACT;
  354. PROCEDURE (c: Controller) MoveLocalSelection* (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER), NEW, ABSTRACT;
  355. PROCEDURE (c: Controller) CopyLocalSelection* (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER), NEW, ABSTRACT;
  356. PROCEDURE (c: Controller) SelectionCopy* (): Model, NEW, ABSTRACT;
  357. PROCEDURE (c: Controller) NativePaste* (m: Models.Model; f: Views.Frame), NEW, ABSTRACT;
  358. PROCEDURE (c: Controller) ArrowChar* (f: Views.Frame; ch: CHAR; units, select: BOOLEAN), NEW, ABSTRACT;
  359. PROCEDURE (c: Controller) ControlChar* (f: Views.Frame; ch: CHAR), NEW, ABSTRACT;
  360. PROCEDURE (c: Controller) PasteChar* (ch: CHAR), NEW, ABSTRACT;
  361. PROCEDURE (c: Controller) PasteView* (f: Views.Frame; v: Views.View; w, h: INTEGER), NEW, ABSTRACT;
  362. (** selection **)
  363. PROCEDURE (c: Controller) HasSelection* (): BOOLEAN, NEW, EXTENSIBLE;
  364. (** extended by subclass to include intrinsic selections **)
  365. BEGIN
  366. ASSERT(c.model # NIL, 20);
  367. RETURN c.singleton # NIL
  368. END HasSelection;
  369. PROCEDURE (c: Controller) Selectable* (): BOOLEAN, NEW, ABSTRACT;
  370. PROCEDURE (c: Controller) Singleton* (): Views.View, NEW; (* LEAF *)
  371. BEGIN
  372. IF c = NIL THEN RETURN NIL
  373. ELSE RETURN c.singleton
  374. END
  375. END Singleton;
  376. PROCEDURE (c: Controller) SetSingleton* (s: Views.View), NEW, EXTENSIBLE;
  377. (** extended by subclass to adjust intrinsic selections **)
  378. VAR con: Models.Context; msg: SingletonMsg;
  379. BEGIN
  380. ASSERT(c.model # NIL, 20);
  381. ASSERT(~(noSelection IN c.opts), 21);
  382. IF c.singleton # s THEN
  383. IF s # NIL THEN
  384. con := s.context;
  385. ASSERT(con # NIL, 22); ASSERT(con.ThisModel() = c.model, 23);
  386. c.view.Neutralize
  387. ELSIF c.singleton # NIL THEN
  388. c.bVis := FALSE; msg.set := FALSE; Views.Broadcast(c.view, msg)
  389. END;
  390. c.singleton := s;
  391. IF s # NIL THEN c.bVis := TRUE; msg.set := TRUE; Views.Broadcast(c.view, msg) END
  392. END
  393. END SetSingleton;
  394. PROCEDURE (c: Controller) SelectAll* (select: BOOLEAN), NEW, ABSTRACT;
  395. (** replaced by subclass to include intrinsic selections **)
  396. PROCEDURE (c: Controller) InSelection* (f: Views.Frame; x, y: INTEGER): BOOLEAN, NEW, ABSTRACT;
  397. (** replaced by subclass to include intrinsic selections **)
  398. PROCEDURE (c: Controller) MarkSelection* (f: Views.Frame; show: BOOLEAN), NEW, EXTENSIBLE;
  399. (** replaced by subclass to include intrinsic selections **)
  400. BEGIN
  401. MarkSingleton(c, f, show)
  402. END MarkSelection;
  403. (** focus **)
  404. PROCEDURE (c: Controller) ThisFocus* (): Views.View, NEW, EXTENSIBLE;
  405. BEGIN
  406. ASSERT(c.model # NIL, 20);
  407. RETURN c.focus
  408. END ThisFocus;
  409. PROCEDURE (c: Controller) SetFocus* (focus: Views.View), NEW; (* LEAF *)
  410. VAR focus0: Views.View; con: Models.Context; msg: FocusMsg;
  411. BEGIN
  412. ASSERT(c.model # NIL, 20);
  413. focus0 := c.focus;
  414. IF focus # focus0 THEN
  415. IF focus # NIL THEN
  416. con := focus.context;
  417. ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.model, 22);
  418. IF focus0 = NIL THEN c.view.Neutralize END
  419. END;
  420. IF focus0 # NIL THEN
  421. IF ~Views.IsInvalid(focus0) THEN focus0.Neutralize END;
  422. c.bVis := FALSE; msg.set := FALSE; Views.Broadcast(c.view, msg)
  423. END;
  424. c.focus := focus;
  425. IF focus # NIL THEN
  426. c.MakeViewVisible(focus);
  427. c.bVis := TRUE; msg.set := TRUE; Views.Broadcast(c.view, msg)
  428. END
  429. END
  430. END SetFocus;
  431. PROCEDURE (c: Controller) ConsiderFocusRequestBy* (view: Views.View), NEW;
  432. VAR con: Models.Context;
  433. BEGIN
  434. ASSERT(c.model # NIL, 20);
  435. ASSERT(view # NIL, 21); con := view.context;
  436. ASSERT(con # NIL, 22); ASSERT(con.ThisModel() = c.model, 23);
  437. IF c.focus = NIL THEN c.SetFocus(view) END
  438. END ConsiderFocusRequestBy;
  439. (** caret **)
  440. PROCEDURE (c: Controller) HasCaret* (): BOOLEAN, NEW, ABSTRACT;
  441. PROCEDURE (c: Controller) MarkCaret* (f: Views.Frame; show: BOOLEAN), NEW, ABSTRACT;
  442. (** general marking protocol **)
  443. PROCEDURE CheckMaskFocus (c: Controller; f: Views.Frame; VAR focus: Views.View);
  444. VAR v: Views.View;
  445. BEGIN
  446. IF f.mark & (c.opts * modeOpts = mask) & (c.model # NIL) & ((focus = NIL) OR ~ClaimFocus(focus)) THEN
  447. c.GetFirstView(any, v);
  448. WHILE (v # NIL) & ~ClaimFocus(v) DO c.GetNextView(any, v) END;
  449. IF v # NIL THEN
  450. c.SetFocus(v);
  451. focus := v
  452. ELSE c.SetFocus(NIL); focus := NIL
  453. END
  454. END
  455. END CheckMaskFocus;
  456. PROCEDURE (c: Controller) Mark* (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN), NEW, EXTENSIBLE;
  457. BEGIN
  458. MarkFocus(c, f, show); c.MarkSelection(f, show); c.MarkCaret(f, show)
  459. END Mark;
  460. PROCEDURE (c: Controller) RestoreMarks2- (f: Views.Frame; l, t, r, b: INTEGER), NEW, EMPTY;
  461. PROCEDURE (c: Controller) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER), NEW;
  462. BEGIN
  463. IF f.mark THEN
  464. c.Mark(f, l, t, r, b, show);
  465. c.RestoreMarks2(f, l, t, r, b)
  466. END
  467. END RestoreMarks;
  468. PROCEDURE (c: Controller) Neutralize2-, NEW, EMPTY;
  469. (** caret needs to be removed by this method **)
  470. PROCEDURE (c: Controller) Neutralize*, NEW;
  471. BEGIN
  472. c.SetFocus(NIL); c.SelectAll(deselect);
  473. c.Neutralize2
  474. END Neutralize;
  475. (** message handlers **)
  476. PROCEDURE (c: Controller) HandleModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
  477. BEGIN
  478. ASSERT(c.model # NIL, 20)
  479. END HandleModelMsg;
  480. PROCEDURE (c: Controller) HandleViewMsg* (f: Views.Frame; VAR msg: Views.Message), NEW, EXTENSIBLE;
  481. VAR g: Views.Frame; mark: Controllers.MarkMsg;
  482. BEGIN
  483. ASSERT(c.model # NIL, 20);
  484. IF msg.view = c.view THEN
  485. WITH msg: ViewMessage DO
  486. WITH msg: FocusMsg DO
  487. g := Views.ThisFrame(f, c.focus);
  488. IF g # NIL THEN
  489. IF msg.set THEN
  490. MarkFocus(c, f, show);
  491. mark.show := TRUE; mark.focus := TRUE;
  492. Views.ForwardCtrlMsg(g, mark)
  493. ELSE
  494. mark.show := FALSE; mark.focus := TRUE;
  495. Views.ForwardCtrlMsg(g, mark);
  496. MarkFocus(c, f, hide)
  497. END
  498. END
  499. | msg: SingletonMsg DO
  500. MarkSingleton(c, f, msg.set)
  501. | msg: FadeMsg DO
  502. MarkFocus(c, f, msg.show);
  503. MarkSingleton(c, f, msg.show)
  504. END
  505. ELSE
  506. END
  507. END
  508. END HandleViewMsg;
  509. PROCEDURE CollectControlPref (c: Controller; focus: Views.View; ch: CHAR; cyclic: BOOLEAN;
  510. VAR v: Views.View; VAR getFocus, accepts: BOOLEAN);
  511. VAR first, w: Views.View; p: Properties.ControlPref; back: BOOLEAN;
  512. BEGIN
  513. back := (ch = LTAB) OR (ch = AL) OR (ch = AU); first := c.focus;
  514. IF first = NIL THEN
  515. c.GetFirstView(any, first);
  516. IF back THEN w := first;
  517. WHILE w # NIL DO first := w; c.GetNextView(any, w) END
  518. END
  519. END;
  520. v := first;
  521. WHILE v # NIL DO
  522. p.char := ch; p.focus := focus;
  523. p.getFocus := (v # focus) & ((ch = TAB) OR (ch = LTAB)) & ClaimFocus(v);
  524. p.accepts := (v = focus) & (ch # TAB) & (ch # LTAB);
  525. Views.HandlePropMsg(v, p);
  526. IF p.accepts OR (v # focus) & p.getFocus THEN
  527. getFocus := p.getFocus; accepts := p.accepts;
  528. RETURN
  529. END;
  530. IF back THEN c.GetPrevView(any, v) ELSE c.GetNextView(any, v) END;
  531. IF cyclic & (v = NIL) THEN
  532. c.GetFirstView(any, v);
  533. IF back THEN w := v;
  534. WHILE w # NIL DO v := w; c.GetNextView(any, w) END
  535. END
  536. END;
  537. IF v = first THEN v := NIL END
  538. END;
  539. getFocus := FALSE; accepts := FALSE
  540. END CollectControlPref;
  541. PROCEDURE (c: Controller) HandlePropMsg* (VAR msg: Properties.Message), NEW, EXTENSIBLE;
  542. VAR v: Views.View;
  543. BEGIN
  544. ASSERT(c.model # NIL, 20);
  545. WITH msg: Properties.PollMsg DO
  546. msg.prop := ThisProp(c, indirect)
  547. | msg: Properties.SetMsg DO
  548. SetProp(c, msg.old, msg.prop, indirect)
  549. | msg: Properties.FocusPref DO
  550. IF {noSelection, noFocus, noCaret} - c.opts # {} THEN msg.setFocus := TRUE END
  551. | msg: GetOpts DO
  552. msg.valid := modeOpts; msg.opts := c.opts
  553. | msg: SetOpts DO
  554. c.SetOpts(c.opts - msg.valid + (msg.opts * msg.valid))
  555. | msg: Properties.ControlPref DO
  556. IF c.opts * modeOpts = mask THEN
  557. v := msg.focus;
  558. IF v = c.view THEN v := c.focus END;
  559. CollectControlPref(c, v, msg.char, FALSE, v, msg.getFocus, msg.accepts);
  560. IF msg.getFocus THEN msg.accepts := TRUE END
  561. END
  562. ELSE
  563. END
  564. END HandlePropMsg;
  565. (** Directory **)
  566. PROCEDURE (d: Directory) NewController* (opts: SET): Controller, NEW, ABSTRACT;
  567. PROCEDURE (d: Directory) New* (): Controller, NEW, EXTENSIBLE;
  568. BEGIN
  569. RETURN d.NewController({})
  570. END New;
  571. (* ViewOp *)
  572. PROCEDURE (op: ViewOp) Do;
  573. VAR v: View; c0, c1: Controller; a0, a1: Stores.Store;
  574. BEGIN
  575. v := op.v; c0 := v.controller; a0 := v.alienCtrl; c1 := op.controller; a1 := op.alienCtrl;
  576. IF c0 # NIL THEN c0.InitView(NIL) END;
  577. v.controller := c1; v.alienCtrl := a1;
  578. op.controller := c0; op.alienCtrl := a0;
  579. IF c1 # NIL THEN c1.InitView(v) END;
  580. Views.Update(v, Views.keepFrames)
  581. END Do;
  582. (* ControllerOp *)
  583. PROCEDURE (op: ControllerOp) Do;
  584. VAR c: Controller; opts: SET;
  585. BEGIN
  586. c := op.c;
  587. opts := c.opts; c.opts := op.opts; op.opts := opts;
  588. Views.Update(c.view, Views.keepFrames)
  589. END Do;
  590. (* Controller implementation support *)
  591. PROCEDURE BorderVisible (c: Controller; f: Views.Frame): BOOLEAN;
  592. BEGIN
  593. IF 31 IN c.opts THEN RETURN TRUE END;
  594. IF f IS Views.RootFrame THEN RETURN FALSE END;
  595. IF Services.Is(c.focus, "OleClient.View") THEN RETURN FALSE END;
  596. RETURN TRUE
  597. END BorderVisible;
  598. PROCEDURE MarkFocus (c: Controller; f: Views.Frame; show: BOOLEAN);
  599. VAR focus: Views.View; f1: Views.Frame; l, t, r, b: INTEGER;
  600. BEGIN
  601. focus := c.focus;
  602. IF f.front & (focus # NIL) & (~show OR c.bVis) & BorderVisible(c, f) & ~(noSelection IN c.opts) THEN
  603. f1 := Views.ThisFrame(f, focus);
  604. IF f1 # NIL THEN
  605. c.bVis := show;
  606. c.view.GetRect(f, focus, l, t, r, b);
  607. IF (l # MAX(INTEGER)) & (t # MAX(INTEGER)) THEN
  608. Mechanisms.MarkFocusBorder(f, focus, l, t, r, b, show)
  609. END
  610. END
  611. END
  612. END MarkFocus;
  613. PROCEDURE MarkSingleton* (c: Controller; f: Views.Frame; show: BOOLEAN);
  614. VAR l, t, r, b: INTEGER;
  615. BEGIN
  616. IF (*(f.front OR f.target) &*) (~show OR c.bVis) & (c.singleton # NIL) THEN
  617. c.bVis := show;
  618. c.view.GetRect(f, c.singleton, l, t, r, b);
  619. IF (l # MAX(INTEGER)) & (t # MAX(INTEGER)) THEN
  620. Mechanisms.MarkSingletonBorder(f, c.singleton, l, t, r, b, show)
  621. END
  622. END
  623. END MarkSingleton;
  624. PROCEDURE FadeMarks* (c: Controller; show: BOOLEAN);
  625. VAR msg: FadeMsg; v: Views.View; fc: Controller;
  626. BEGIN
  627. IF (c.focus # NIL) OR (c.singleton # NIL) THEN
  628. IF c.bVis # show THEN
  629. IF ~show THEN
  630. v := c.focus;
  631. WHILE (v # NIL) & (v IS View) DO
  632. fc := v(View).ThisController();
  633. fc.bVis := FALSE; v := fc.focus
  634. END
  635. END;
  636. c.bVis := show; msg.show := show; Views.Broadcast(c.view, msg)
  637. END
  638. END
  639. END FadeMarks;
  640. (* handle controller messages in editor mode *)
  641. PROCEDURE ClaimFocus (v: Views.View): BOOLEAN;
  642. VAR p: Properties.FocusPref;
  643. BEGIN
  644. p.atLocation := FALSE;
  645. p.hotFocus := FALSE; p.setFocus := FALSE;
  646. Views.HandlePropMsg(v, p);
  647. RETURN p.setFocus
  648. END ClaimFocus;
  649. PROCEDURE ClaimFocusAt (v: Views.View; f, g: Views.Frame; x, y: INTEGER; mask: BOOLEAN): BOOLEAN;
  650. VAR p: Properties.FocusPref;
  651. BEGIN
  652. p.atLocation := TRUE; p.x := x + f.gx - g.gx; p.y := y + f.gy - g.gy;
  653. p.hotFocus := FALSE; p.setFocus := FALSE;
  654. Views.HandlePropMsg(v, p);
  655. RETURN p.setFocus & (mask OR ~p.hotFocus)
  656. END ClaimFocusAt;
  657. PROCEDURE NeedFocusAt (v: Views.View; f, g: Views.Frame; x, y: INTEGER): BOOLEAN;
  658. VAR p: Properties.FocusPref;
  659. BEGIN
  660. p.atLocation := TRUE; p.x := x + f.gx - g.gx; p.y := y + f.gy - g.gy;
  661. p.hotFocus := FALSE; p.setFocus := FALSE;
  662. Views.HandlePropMsg(v, p);
  663. RETURN p.hotFocus OR p.setFocus
  664. END NeedFocusAt;
  665. PROCEDURE TrackToResize (c: Controller; f: Views.Frame; v: Views.View; x, y: INTEGER; buttons: SET);
  666. VAR minW, maxW, minH, maxH, l, t, r, b, w0, h0, w, h: INTEGER; op: INTEGER; sg, fc: Views.View;
  667. BEGIN
  668. c.model.GetEmbeddingLimits(minW, maxW, minH, maxH);
  669. c.view.GetRect(f, v, l, t, r, b);
  670. w0 := r - l; h0 := b - t; w := w0; h := h0;
  671. Mechanisms.TrackToResize(f, v, minW, maxW, minH, maxH, l, t, r, b, op, x, y, buttons);
  672. IF op = Mechanisms.resize THEN
  673. sg := c.singleton; fc := c.focus;
  674. c.Resize(v, l, t, r, b);
  675. IF c.singleton # sg THEN c.SetSingleton(sg) END;
  676. IF c.focus # fc THEN c.focus := fc; c.bVis := FALSE END (* delayed c.SetFocus(fc) *)
  677. END
  678. END TrackToResize;
  679. PROCEDURE TrackToDrop (c: Controller; f: Views.Frame; VAR x, y: INTEGER; buttons: SET;
  680. VAR pass: BOOLEAN);
  681. VAR dest: Views.Frame; m: Models.Model; v: Views.View;
  682. x0, y0, x1, y1, w, h, rx, ry, destX, destY: INTEGER; op: INTEGER; isDown, isSingle: BOOLEAN; mo: SET;
  683. BEGIN (* drag and drop c's selection: mouse is in selection *)
  684. x0 := x; y0 := y;
  685. REPEAT
  686. f.Input(x1, y1, mo, isDown)
  687. UNTIL ~isDown OR (ABS(x1 - x) > 3 * Ports.point) OR (ABS(y1 - y) > 3 * Ports.point);
  688. pass := ~isDown;
  689. IF ~pass THEN
  690. v := c.Singleton();
  691. IF v = NIL THEN v := c.view; isSingle := FALSE
  692. ELSE isSingle := TRUE
  693. END;
  694. c.GetSelectionBounds(f, rx, ry, w, h);
  695. rx := x0 - rx; ry := y0 - ry;
  696. IF rx < 0 THEN rx := 0 ELSIF rx > w THEN rx := w END;
  697. IF ry < 0 THEN ry := 0 ELSIF ry > h THEN ry := h END;
  698. IF noCaret IN c.opts THEN op := Mechanisms.copy ELSE op := 0 END;
  699. Mechanisms.TrackToDrop(f, v, isSingle, w, h, rx, ry, dest, destX, destY, op, x, y, buttons);
  700. IF (op IN {Mechanisms.copy, Mechanisms.move}) THEN (* copy or move selection *)
  701. IF dest # NIL THEN
  702. m := dest.view.ThisModel();
  703. IF (dest.view = c.view) OR (m # NIL) & (m = c.view.ThisModel()) THEN (* local drop *)
  704. IF op = Mechanisms.copy THEN (* local copy *)
  705. c.CopyLocalSelection(f, dest, x0, y0, destX, destY)
  706. ELSIF op = Mechanisms.move THEN (* local move *)
  707. c.MoveLocalSelection(f, dest, x0, y0, destX, destY)
  708. END
  709. ELSE (* non-local drop *)
  710. CopyView(c, v, w, h); (* create copy of selection *)
  711. IF (op = Mechanisms.copy) OR (noCaret IN c.opts) THEN (* drop copy *)
  712. Controllers.Drop(x, y, f, x0, y0, v, isSingle, w, h, rx, ry)
  713. ELSIF op = Mechanisms.move THEN (* drop copy and delete original *)
  714. Controllers.Drop(x, y, f, x0, y0, v, isSingle, w, h, rx, ry);
  715. c.DeleteSelection;
  716. END
  717. END
  718. ELSIF (op = Mechanisms.move) & ~(noCaret IN c.opts) THEN
  719. c.DeleteSelection
  720. END
  721. END
  722. END
  723. END TrackToDrop;
  724. PROCEDURE TrackToPick (c: Controller; f: Views.Frame; x, y: INTEGER; buttons: SET;
  725. VAR pass: BOOLEAN);
  726. VAR p: Properties.Property; dest: Views.Frame; x0, y0, x1, y1, destX, destY: INTEGER;
  727. op: INTEGER; isDown: BOOLEAN; m: SET;
  728. BEGIN
  729. x0 := x; y0 := y;
  730. REPEAT
  731. f.Input(x1, y1, m, isDown)
  732. UNTIL ~isDown OR (ABS(x1 - x) > 3 * Ports.point) OR (ABS(y1 - y) > 3 * Ports.point);
  733. pass := ~isDown;
  734. IF ~pass THEN
  735. Mechanisms.TrackToPick(f, dest, destX, destY, op, x, y, buttons);
  736. IF op IN {Mechanisms.pick, Mechanisms.pickForeign} THEN
  737. Properties.Pick(x, y, f, x0, y0, p);
  738. IF p # NIL THEN SetProp(c, NIL, p, direct) END
  739. END
  740. END
  741. END TrackToPick;
  742. PROCEDURE MarkViews (f: Views.Frame);
  743. VAR x, y: INTEGER; isDown: BOOLEAN; root: Views.RootFrame; m: SET;
  744. BEGIN
  745. root := Views.RootOf(f);
  746. Views.MarkBorders(root);
  747. REPEAT f.Input(x, y, m, isDown) UNTIL ~isDown;
  748. Views.MarkBorders(root)
  749. END MarkViews;
  750. PROCEDURE Track (c: Controller; f: Views.Frame; VAR msg: Controllers.TrackMsg; VAR focus: Views.View);
  751. VAR res, l, t, r, b: INTEGER; cursor: INTEGER; sel: Views.View; obj: Views.Frame;
  752. inSel, pass, extend, add, double, popup: BOOLEAN;
  753. BEGIN
  754. cursor := Mechanisms.outside; sel := c.Singleton();
  755. IF focus # NIL THEN
  756. c.view.GetRect(f, focus, l, t, r, b);
  757. IF (BorderVisible(c, f) OR (f IS Views.RootFrame)) & ~(noSelection IN c.opts) THEN
  758. cursor := Mechanisms.FocusBorderCursor(f, focus, l, t, r, b, msg.x, msg.y)
  759. ELSIF (msg.x >= l) & (msg.x <= r) & (msg.y >= t) & (msg.y <= b) THEN
  760. cursor := Mechanisms.inside
  761. END
  762. ELSIF sel # NIL THEN
  763. c.view.GetRect(f, sel, l, t, r, b);
  764. cursor := Mechanisms.SelBorderCursor(f, sel, l, t, r, b, msg.x, msg.y)
  765. END;
  766. IF cursor >= 0 THEN
  767. IF focus # NIL THEN
  768. (* resize focus *)
  769. TrackToResize(c, f, focus, msg.x, msg.y, msg.modifiers);
  770. focus := NIL
  771. ELSE
  772. (* resize singleton *)
  773. TrackToResize(c, f, sel, msg.x, msg.y, msg.modifiers)
  774. END
  775. ELSIF (focus # NIL) & (cursor = Mechanisms.inside) THEN
  776. (* forward to focus *)
  777. ELSE
  778. IF (focus # NIL) & (c.opts * modeOpts # mask) THEN c.SetFocus(NIL) END;
  779. focus := NIL;
  780. inSel := c.InSelection(f, msg.x, msg.y);
  781. extend := Controllers.extend IN msg.modifiers;
  782. add := Controllers.modify IN msg.modifiers;
  783. double := Controllers.doubleClick IN msg.modifiers;
  784. popup := right IN msg.modifiers;
  785. obj := Views.FrameAt(f, msg.x, msg.y);
  786. IF ~inSel & (~extend OR (noSelection IN c.opts)) THEN
  787. IF obj # NIL THEN
  788. IF ~(noFocus IN c.opts) & NeedFocusAt(obj.view, f, obj, msg.x, msg.y)
  789. & (~(alt IN msg.modifiers) OR (noSelection IN c.opts)) THEN
  790. (* set hot focus *)
  791. focus := obj.view;
  792. IF ClaimFocusAt(focus, f, obj, msg.x, msg.y, c.opts * modeOpts = mask) THEN
  793. (* set permanent focus *)
  794. c.SelectAll(deselect);
  795. c.SetFocus(focus)
  796. END
  797. END;
  798. IF (focus = NIL) & ~add & ~(noSelection IN c.opts) THEN
  799. (* select object *)
  800. c.SelectAll(deselect);
  801. c.SetSingleton(obj.view); inSel := TRUE
  802. END
  803. ELSIF ~add THEN c.SelectAll(deselect)
  804. END
  805. END;
  806. IF focus = NIL THEN
  807. IF inSel & double & (popup OR (alt IN msg.modifiers)) THEN (* properties *)
  808. Dialog.Call("StdCmds.ShowProp", "", res)
  809. ELSIF inSel & double & (obj # NIL) THEN (* primary verb *)
  810. Dialog.Call("HostMenus.PrimaryVerb", "", res)
  811. ELSIF ~inSel & (alt IN msg.modifiers) & extend THEN
  812. MarkViews(f)
  813. ELSE
  814. IF inSel & ~extend THEN (* drag *)
  815. IF (alt IN msg.modifiers) OR (middle IN msg.modifiers) THEN
  816. IF ~(noCaret IN c.opts) THEN
  817. TrackToPick(c, f, msg.x, msg.y, msg.modifiers, pass)
  818. END
  819. ELSE
  820. TrackToDrop(c, f, msg.x, msg.y, msg.modifiers, pass)
  821. END;
  822. IF ~pass THEN RETURN END
  823. END;
  824. IF ~(noSelection IN c.opts) & (~inSel OR extend OR add OR (obj = NIL) & ~popup) THEN (* select *)
  825. c.TrackMarks(f, msg.x, msg.y, double, extend, add)
  826. END;
  827. IF popup THEN Dialog.Call("HostMenus.PopupMenu", "", res) END
  828. END
  829. END
  830. END
  831. END Track;
  832. PROCEDURE CopyView (source: Controller; VAR view: Views.View; VAR w, h: INTEGER);
  833. VAR s: Views.View; m: Model; v: View; p: Properties.BoundsPref;
  834. BEGIN
  835. s := source.Singleton();
  836. IF s # NIL THEN (* create a copy of singular selection *)
  837. view := Views.CopyOf(s, Views.deep); s.context.GetSize(w, h)
  838. ELSE (* create a copy of view with a copy of whole selection as contents *)
  839. m := source.SelectionCopy();
  840. v := Views.CopyWithNewModel(source.view, m)(View);
  841. p.w := Views.undefined; p.h := Views.undefined; Views.HandlePropMsg(v, p);
  842. view := v; w := p.w; h := p.h
  843. END
  844. END CopyView;
  845. PROCEDURE Paste (c: Controller; f: Views.Frame; v: Views.View; w, h: INTEGER);
  846. VAR m: Models.Model;
  847. BEGIN
  848. m := v.ThisModel();
  849. IF (m # NIL) & c.NativeModel(m) THEN
  850. (* paste whole contents of source view *)
  851. c.NativePaste(m, f)
  852. ELSE
  853. (* paste whole view *)
  854. c.PasteView(f, v (* Views.CopyOf(v, Views.deep) *), w, h)
  855. END
  856. END Paste;
  857. PROCEDURE GetValidOps (c: Controller; VAR valid: SET);
  858. BEGIN
  859. valid := {}; c.GetValidOps(valid);
  860. IF noCaret IN c.opts THEN
  861. valid := valid
  862. - {Controllers.pasteChar, Controllers.pasteChar,
  863. Controllers.paste, Controllers.cut}
  864. END
  865. END GetValidOps;
  866. PROCEDURE Transfer (c: Controller; f: Views.Frame;
  867. VAR msg: Controllers.TransferMessage; VAR focus: Views.View);
  868. VAR g: Views.Frame; inSelection: BOOLEAN; dMsg: DropPref;
  869. BEGIN
  870. focus := NIL;
  871. g := Views.FrameAt(f, msg.x, msg.y);
  872. WITH msg: Controllers.PollDropMsg DO
  873. inSelection := c.InSelection(f, msg.x, msg.y);
  874. dMsg.mode := c.opts; dMsg.okToDrop := FALSE;
  875. IF g # NIL THEN Views.HandlePropMsg(g.view, dMsg) END;
  876. IF (g # NIL) & ~inSelection & (dMsg.okToDrop OR ~(noFocus IN c.opts))THEN
  877. focus := g.view
  878. ELSIF ~(noCaret IN c.opts) & c.CanDrop(f, msg.x, msg.y) THEN
  879. msg.dest := f;
  880. IF msg.mark THEN
  881. c.MarkDropTarget(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.w, msg.h, msg.rx, msg.ry,
  882. msg.type, msg.isSingle, msg.show)
  883. END
  884. END
  885. | msg: Controllers.DropMsg DO
  886. inSelection := c.InSelection(f, msg.x, msg.y);
  887. dMsg.mode := c.opts; dMsg.okToDrop := FALSE;
  888. IF g # NIL THEN Views.HandlePropMsg(g.view, dMsg) END;
  889. IF (g # NIL) & ~inSelection & (dMsg.okToDrop OR ~(noFocus IN c.opts))THEN
  890. focus := g.view
  891. ELSIF ~(noCaret IN c.opts) & c.CanDrop(f, msg.x, msg.y) THEN
  892. c.Drop(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.w, msg.h,
  893. msg.rx, msg.ry, msg.view, msg.isSingle)
  894. END
  895. | msg: Properties.PollPickMsg DO
  896. IF g # NIL THEN
  897. focus := g.view
  898. ELSE
  899. msg.dest := f;
  900. IF msg.mark THEN
  901. c.MarkPickTarget(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.show)
  902. END
  903. END
  904. | msg: Properties.PickMsg DO
  905. IF g # NIL THEN
  906. focus := g.view
  907. ELSE
  908. c.PickNativeProp(f, msg.x, msg.y, msg.prop)
  909. END
  910. ELSE
  911. IF g # NIL THEN focus := g.view END
  912. END
  913. END Transfer;
  914. PROCEDURE FocusHasSel (): BOOLEAN;
  915. VAR msg: Controllers.PollOpsMsg;
  916. BEGIN
  917. Controllers.PollOps(msg);
  918. RETURN msg.selectable & (Controllers.copy IN msg.valid)
  919. END FocusHasSel;
  920. PROCEDURE FocusEditor (): Controller;
  921. VAR msg: PollFocusMsg;
  922. BEGIN
  923. msg.focus := NIL; msg.ctrl := NIL; msg.all := FALSE;
  924. Controllers.Forward(msg);
  925. RETURN msg.ctrl
  926. END FocusEditor;
  927. PROCEDURE Edit (c: Controller; f: Views.Frame;
  928. VAR msg: Controllers.EditMsg; VAR focus: Views.View);
  929. VAR g: Views.Frame; v: Views.View; res: INTEGER;
  930. valid: SET; select, units, getFocus, accepts: BOOLEAN;
  931. sel: Controllers.SelectMsg;
  932. BEGIN
  933. IF (c.opts * modeOpts # mask) & (focus = NIL) THEN
  934. IF (msg.op = Controllers.pasteChar) & (msg.char = ESC) THEN
  935. c.SelectAll(FALSE)
  936. ELSIF (c.Singleton() # NIL) & (msg.op = Controllers.pasteChar) &
  937. (msg.char = ENTER) THEN
  938. Dialog.Call("HostMenus.PrimaryVerb", "", res)
  939. ELSE
  940. GetValidOps(c, valid);
  941. IF msg.op IN valid THEN
  942. CASE msg.op OF
  943. | Controllers.pasteChar:
  944. IF msg.char >= " " THEN
  945. c.PasteChar(msg.char)
  946. ELSIF (AL <= msg.char) & (msg.char <= AD) OR
  947. (PL <= msg.char) & (msg.char <= DD) THEN
  948. select := Controllers.extend IN msg.modifiers;
  949. units := Controllers.modify IN msg.modifiers;
  950. c.ArrowChar(f, msg.char, units, select)
  951. ELSE c.ControlChar(f, msg.char)
  952. END
  953. | Controllers.cut, Controllers.copy:
  954. CopyView(c, msg.view, msg.w, msg.h);
  955. msg.isSingle := c.Singleton() # NIL;
  956. IF msg.op = Controllers.cut THEN c.DeleteSelection END
  957. | Controllers.paste:
  958. IF msg.isSingle THEN
  959. c.PasteView(f, msg.view (* Views.CopyOf(msg.view, Views.deep) *), msg.w, msg.h)
  960. ELSE
  961. Paste(c, f, msg.view, msg.w, msg.h)
  962. END
  963. ELSE
  964. END
  965. END
  966. END
  967. ELSIF (c.opts * modeOpts # mask)
  968. & (msg.op = Controllers.pasteChar) & (msg.char = ESC)
  969. & (~(f IS Views.RootFrame) OR (31 IN c.opts))
  970. & (c = FocusEditor())
  971. & ((Controllers.extend IN msg.modifiers) OR ~FocusHasSel()) THEN
  972. IF 31 IN c.opts THEN INCL(msg.modifiers, 31)
  973. ELSE c.SetSingleton(focus)
  974. END;
  975. focus := NIL
  976. ELSIF (c.opts * modeOpts # mask) & (c = Focus()) THEN
  977. (* do some generic processing for non-container views *)
  978. IF (msg.op = Controllers.pasteChar) & (msg.char = ESC) THEN
  979. g := Views.ThisFrame(f, focus);
  980. IF g # NIL THEN sel.set := FALSE; Views.ForwardCtrlMsg(g, sel) END
  981. END
  982. ELSIF (c.opts * modeOpts = mask) & (msg.op = Controllers.pasteChar) THEN
  983. IF alt IN msg.modifiers THEN
  984. CollectControlPref (c, NIL, msg.char, TRUE, v, getFocus, accepts)
  985. ELSE
  986. CollectControlPref (c, focus, msg.char, TRUE, v, getFocus, accepts)
  987. END;
  988. IF v = NIL THEN
  989. CheckMaskFocus(c, f, focus);
  990. CollectControlPref(c, focus, msg.char, TRUE, v, getFocus, accepts)
  991. END;
  992. IF v # NIL THEN
  993. IF getFocus & (v # focus) THEN
  994. c.SetFocus(v)
  995. END;
  996. IF accepts THEN
  997. g := Views.ThisFrame(f, v);
  998. IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END
  999. END;
  1000. focus := NIL
  1001. END
  1002. END
  1003. END Edit;
  1004. PROCEDURE PollCursor (c: Controller; f: Views.Frame; VAR msg: Controllers.PollCursorMsg; VAR focus: Views.View);
  1005. VAR l, t, r, b: INTEGER; cursor: INTEGER; sel: Views.View; obj: Views.Frame; inSel: BOOLEAN;
  1006. BEGIN
  1007. cursor := Mechanisms.outside; sel := c.Singleton();
  1008. IF focus # NIL THEN
  1009. c.view.GetRect(f, focus, l, t, r, b);
  1010. IF (BorderVisible(c, f) OR (f IS Views.RootFrame)) & ~(noSelection IN c.opts) THEN
  1011. cursor := Mechanisms.FocusBorderCursor(f, focus, l, t, r, b, msg.x, msg.y)
  1012. ELSIF (msg.x >= l) & (msg.x <= r) & (msg.y >= t) & (msg.y <= b) THEN
  1013. cursor := Mechanisms.inside
  1014. END
  1015. ELSIF sel # NIL THEN
  1016. c.view.GetRect(f, sel, l, t, r, b);
  1017. cursor := Mechanisms.SelBorderCursor(f, sel, l, t, r, b, msg.x, msg.y)
  1018. END;
  1019. IF cursor >= 0 THEN
  1020. msg.cursor := cursor; focus := NIL
  1021. ELSIF (focus # NIL) & (cursor = Mechanisms.inside) THEN
  1022. msg.cursor := Ports.arrowCursor
  1023. ELSE
  1024. IF noCaret IN c.opts THEN msg.cursor := Ports.arrowCursor
  1025. ELSE msg.cursor := c.NativeCursorAt(f, msg.x, msg.y) (* if nothing else, use native cursor *)
  1026. END;
  1027. focus := NIL; inSel := FALSE;
  1028. IF ~(noSelection IN c.opts) THEN inSel := c.InSelection(f, msg.x, msg.y) END;
  1029. IF ~inSel THEN
  1030. obj := Views.FrameAt(f, msg.x, msg.y);
  1031. IF obj # NIL THEN
  1032. IF ~(noFocus IN c.opts) & NeedFocusAt(obj.view, f, obj, msg.x, msg.y) THEN
  1033. focus := obj.view;
  1034. msg.cursor := Ports.arrowCursor
  1035. ELSIF ~(noSelection IN c.opts) THEN
  1036. inSel := TRUE
  1037. END
  1038. END
  1039. END;
  1040. IF focus = NIL THEN
  1041. IF inSel THEN
  1042. msg.cursor := Ports.arrowCursor
  1043. END
  1044. END
  1045. END
  1046. END PollCursor;
  1047. PROCEDURE PollOps (c: Controller; f: Views.Frame;
  1048. VAR msg: Controllers.PollOpsMsg; VAR focus: Views.View);
  1049. BEGIN
  1050. IF focus = NIL THEN
  1051. msg.type := "";
  1052. IF ~(noSelection IN c.opts) THEN c.GetContextType(msg.type) END;
  1053. msg.selectable := ~(noSelection IN c.opts) & c.Selectable();
  1054. GetValidOps(c, msg.valid);
  1055. msg.singleton := c.Singleton()
  1056. END
  1057. END PollOps;
  1058. PROCEDURE ReplaceView (c: Controller; old, new: Views.View);
  1059. BEGIN
  1060. ASSERT(old.context # NIL, 20);
  1061. ASSERT((new.context = NIL) OR (new.context = old.context), 22);
  1062. IF old.context.ThisModel() = c.model THEN
  1063. c.model.ReplaceView(old, new)
  1064. END;
  1065. IF c.singleton = old THEN c.singleton := new END;
  1066. IF c.focus = old THEN c.focus := new END
  1067. END ReplaceView;
  1068. PROCEDURE ViewProp (v: Views.View): Properties.Property;
  1069. VAR poll: Properties.PollMsg;
  1070. BEGIN
  1071. poll.prop := NIL; Views.HandlePropMsg(v, poll); RETURN poll.prop
  1072. END ViewProp;
  1073. PROCEDURE SetViewProp (v: Views.View; old, p: Properties.Property);
  1074. VAR set: Properties.SetMsg;
  1075. BEGIN
  1076. set.old := old; set.prop := p; Views.HandlePropMsg(v, set)
  1077. END SetViewProp;
  1078. PROCEDURE SizeProp (v: Views.View): Properties.Property;
  1079. VAR sp: Properties.SizeProp;
  1080. BEGIN
  1081. NEW(sp); sp.known := {Properties.width, Properties.height}; sp.valid := sp.known;
  1082. v.context.GetSize(sp.width, sp.height);
  1083. RETURN sp
  1084. END SizeProp;
  1085. PROCEDURE SetSizeProp (v: Views.View; p: Properties.SizeProp);
  1086. VAR w, h: INTEGER;
  1087. BEGIN
  1088. IF p.valid # {Properties.width, Properties.height} THEN
  1089. v.context.GetSize(w, h)
  1090. END;
  1091. IF Properties.width IN p.valid THEN w := p.width END;
  1092. IF Properties.height IN p.valid THEN h := p.height END;
  1093. v.context.SetSize(w, h)
  1094. END SetSizeProp;
  1095. PROCEDURE ThisProp (c: Controller; direct: BOOLEAN): Properties.Property;
  1096. CONST scanCutoff = MAX(INTEGER) (* 50 *); (* bound number of polled embedded views *)
  1097. VAR v: Views.View; np, vp, p: Properties.Property; k: INTEGER; trunc, equal: BOOLEAN;
  1098. BEGIN
  1099. trunc := FALSE; k := 1;
  1100. np := NIL; c.PollNativeProp(direct, np, trunc);
  1101. v := NIL; c.GetFirstView(direct, v);
  1102. IF v # NIL THEN
  1103. Properties.Insert(np, SizeProp(v));
  1104. vp := ViewProp(v);
  1105. k := scanCutoff; c.GetNextView(direct, v);
  1106. WHILE (v # NIL) & (k > 0) DO
  1107. DEC(k);
  1108. Properties.Insert(np, SizeProp(v));
  1109. Properties.Intersect(vp, ViewProp(v), equal);
  1110. c.GetNextView(direct, v)
  1111. END;
  1112. IF c.singleton # NIL THEN Properties.Merge(np, vp); vp := np
  1113. ELSE Properties.Merge(vp, np)
  1114. END
  1115. ELSE vp := np
  1116. END;
  1117. IF trunc OR (k = 0) THEN
  1118. p := vp; WHILE p # NIL DO p.valid := {}; p := p.next END
  1119. END;
  1120. IF noCaret IN c.opts THEN
  1121. p := vp; WHILE p # NIL DO p.readOnly := p.valid; p := p.next END
  1122. END;
  1123. RETURN vp
  1124. END ThisProp;
  1125. PROCEDURE SetProp (c: Controller; old, p: Properties.Property; direct: BOOLEAN);
  1126. TYPE
  1127. ViewList = POINTER TO RECORD next: ViewList; view: Views.View END;
  1128. VAR v: Views.View; q, sp: Properties.Property; equal: BOOLEAN; s: Stores.Operation;
  1129. list, last: ViewList;
  1130. BEGIN
  1131. IF noCaret IN c.opts THEN RETURN END;
  1132. Views.BeginScript(c.view, "#System:SetProp", s);
  1133. q := p; WHILE (q # NIL) & ~(q IS Properties.SizeProp) DO q := q.next END;
  1134. list := NIL; v := NIL; c.GetFirstView(direct, v);
  1135. WHILE v # NIL DO
  1136. IF list = NIL THEN NEW(list); last := list
  1137. ELSE NEW(last.next); last := last.next
  1138. END;
  1139. last.view := v;
  1140. c.GetNextView(direct, v)
  1141. END;
  1142. c.SetNativeProp(direct, old, p);
  1143. WHILE list # NIL DO
  1144. v := list.view; list := list.next;
  1145. SetViewProp(v, old, p);
  1146. IF direct & (q # NIL) THEN
  1147. (* q IS Properties.SizeProp *)
  1148. IF old # NIL THEN
  1149. sp := SizeProp(v);
  1150. Properties.Intersect(sp, old, equal);
  1151. Properties.Intersect(sp, old, equal)
  1152. END;
  1153. IF (old = NIL) OR equal THEN
  1154. SetSizeProp(v, q(Properties.SizeProp))
  1155. END
  1156. END
  1157. END;
  1158. Views.EndScript(c.view, s)
  1159. END SetProp;
  1160. PROCEDURE (c: Controller) HandleCtrlMsg* (f: Views.Frame;
  1161. VAR msg: Controllers.Message; VAR focus: Views.View), NEW, EXTENSIBLE;
  1162. BEGIN
  1163. focus := c.focus;
  1164. WITH msg: Controllers.PollCursorMsg DO
  1165. PollCursor(c, f, msg, focus)
  1166. | msg: Controllers.PollOpsMsg DO
  1167. PollOps(c, f, msg, focus)
  1168. | msg: PollFocusMsg DO
  1169. IF msg.all OR (c.opts * modeOpts # mask) & (c.focus # NIL) THEN msg.ctrl := c END
  1170. | msg: Controllers.TrackMsg DO
  1171. Track(c, f, msg, focus)
  1172. | msg: Controllers.EditMsg DO
  1173. Edit(c, f, msg, focus)
  1174. | msg: Controllers.TransferMessage DO
  1175. Transfer(c, f, msg, focus)
  1176. | msg: Controllers.SelectMsg DO
  1177. IF focus = NIL THEN c.SelectAll(msg.set) END
  1178. | msg: Controllers.TickMsg DO
  1179. FadeMarks(c, show);
  1180. CheckMaskFocus(c, f, focus)
  1181. | msg: Controllers.MarkMsg DO
  1182. c.bVis := msg.show;
  1183. c.Mark(f, f.l, f.t, f.r, f.b, msg.show)
  1184. | msg: Controllers.ReplaceViewMsg DO
  1185. ReplaceView(c, msg.old, msg.new)
  1186. | msg: Properties.CollectMsg DO
  1187. IF focus = NIL THEN
  1188. msg.poll.prop := ThisProp(c, direct)
  1189. END
  1190. | msg: Properties.EmitMsg DO
  1191. IF focus = NIL THEN
  1192. SetProp(c, msg.set.old, msg.set.prop, direct)
  1193. END
  1194. ELSE
  1195. END
  1196. END HandleCtrlMsg;
  1197. (** miscellaneous **)
  1198. PROCEDURE Focus* (): Controller;
  1199. VAR msg: PollFocusMsg;
  1200. BEGIN
  1201. msg.focus := NIL; msg.ctrl := NIL; msg.all := TRUE;
  1202. Controllers.Forward(msg);
  1203. RETURN msg.ctrl
  1204. END Focus;
  1205. PROCEDURE FocusSingleton* (): Views.View;
  1206. VAR c: Controller; v: Views.View;
  1207. BEGIN
  1208. c := Focus();
  1209. IF c # NIL THEN v := c.Singleton() ELSE v := NIL END;
  1210. RETURN v
  1211. END FocusSingleton;
  1212. PROCEDURE CloneOf* (m: Model): Model;
  1213. VAR h: Model;
  1214. BEGIN
  1215. ASSERT(m # NIL, 20);
  1216. Kernel.NewObj(h, Kernel.TypeOf(m));
  1217. h.InitFrom(m);
  1218. RETURN h
  1219. END CloneOf;
  1220. END Containers.