new/System/Mod/Containers.txt

   1 MODULE Containers;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Containers.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT Kernel, Services, Ports, Dialog, Stores, Models, Views, Controllers, Properties, Mechanisms;
   7
   8         CONST
   9                 (** Controller.opts **)
  10                 noSelection* = 0; noFocus* = 1; noCaret* = 2;
  11                 mask* = {noSelection, noCaret}; layout* = {noFocus};
  12                 modeOpts = {noSelection, noFocus, noCaret};
  13
  14                 (** Controller.SelectAll select **)
  15                 deselect* = FALSE; select* = TRUE;
  16
  17                 (** Controller.PollNativeProp/etc. selection **)
  18                 any* = FALSE; selection* = TRUE;
  19
  20                 (** Mark/MarkCaret/MarkSelection/MarkSingleton show **)
  21                 hide* = FALSE; show* = TRUE;
  22
  23                 indirect = FALSE; direct = TRUE;
  24
  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;
  29
  30                 minVersion = 0; maxModelVersion = 0; maxViewVersion = 0; maxCtrlVersion = 0;
  31
  32                 (* buttons *)
  33                 left = 16; middle = 17; right = 18; alt = 28;   (* same as in HostPorts! *)
  34
  35
  36         TYPE
  37                 Model* = POINTER TO ABSTRACT RECORD (Models.Model) END;
  38
  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;
  44
  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;
  52
  53                 Directory* = POINTER TO ABSTRACT RECORD END;
  54
  55                 PollFocusMsg = RECORD (Controllers.PollFocusMsg)
  56                         all: BOOLEAN;
  57                         ctrl: Controller
  58                 END;
  59
  60                 ViewOp = POINTER TO RECORD (Stores.Operation)
  61                         v: View;
  62                         controller: Controller; (* may be NIL *)
  63                         alienCtrl: Stores.Store
  64                 END;
  65
  66                 ControllerOp = POINTER TO RECORD (Stores.Operation)
  67                         c: Controller;
  68                         opts: SET
  69                 END;
  70
  71                 ViewMessage = ABSTRACT RECORD (Views.Message) END;
  72
  73                 FocusMsg = RECORD (ViewMessage)
  74                         set: BOOLEAN
  75                 END;
  76
  77                 SingletonMsg = RECORD (ViewMessage)
  78                         set: BOOLEAN
  79                 END;
  80
  81                 FadeMsg = RECORD (ViewMessage)
  82                         show: BOOLEAN
  83                 END;
  84
  85                 DropPref* = RECORD (Properties.Preference)
  86                         mode-: SET;
  87                         okToDrop*: BOOLEAN
  88                 END;
  89
  90                 GetOpts* = RECORD (Views.PropMessage)
  91                         valid*, opts*: SET
  92                 END;
  93
  94                 SetOpts* = RECORD (Views.PropMessage)
  95                         valid*, opts*: SET
  96                 END;
  97
  98
  99         PROCEDURE ^ (v: View) SetController* (c: Controller), NEW;
 100         PROCEDURE ^ (v: View) InitModel* (m: Model), NEW;
 101
 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);
 110
 111
 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 **)
 128
 129         (** Model **)
 130
 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;
 138
 139         PROCEDURE (m: Model) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
 140         BEGIN
 141                 m.Externalize^(wr);
 142                 wr.WriteVersion(maxModelVersion)
 143         END Externalize;
 144
 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;
 148
 149         (** View **)
 150
 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;
 162
 163
 164         PROCEDURE (v: View) Externalize2- (VAR rd: Stores.Writer), NEW, EMPTY;
 165         PROCEDURE(v: View) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
 166
 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;
 192
 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;
 204
 205         PROCEDURE (v: View) CopyFromModelView2- (source: Views.View; model: Models.Model), NEW, EMPTY;
 206
 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;
 222
 223         PROCEDURE (v: View) ThisModel* (): Model, EXTENSIBLE;
 224         BEGIN
 225                 RETURN v.model
 226         END ThisModel;
 227
 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;
 238
 239         PROCEDURE (v: View) ThisController* (): Controller, NEW, EXTENSIBLE;
 240         BEGIN
 241                 RETURN v.controller
 242         END ThisController;
 243
 244         PROCEDURE (v: View) GetRect* (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER), NEW, ABSTRACT;
 245
 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;
 250
 251         PROCEDURE (v: View) Neutralize*;
 252         BEGIN
 253                 IF v.controller # NIL THEN v.controller.Neutralize END
 254         END Neutralize;
 255
 256         PROCEDURE (v: View) ConsiderFocusRequestBy- (view: Views.View);
 257         BEGIN
 258                 IF v.controller # NIL THEN v.controller.ConsiderFocusRequestBy(view) END
 259         END ConsiderFocusRequestBy;
 260
 261
 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;
 267
 268
 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;
 274
 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;
 280
 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;
 292
 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 ;
 298
 299
 300         (** Controller **)
 301
 302         PROCEDURE (c: Controller) Externalize2- (VAR rd: Stores.Writer), NEW, EMPTY;
 303         PROCEDURE(c: Controller) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
 304
 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;
 315
 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;
 323
 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;
 332
 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;
 349
 350         PROCEDURE (c: Controller) ThisView* (): View, NEW, EXTENSIBLE;
 351         BEGIN
 352                 RETURN c.view
 353         END ThisView;
 354
 355
 356         (** options **)
 357
 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;
 368
 369
 370         (** subclass hooks **)
 371
 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;
 380
 381         PROCEDURE (c: Controller) MakeViewVisible* (v: Views.View), NEW, EMPTY;
 382
 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;
 385
 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;
 399
 400         PROCEDURE (c: Controller) CanDrop* (f: Views.Frame; x, y: INTEGER): BOOLEAN, NEW, EXTENSIBLE;
 401         BEGIN
 402                 RETURN TRUE
 403         END CanDrop;
 404
 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;
 418
 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;
 423
 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;
 426
 427         PROCEDURE (c: Controller) MarkPickTarget* (src, dst: Views.Frame;
 428                                                                                                                         sx, sy, dx, dy: INTEGER; show: BOOLEAN), NEW, EMPTY;
 429
 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;
 441
 442
 443         (** selection **)
 444
 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;
 451
 452         PROCEDURE (c: Controller) Selectable* (): BOOLEAN, NEW, ABSTRACT;
 453
 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;
 460
 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;
 479
 480         PROCEDURE (c: Controller) SelectAll* (select: BOOLEAN), NEW, ABSTRACT;
 481         (** replaced by subclass to include intrinsic selections **)
 482
 483         PROCEDURE (c: Controller) InSelection* (f: Views.Frame; x, y: INTEGER): BOOLEAN, NEW, ABSTRACT;
 484         (** replaced by subclass to include intrinsic selections **)
 485
 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;
 491
 492
 493         (** focus **)
 494
 495         PROCEDURE (c: Controller) ThisFocus* (): Views.View, NEW, EXTENSIBLE;
 496         BEGIN
 497                 ASSERT(c.model # NIL, 20);
 498                 RETURN c.focus
 499         END ThisFocus;
 500
 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;
 523
 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;
 532
 533
 534         (** caret **)
 535
 536         PROCEDURE (c: Controller) HasCaret* (): BOOLEAN, NEW, ABSTRACT;
 537         PROCEDURE (c: Controller) MarkCaret* (f: Views.Frame; show: BOOLEAN), NEW, ABSTRACT;
 538
 539
 540         (** general marking protocol **)
 541
 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;
 555
 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;
 560
 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;
 569
 570         PROCEDURE (c: Controller) Neutralize2-, NEW, EMPTY;
 571         (** caret needs to be removed by this method **)
 572
 573         PROCEDURE (c: Controller) Neutralize*, NEW;
 574         BEGIN
 575                 c.SetFocus(NIL); c.SelectAll(deselect);
 576                 c.Neutralize2
 577         END Neutralize;
 578
 579
 580         (** message handlers **)
 581
 582         PROCEDURE (c: Controller) HandleModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
 583         BEGIN
 584                 ASSERT(c.model # NIL, 20)
 585         END HandleModelMsg;
 586
 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;
 616
 617
 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;
 650
 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;
 675
 676
 677         (** Directory **)
 678
 679         PROCEDURE (d: Directory) NewController* (opts: SET): Controller, NEW, ABSTRACT;
 680
 681         PROCEDURE (d: Directory) New* (): Controller, NEW, EXTENSIBLE;
 682         BEGIN
 683                 RETURN d.NewController({})
 684         END New;
 685
 686
 687         (* ViewOp *)
 688
 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;
 699
 700
 701         (* ControllerOp *)
 702
 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;
 710
 711
 712         (* Controller implementation support *)
 713
 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;
 721
 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;
 737
 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;
 749
 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;
 766
 767
 768         (* handle controller messages in editor mode *)
 769
 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;
 778
 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;
 787
 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;
 796
 797
 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;
 812
 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;
 858
 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;
 877
 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;
 886
 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;
 969
 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;
 983
 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;
 996
 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;
1006
1007
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;
1056
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;
1063
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;
1071
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;
1149
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;
1193
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;
1205
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;
1216
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;
1222
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;
1228
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;
1236
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;
1247
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;
1278
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;
1314
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;
1352
1353
1354         (** miscellaneous **)
1355
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;
1363
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;
1371
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;
1380
1381 END Containers.