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