1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381 |
- MODULE Containers;
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Containers.odc *)
- (* DO NOT EDIT *)
- IMPORT Kernel, Services, Ports, Dialog, Stores, Models, Views, Controllers, Properties, Mechanisms;
- CONST
- (** Controller.opts **)
- noSelection* = 0; noFocus* = 1; noCaret* = 2;
- mask* = {noSelection, noCaret}; layout* = {noFocus};
- modeOpts = {noSelection, noFocus, noCaret};
- (** Controller.SelectAll select **)
- deselect* = FALSE; select* = TRUE;
- (** Controller.PollNativeProp/etc. selection **)
- any* = FALSE; selection* = TRUE;
- (** Mark/MarkCaret/MarkSelection/MarkSingleton show **)
- hide* = FALSE; show* = TRUE;
- indirect = FALSE; direct = TRUE;
- TAB = 9X; LTAB = 0AX; ENTER = 0DX; ESC = 01BX;
- PL = 10X; PR = 11X; PU = 12X; PD = 13X;
- DL = 14X; DR = 15; DU = 16X; DD = 17X;
- AL = 1CX; AR = 1DX; AU = 1EX; AD = 1FX;
- minVersion = 0; maxModelVersion = 0; maxViewVersion = 0; maxCtrlVersion = 0;
- (* buttons *)
- left = 16; middle = 17; right = 18; alt = 28; (* same as in HostPorts! *)
- TYPE
- Model* = POINTER TO ABSTRACT RECORD (Models.Model) END;
- View* = POINTER TO ABSTRACT RECORD (Views.View)
- model: Model;
- controller: Controller;
- alienCtrl: Stores.Store (* alienCtrl = NIL OR controller = NIL *)
- END;
- Controller* = POINTER TO ABSTRACT RECORD (Controllers.Controller)
- opts-: SET;
- model: Model; (* connected iff model # NIL *)
- view: View;
- focus, singleton: Views.View;
- bVis: BOOLEAN (* control visibility of focus/singleton border *)
- END;
- Directory* = POINTER TO ABSTRACT RECORD END;
- PollFocusMsg = RECORD (Controllers.PollFocusMsg)
- all: BOOLEAN;
- ctrl: Controller
- END;
-
- ViewOp = POINTER TO RECORD (Stores.Operation)
- v: View;
- controller: Controller; (* may be NIL *)
- alienCtrl: Stores.Store
- END;
- ControllerOp = POINTER TO RECORD (Stores.Operation)
- c: Controller;
- opts: SET
- END;
- ViewMessage = ABSTRACT RECORD (Views.Message) END;
- FocusMsg = RECORD (ViewMessage)
- set: BOOLEAN
- END;
- SingletonMsg = RECORD (ViewMessage)
- set: BOOLEAN
- END;
- FadeMsg = RECORD (ViewMessage)
- show: BOOLEAN
- END;
-
- DropPref* = RECORD (Properties.Preference)
- mode-: SET;
- okToDrop*: BOOLEAN
- END;
-
- GetOpts* = RECORD (Views.PropMessage)
- valid*, opts*: SET
- END;
-
- SetOpts* = RECORD (Views.PropMessage)
- valid*, opts*: SET
- END;
-
- PROCEDURE ^ (v: View) SetController* (c: Controller), NEW;
- PROCEDURE ^ (v: View) InitModel* (m: Model), NEW;
- PROCEDURE ^ Focus* (): Controller;
- PROCEDURE ^ ClaimFocus (v: Views.View): BOOLEAN;
- PROCEDURE ^ MarkFocus (c: Controller; f: Views.Frame; show: BOOLEAN);
- PROCEDURE ^ MarkSingleton* (c: Controller; f: Views.Frame; show: BOOLEAN);
- PROCEDURE ^ FadeMarks* (c: Controller; show: BOOLEAN);
- PROCEDURE ^ CopyView (source: Controller; VAR view: Views.View; VAR w, h: INTEGER);
- PROCEDURE ^ ThisProp (c: Controller; direct: BOOLEAN): Properties.Property;
- PROCEDURE ^ SetProp (c: Controller; old, p: Properties.Property; direct: BOOLEAN);
- PROCEDURE ^ (c: Controller) InitView* (v: Views.View), NEW;
- PROCEDURE (c: Controller) InitView2* (v: Views.View), NEW, EMPTY;
- PROCEDURE ^ (c: Controller) ThisView* (): View, NEW, EXTENSIBLE;
- PROCEDURE ^ (c: Controller) ThisFocus* (): Views.View, NEW, EXTENSIBLE;
- PROCEDURE ^ (c: Controller) ConsiderFocusRequestBy* (view: Views.View), NEW;
- PROCEDURE ^ (c: Controller) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER), NEW;
- PROCEDURE ^ (c: Controller) Neutralize*, NEW;
- (** called by view's Neutralize **)
- PROCEDURE ^ (c: Controller) HandleModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
- (** called by view's HandleModelMsg after handling msg **)
- PROCEDURE ^ (c: Controller) HandleViewMsg* (f: Views.Frame; VAR msg: Views.Message), NEW, EXTENSIBLE;
- (** called by view's HandleViewMsg after handling msg **)
- PROCEDURE ^ (c: Controller) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View), NEW, EXTENSIBLE;
- (** called by view's HandleCtrlMsg *before* handling msg; focus is respected/used by view **)
- PROCEDURE ^ (c: Controller) HandlePropMsg* (VAR msg: Views.PropMessage), NEW, EXTENSIBLE;
- (** called by view's HandlePropMsg after handling msg; controller can override view **)
- (** Model **)
- PROCEDURE (m: Model) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
- VAR thisVersion: INTEGER;
- BEGIN
- m.Internalize^(rd);
- IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxModelVersion, thisVersion)
- END Internalize;
- PROCEDURE (m: Model) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
- BEGIN
- m.Externalize^(wr);
- wr.WriteVersion(maxModelVersion)
- END Externalize;
- PROCEDURE (m: Model) GetEmbeddingLimits* (OUT minW, maxW, minH, maxH: INTEGER), NEW, ABSTRACT;
- PROCEDURE (m: Model) ReplaceView* (old, new: Views.View), NEW, ABSTRACT;
- PROCEDURE (m: Model) InitFrom- (source: Model), NEW, EMPTY;
- (** View **)
- PROCEDURE (v: View) AcceptableModel- (m: Model): BOOLEAN, NEW, ABSTRACT;
- PROCEDURE (v: View) InitModel2- (m: Model), NEW, EMPTY;
- PROCEDURE (v: View) InitModel* (m: Model), NEW;
- BEGIN
- ASSERT((v.model = NIL) OR (v.model = m), 20);
- ASSERT(m # NIL, 21);
- ASSERT(v.AcceptableModel(m), 22);
- v.model := m;
- Stores.Join(v, m);
- v.InitModel2(m)
- END InitModel;
-
-
- PROCEDURE (v: View) Externalize2- (VAR rd: Stores.Writer), NEW, EMPTY;
- PROCEDURE(v: View) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
- PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader);
- VAR st: Stores.Store; c: Controller; m: Model; thisVersion: INTEGER;
- BEGIN
- v.Internalize^(rd);
- IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxViewVersion, thisVersion);
- IF rd.cancelled THEN RETURN END;
- rd.ReadStore(st); ASSERT(st # NIL, 100);
- IF ~(st IS Model) THEN
- rd.TurnIntoAlien(Stores.alienComponent);
- Stores.Report("#System:AlienModel", "", "", "");
- RETURN
- END;
- m := st(Model);
- rd.ReadStore(st);
- IF st = NIL THEN c := NIL; v.alienCtrl := NIL
- ELSIF st IS Stores.Alien THEN
- c := NIL; v.alienCtrl := st; Stores.Join(v, v.alienCtrl);
- Stores.Report("#System:AlienControllerWarning", "", "", "")
- ELSE c := st(Controller); v.alienCtrl := NIL
- END;
- v.InitModel(m);
- IF c # NIL THEN v.SetController(c) ELSE v.controller := NIL END;
- v.Internalize2(rd)
- END Internalize;
- PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer);
- BEGIN
- ASSERT(v.model # NIL, 20);
- v.Externalize^(wr);
- wr.WriteVersion(maxViewVersion);
- wr.WriteStore(v.model);
- IF v.controller # NIL THEN wr.WriteStore(v.controller)
- ELSE wr.WriteStore(v.alienCtrl)
- END;
- v.Externalize2(wr)
- END Externalize;
- PROCEDURE (v: View) CopyFromModelView2- (source: Views.View; model: Models.Model), NEW, EMPTY;
-
- PROCEDURE (v: View) CopyFromModelView- (source: Views.View; model: Models.Model);
- VAR c: Controller;
- BEGIN
- WITH source: View DO
- v.InitModel(model(Model));
- IF source.controller # NIL THEN
- c := Stores.CopyOf(source.controller)(Controller)
- ELSE
- c := NIL
- END;
- IF source.alienCtrl # NIL THEN v.alienCtrl := Stores.CopyOf(source.alienCtrl)(Stores.Alien) END;
- IF c # NIL THEN v.SetController(c) ELSE v.controller := NIL END
- END;
- v.CopyFromModelView2(source, model)
- END CopyFromModelView;
- PROCEDURE (v: View) ThisModel* (): Model, EXTENSIBLE;
- BEGIN
- RETURN v.model
- END ThisModel;
- PROCEDURE (v: View) SetController* (c: Controller), NEW;
- VAR op: ViewOp;
- BEGIN
- ASSERT(v.model # NIL, 20);
- IF v.controller # c THEN
- Stores.Join(v, c);
- NEW(op); op.v := v; op.controller := c; op.alienCtrl := NIL;
- Views.Do(v, "#System:ViewSetting", op)
- END
- END SetController;
- PROCEDURE (v: View) ThisController* (): Controller, NEW, EXTENSIBLE;
- BEGIN
- RETURN v.controller
- END ThisController;
-
- PROCEDURE (v: View) GetRect* (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER), NEW, ABSTRACT;
- PROCEDURE (v: View) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- IF v.controller # NIL THEN v.controller.RestoreMarks(f, l, t, r, b) END
- END RestoreMarks;
- PROCEDURE (v: View) Neutralize*;
- BEGIN
- IF v.controller # NIL THEN v.controller.Neutralize END
- END Neutralize;
- PROCEDURE (v: View) ConsiderFocusRequestBy- (view: Views.View);
- BEGIN
- IF v.controller # NIL THEN v.controller.ConsiderFocusRequestBy(view) END
- END ConsiderFocusRequestBy;
- PROCEDURE (v: View) HandleModelMsg2- (VAR msg: Models.Message), NEW, EMPTY;
- PROCEDURE (v: View) HandleViewMsg2- (f: Views.Frame; VAR msg: Views.Message), NEW, EMPTY;
- PROCEDURE (v: View) HandlePropMsg2- (VAR p: Properties.Message), NEW, EMPTY;
- PROCEDURE (v: View) HandleCtrlMsg2- (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View), NEW, EMPTY;
- PROCEDURE (v: View) HandleModelMsg- (VAR msg: Models.Message);
- BEGIN
- v.HandleModelMsg2(msg);
- IF v.controller # NIL THEN v.controller.HandleModelMsg(msg) END
- END HandleModelMsg;
- PROCEDURE (v: View) HandleViewMsg- (f: Views.Frame; VAR msg: Views.Message);
- BEGIN
- v.HandleViewMsg2(f, msg);
- IF v.controller # NIL THEN v.controller.HandleViewMsg(f, msg) END
- END HandleViewMsg;
- PROCEDURE (v: View) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
- BEGIN
- IF v.controller # NIL THEN v.controller.HandleCtrlMsg(f, msg, focus) END;
- v.HandleCtrlMsg2(f, msg, focus);
- WITH msg: Controllers.PollSectionMsg DO
- IF ~msg.focus THEN focus := NIL END
- | msg: Controllers.ScrollMsg DO
- IF ~msg.focus THEN focus := NIL END
- ELSE
- END
- END HandleCtrlMsg;
- PROCEDURE (v: View) HandlePropMsg- (VAR p: Properties.Message);
- BEGIN
- v.HandlePropMsg2(p);
- IF v.controller # NIL THEN v.controller.HandlePropMsg(p) END
- END HandlePropMsg ;
- (** Controller **)
- PROCEDURE (c: Controller) Externalize2- (VAR rd: Stores.Writer), NEW, EMPTY;
- PROCEDURE(c: Controller) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
- PROCEDURE (c: Controller) Internalize- (VAR rd: Stores.Reader);
- VAR v: INTEGER;
- BEGIN
- c.Internalize^(rd);
- IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxCtrlVersion, v);
- IF rd.cancelled THEN RETURN END;
- rd.ReadSet(c.opts);
- c.Internalize2(rd)
- END Internalize;
- PROCEDURE (c: Controller) Externalize- (VAR wr: Stores.Writer);
- BEGIN
- c.Externalize^(wr);
- wr.WriteVersion(maxCtrlVersion);
- wr.WriteSet(c.opts);
- c.Externalize2(wr)
- END Externalize;
- PROCEDURE (c: Controller) CopyFrom- (source: Stores.Store), EXTENSIBLE;
- BEGIN
- WITH source: Controller DO
- c.opts := source.opts;
- c.focus := NIL; c.singleton := NIL;
- c.bVis := FALSE
- END
- END CopyFrom;
- PROCEDURE (c: Controller) InitView* (v: Views.View), NEW;
- VAR view: View; model: Model;
- BEGIN
- ASSERT((v = NIL) # (c.view = NIL) OR (v = c.view), 21);
- IF c.view = NIL THEN
- ASSERT(v IS View, 22); (* subclass may assert narrower type *)
- view := v(View);
- model := view.ThisModel(); ASSERT(model # NIL, 24);
- c.view := view; c.model := model;
- Stores.Join(c, c.view)
- ELSE
- c.view.Neutralize; c.view := NIL; c.model := NIL
- END;
- c.focus := NIL; c.singleton := NIL; c.bVis := FALSE;
- c.InitView2(v)
- END InitView;
- PROCEDURE (c: Controller) ThisView* (): View, NEW, EXTENSIBLE;
- BEGIN
- RETURN c.view
- END ThisView;
- (** options **)
- PROCEDURE (c: Controller) SetOpts* (opts: SET), NEW, EXTENSIBLE;
- VAR op: ControllerOp;
- BEGIN
- IF c.view # NIL THEN
- NEW(op); op.c := c; op.opts := opts;
- Views.Do(c.view, "#System:ChangeOptions", op)
- ELSE
- c.opts := opts
- END
- END SetOpts;
- (** subclass hooks **)
- PROCEDURE (c: Controller) GetContextType* (OUT type: Stores.TypeName), NEW, ABSTRACT;
- PROCEDURE (c: Controller) GetValidOps* (OUT valid: SET), NEW, ABSTRACT;
- PROCEDURE (c: Controller) NativeModel* (m: Models.Model): BOOLEAN, NEW, ABSTRACT;
- PROCEDURE (c: Controller) NativeView* (v: Views.View): BOOLEAN, NEW, ABSTRACT;
- PROCEDURE (c: Controller) NativeCursorAt* (f: Views.Frame; x, y: INTEGER): INTEGER, NEW, ABSTRACT;
- PROCEDURE (c: Controller) PickNativeProp* (f: Views.Frame; x, y: INTEGER; VAR p: Properties.Property), NEW, EMPTY;
- PROCEDURE (c: Controller) PollNativeProp* (selection: BOOLEAN; VAR p: Properties.Property; VAR truncated: BOOLEAN), NEW, EMPTY;
- PROCEDURE (c: Controller) SetNativeProp* (selection: BOOLEAN; old, p: Properties.Property), NEW, EMPTY;
- PROCEDURE (c: Controller) MakeViewVisible* (v: Views.View), NEW, EMPTY;
-
- PROCEDURE (c: Controller) GetFirstView* (selection: BOOLEAN; OUT v: Views.View), NEW, ABSTRACT;
- PROCEDURE (c: Controller) GetNextView* (selection: BOOLEAN; VAR v: Views.View), NEW, ABSTRACT;
- PROCEDURE (c: Controller) GetPrevView* (selection: BOOLEAN; VAR v: Views.View), NEW, EXTENSIBLE;
- VAR p, q: Views.View;
- BEGIN
- ASSERT(v # NIL, 20);
- c.GetFirstView(selection, p);
- IF p # v THEN
- WHILE (p # NIL) & (p # v) DO q := p; c.GetNextView(selection, p) END;
- ASSERT(p # NIL, 21);
- v := q
- ELSE
- v := NIL
- END
- END GetPrevView;
-
- PROCEDURE (c: Controller) CanDrop* (f: Views.Frame; x, y: INTEGER): BOOLEAN, NEW, EXTENSIBLE;
- BEGIN
- RETURN TRUE
- END CanDrop;
- PROCEDURE (c: Controller) GetSelectionBounds* (f: Views.Frame; OUT x, y, w, h: INTEGER), NEW, EXTENSIBLE;
- VAR g: Views.Frame; v: Views.View;
- BEGIN
- x := 0; y := 0; w := 0; h := 0;
- v := c.singleton;
- IF v # NIL THEN
- g := Views.ThisFrame(f, v);
- IF g # NIL THEN
- x := g.gx - f.gx; y := g.gy - f.gy;
- v.context.GetSize(w, h)
- END
- END
- END GetSelectionBounds;
- PROCEDURE (c: Controller) MarkDropTarget* (src, dst: Views.Frame;
- sx, sy, dx, dy, w, h, rx, ry: INTEGER;
- type: Stores.TypeName;
- isSingle, show: BOOLEAN), NEW, EMPTY;
- PROCEDURE (c: Controller) Drop* (src, dst: Views.Frame; sx, sy, dx, dy, w, h, rx, ry: INTEGER;
- view: Views.View; isSingle: BOOLEAN), NEW, ABSTRACT;
- PROCEDURE (c: Controller) MarkPickTarget* (src, dst: Views.Frame;
- sx, sy, dx, dy: INTEGER; show: BOOLEAN), NEW, EMPTY;
- PROCEDURE (c: Controller) TrackMarks* (f: Views.Frame; x, y: INTEGER; units, extend, add: BOOLEAN), NEW, ABSTRACT;
- PROCEDURE (c: Controller) Resize* (view: Views.View; l, t, r, b: INTEGER), NEW, ABSTRACT;
- PROCEDURE (c: Controller) DeleteSelection*, NEW, ABSTRACT;
- PROCEDURE (c: Controller) MoveLocalSelection* (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER), NEW, ABSTRACT;
- PROCEDURE (c: Controller) CopyLocalSelection* (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER), NEW, ABSTRACT;
- PROCEDURE (c: Controller) SelectionCopy* (): Model, NEW, ABSTRACT;
- PROCEDURE (c: Controller) NativePaste* (m: Models.Model; f: Views.Frame), NEW, ABSTRACT;
- PROCEDURE (c: Controller) ArrowChar* (f: Views.Frame; ch: CHAR; units, select: BOOLEAN), NEW, ABSTRACT;
- PROCEDURE (c: Controller) ControlChar* (f: Views.Frame; ch: CHAR), NEW, ABSTRACT;
- PROCEDURE (c: Controller) PasteChar* (ch: CHAR), NEW, ABSTRACT;
- PROCEDURE (c: Controller) PasteView* (f: Views.Frame; v: Views.View; w, h: INTEGER), NEW, ABSTRACT;
- (** selection **)
- PROCEDURE (c: Controller) HasSelection* (): BOOLEAN, NEW, EXTENSIBLE;
- (** extended by subclass to include intrinsic selections **)
- BEGIN
- ASSERT(c.model # NIL, 20);
- RETURN c.singleton # NIL
- END HasSelection;
- PROCEDURE (c: Controller) Selectable* (): BOOLEAN, NEW, ABSTRACT;
- PROCEDURE (c: Controller) Singleton* (): Views.View, NEW; (* LEAF *)
- BEGIN
- IF c = NIL THEN RETURN NIL
- ELSE RETURN c.singleton
- END
- END Singleton;
- PROCEDURE (c: Controller) SetSingleton* (s: Views.View), NEW, EXTENSIBLE;
- (** extended by subclass to adjust intrinsic selections **)
- VAR con: Models.Context; msg: SingletonMsg;
- BEGIN
- ASSERT(c.model # NIL, 20);
- ASSERT(~(noSelection IN c.opts), 21);
- IF c.singleton # s THEN
- IF s # NIL THEN
- con := s.context;
- ASSERT(con # NIL, 22); ASSERT(con.ThisModel() = c.model, 23);
- c.view.Neutralize
- ELSIF c.singleton # NIL THEN
- c.bVis := FALSE; msg.set := FALSE; Views.Broadcast(c.view, msg)
- END;
- c.singleton := s;
- IF s # NIL THEN c.bVis := TRUE; msg.set := TRUE; Views.Broadcast(c.view, msg) END
- END
- END SetSingleton;
-
- PROCEDURE (c: Controller) SelectAll* (select: BOOLEAN), NEW, ABSTRACT;
- (** replaced by subclass to include intrinsic selections **)
- PROCEDURE (c: Controller) InSelection* (f: Views.Frame; x, y: INTEGER): BOOLEAN, NEW, ABSTRACT;
- (** replaced by subclass to include intrinsic selections **)
- PROCEDURE (c: Controller) MarkSelection* (f: Views.Frame; show: BOOLEAN), NEW, EXTENSIBLE;
- (** replaced by subclass to include intrinsic selections **)
- BEGIN
- MarkSingleton(c, f, show)
- END MarkSelection;
- (** focus **)
- PROCEDURE (c: Controller) ThisFocus* (): Views.View, NEW, EXTENSIBLE;
- BEGIN
- ASSERT(c.model # NIL, 20);
- RETURN c.focus
- END ThisFocus;
- PROCEDURE (c: Controller) SetFocus* (focus: Views.View), NEW; (* LEAF *)
- VAR focus0: Views.View; con: Models.Context; msg: FocusMsg;
- BEGIN
- ASSERT(c.model # NIL, 20);
- focus0 := c.focus;
- IF focus # focus0 THEN
- IF focus # NIL THEN
- con := focus.context;
- ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.model, 22);
- IF focus0 = NIL THEN c.view.Neutralize END
- END;
- IF focus0 # NIL THEN
- IF ~Views.IsInvalid(focus0) THEN focus0.Neutralize END;
- c.bVis := FALSE; msg.set := FALSE; Views.Broadcast(c.view, msg)
- END;
- c.focus := focus;
- IF focus # NIL THEN
- c.MakeViewVisible(focus);
- c.bVis := TRUE; msg.set := TRUE; Views.Broadcast(c.view, msg)
- END
- END
- END SetFocus;
- PROCEDURE (c: Controller) ConsiderFocusRequestBy* (view: Views.View), NEW;
- VAR con: Models.Context;
- BEGIN
- ASSERT(c.model # NIL, 20);
- ASSERT(view # NIL, 21); con := view.context;
- ASSERT(con # NIL, 22); ASSERT(con.ThisModel() = c.model, 23);
- IF c.focus = NIL THEN c.SetFocus(view) END
- END ConsiderFocusRequestBy;
- (** caret **)
- PROCEDURE (c: Controller) HasCaret* (): BOOLEAN, NEW, ABSTRACT;
- PROCEDURE (c: Controller) MarkCaret* (f: Views.Frame; show: BOOLEAN), NEW, ABSTRACT;
- (** general marking protocol **)
- PROCEDURE CheckMaskFocus (c: Controller; f: Views.Frame; VAR focus: Views.View);
- VAR v: Views.View;
- BEGIN
- IF f.mark & (c.opts * modeOpts = mask) & (c.model # NIL) & ((focus = NIL) OR ~ClaimFocus(focus)) THEN
- c.GetFirstView(any, v);
- WHILE (v # NIL) & ~ClaimFocus(v) DO c.GetNextView(any, v) END;
- IF v # NIL THEN
- c.SetFocus(v);
- focus := v
- ELSE c.SetFocus(NIL); focus := NIL
- END
- END
- END CheckMaskFocus;
-
- PROCEDURE (c: Controller) Mark* (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN), NEW, EXTENSIBLE;
- BEGIN
- MarkFocus(c, f, show); c.MarkSelection(f, show); c.MarkCaret(f, show)
- END Mark;
- PROCEDURE (c: Controller) RestoreMarks2- (f: Views.Frame; l, t, r, b: INTEGER), NEW, EMPTY;
- PROCEDURE (c: Controller) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER), NEW;
- BEGIN
- IF f.mark THEN
- c.Mark(f, l, t, r, b, show);
- c.RestoreMarks2(f, l, t, r, b)
- END
- END RestoreMarks;
- PROCEDURE (c: Controller) Neutralize2-, NEW, EMPTY;
- (** caret needs to be removed by this method **)
- PROCEDURE (c: Controller) Neutralize*, NEW;
- BEGIN
- c.SetFocus(NIL); c.SelectAll(deselect);
- c.Neutralize2
- END Neutralize;
- (** message handlers **)
- PROCEDURE (c: Controller) HandleModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
- BEGIN
- ASSERT(c.model # NIL, 20)
- END HandleModelMsg;
- PROCEDURE (c: Controller) HandleViewMsg* (f: Views.Frame; VAR msg: Views.Message), NEW, EXTENSIBLE;
- VAR g: Views.Frame; mark: Controllers.MarkMsg;
- BEGIN
- ASSERT(c.model # NIL, 20);
- IF msg.view = c.view THEN
- WITH msg: ViewMessage DO
- WITH msg: FocusMsg DO
- g := Views.ThisFrame(f, c.focus);
- IF g # NIL THEN
- IF msg.set THEN
- MarkFocus(c, f, show);
- mark.show := TRUE; mark.focus := TRUE;
- Views.ForwardCtrlMsg(g, mark)
- ELSE
- mark.show := FALSE; mark.focus := TRUE;
- Views.ForwardCtrlMsg(g, mark);
- MarkFocus(c, f, hide)
- END
- END
- | msg: SingletonMsg DO
- MarkSingleton(c, f, msg.set)
- | msg: FadeMsg DO
- MarkFocus(c, f, msg.show);
- MarkSingleton(c, f, msg.show)
- END
- ELSE
- END
- END
- END HandleViewMsg;
- PROCEDURE CollectControlPref (c: Controller; focus: Views.View; ch: CHAR; cyclic: BOOLEAN;
- VAR v: Views.View; VAR getFocus, accepts: BOOLEAN);
- VAR first, w: Views.View; p: Properties.ControlPref; back: BOOLEAN;
- BEGIN
- back := (ch = LTAB) OR (ch = AL) OR (ch = AU); first := c.focus;
- IF first = NIL THEN
- c.GetFirstView(any, first);
- IF back THEN w := first;
- WHILE w # NIL DO first := w; c.GetNextView(any, w) END
- END
- END;
- v := first;
- WHILE v # NIL DO
- p.char := ch; p.focus := focus;
- p.getFocus := (v # focus) & ((ch = TAB) OR (ch = LTAB)) & ClaimFocus(v);
- p.accepts := (v = focus) & (ch # TAB) & (ch # LTAB);
- Views.HandlePropMsg(v, p);
- IF p.accepts OR (v # focus) & p.getFocus THEN
- getFocus := p.getFocus; accepts := p.accepts;
- RETURN
- END;
- IF back THEN c.GetPrevView(any, v) ELSE c.GetNextView(any, v) END;
- IF cyclic & (v = NIL) THEN
- c.GetFirstView(any, v);
- IF back THEN w := v;
- WHILE w # NIL DO v := w; c.GetNextView(any, w) END
- END
- END;
- IF v = first THEN v := NIL END
- END;
- getFocus := FALSE; accepts := FALSE
- END CollectControlPref;
-
- PROCEDURE (c: Controller) HandlePropMsg* (VAR msg: Properties.Message), NEW, EXTENSIBLE;
- VAR v: Views.View;
- BEGIN
- ASSERT(c.model # NIL, 20);
- WITH msg: Properties.PollMsg DO
- msg.prop := ThisProp(c, indirect)
- | msg: Properties.SetMsg DO
- SetProp(c, msg.old, msg.prop, indirect)
- | msg: Properties.FocusPref DO
- IF {noSelection, noFocus, noCaret} - c.opts # {} THEN msg.setFocus := TRUE END
- | msg: GetOpts DO
- msg.valid := modeOpts; msg.opts := c.opts
- | msg: SetOpts DO
- c.SetOpts(c.opts - msg.valid + (msg.opts * msg.valid))
- | msg: Properties.ControlPref DO
- IF c.opts * modeOpts = mask THEN
- v := msg.focus;
- IF v = c.view THEN v := c.focus END;
- CollectControlPref(c, v, msg.char, FALSE, v, msg.getFocus, msg.accepts);
- IF msg.getFocus THEN msg.accepts := TRUE END
- END
- ELSE
- END
- END HandlePropMsg;
- (** Directory **)
- PROCEDURE (d: Directory) NewController* (opts: SET): Controller, NEW, ABSTRACT;
- PROCEDURE (d: Directory) New* (): Controller, NEW, EXTENSIBLE;
- BEGIN
- RETURN d.NewController({})
- END New;
- (* ViewOp *)
- PROCEDURE (op: ViewOp) Do;
- VAR v: View; c0, c1: Controller; a0, a1: Stores.Store;
- BEGIN
- v := op.v; c0 := v.controller; a0 := v.alienCtrl; c1 := op.controller; a1 := op.alienCtrl;
- IF c0 # NIL THEN c0.InitView(NIL) END;
- v.controller := c1; v.alienCtrl := a1;
- op.controller := c0; op.alienCtrl := a0;
- IF c1 # NIL THEN c1.InitView(v) END;
- Views.Update(v, Views.keepFrames)
- END Do;
- (* ControllerOp *)
- PROCEDURE (op: ControllerOp) Do;
- VAR c: Controller; opts: SET;
- BEGIN
- c := op.c;
- opts := c.opts; c.opts := op.opts; op.opts := opts;
- Views.Update(c.view, Views.keepFrames)
- END Do;
- (* Controller implementation support *)
- PROCEDURE BorderVisible (c: Controller; f: Views.Frame): BOOLEAN;
- BEGIN
- IF 31 IN c.opts THEN RETURN TRUE END;
- IF f IS Views.RootFrame THEN RETURN FALSE END;
- IF Services.Is(c.focus, "OleClient.View") THEN RETURN FALSE END;
- RETURN TRUE
- END BorderVisible;
- PROCEDURE MarkFocus (c: Controller; f: Views.Frame; show: BOOLEAN);
- VAR focus: Views.View; f1: Views.Frame; l, t, r, b: INTEGER;
- BEGIN
- focus := c.focus;
- IF f.front & (focus # NIL) & (~show OR c.bVis) & BorderVisible(c, f) & ~(noSelection IN c.opts) THEN
- f1 := Views.ThisFrame(f, focus);
- IF f1 # NIL THEN
- c.bVis := show;
- c.view.GetRect(f, focus, l, t, r, b);
- IF (l # MAX(INTEGER)) & (t # MAX(INTEGER)) THEN
- Mechanisms.MarkFocusBorder(f, focus, l, t, r, b, show)
- END
- END
- END
- END MarkFocus;
- PROCEDURE MarkSingleton* (c: Controller; f: Views.Frame; show: BOOLEAN);
- VAR l, t, r, b: INTEGER;
- BEGIN
- IF (*(f.front OR f.target) &*) (~show OR c.bVis) & (c.singleton # NIL) THEN
- c.bVis := show;
- c.view.GetRect(f, c.singleton, l, t, r, b);
- IF (l # MAX(INTEGER)) & (t # MAX(INTEGER)) THEN
- Mechanisms.MarkSingletonBorder(f, c.singleton, l, t, r, b, show)
- END
- END
- END MarkSingleton;
- PROCEDURE FadeMarks* (c: Controller; show: BOOLEAN);
- VAR msg: FadeMsg; v: Views.View; fc: Controller;
- BEGIN
- IF (c.focus # NIL) OR (c.singleton # NIL) THEN
- IF c.bVis # show THEN
- IF ~show THEN
- v := c.focus;
- WHILE (v # NIL) & (v IS View) DO
- fc := v(View).ThisController();
- fc.bVis := FALSE; v := fc.focus
- END
- END;
- c.bVis := show; msg.show := show; Views.Broadcast(c.view, msg)
- END
- END
- END FadeMarks;
- (* handle controller messages in editor mode *)
- PROCEDURE ClaimFocus (v: Views.View): BOOLEAN;
- VAR p: Properties.FocusPref;
- BEGIN
- p.atLocation := FALSE;
- p.hotFocus := FALSE; p.setFocus := FALSE;
- Views.HandlePropMsg(v, p);
- RETURN p.setFocus
- END ClaimFocus;
-
- PROCEDURE ClaimFocusAt (v: Views.View; f, g: Views.Frame; x, y: INTEGER; mask: BOOLEAN): BOOLEAN;
- VAR p: Properties.FocusPref;
- BEGIN
- p.atLocation := TRUE; p.x := x + f.gx - g.gx; p.y := y + f.gy - g.gy;
- p.hotFocus := FALSE; p.setFocus := FALSE;
- Views.HandlePropMsg(v, p);
- RETURN p.setFocus & (mask OR ~p.hotFocus)
- END ClaimFocusAt;
-
- PROCEDURE NeedFocusAt (v: Views.View; f, g: Views.Frame; x, y: INTEGER): BOOLEAN;
- VAR p: Properties.FocusPref;
- BEGIN
- p.atLocation := TRUE; p.x := x + f.gx - g.gx; p.y := y + f.gy - g.gy;
- p.hotFocus := FALSE; p.setFocus := FALSE;
- Views.HandlePropMsg(v, p);
- RETURN p.hotFocus OR p.setFocus
- END NeedFocusAt;
- PROCEDURE TrackToResize (c: Controller; f: Views.Frame; v: Views.View; x, y: INTEGER; buttons: SET);
- VAR minW, maxW, minH, maxH, l, t, r, b, w0, h0, w, h: INTEGER; op: INTEGER; sg, fc: Views.View;
- BEGIN
- c.model.GetEmbeddingLimits(minW, maxW, minH, maxH);
- c.view.GetRect(f, v, l, t, r, b);
- w0 := r - l; h0 := b - t; w := w0; h := h0;
- Mechanisms.TrackToResize(f, v, minW, maxW, minH, maxH, l, t, r, b, op, x, y, buttons);
- IF op = Mechanisms.resize THEN
- sg := c.singleton; fc := c.focus;
- c.Resize(v, l, t, r, b);
- IF c.singleton # sg THEN c.SetSingleton(sg) END;
- IF c.focus # fc THEN c.focus := fc; c.bVis := FALSE END (* delayed c.SetFocus(fc) *)
- END
- END TrackToResize;
- PROCEDURE TrackToDrop (c: Controller; f: Views.Frame; VAR x, y: INTEGER; buttons: SET;
- VAR pass: BOOLEAN);
- VAR dest: Views.Frame; m: Models.Model; v: Views.View;
- x0, y0, x1, y1, w, h, rx, ry, destX, destY: INTEGER; op: INTEGER; isDown, isSingle: BOOLEAN; mo: SET;
- BEGIN (* drag and drop c's selection: mouse is in selection *)
- x0 := x; y0 := y;
- REPEAT
- f.Input(x1, y1, mo, isDown)
- UNTIL ~isDown OR (ABS(x1 - x) > 3 * Ports.point) OR (ABS(y1 - y) > 3 * Ports.point);
- pass := ~isDown;
- IF ~pass THEN
- v := c.Singleton();
- IF v = NIL THEN v := c.view; isSingle := FALSE
- ELSE isSingle := TRUE
- END;
- c.GetSelectionBounds(f, rx, ry, w, h);
- rx := x0 - rx; ry := y0 - ry;
- IF rx < 0 THEN rx := 0 ELSIF rx > w THEN rx := w END;
- IF ry < 0 THEN ry := 0 ELSIF ry > h THEN ry := h END;
- IF noCaret IN c.opts THEN op := Mechanisms.copy ELSE op := 0 END;
- Mechanisms.TrackToDrop(f, v, isSingle, w, h, rx, ry, dest, destX, destY, op, x, y, buttons);
- IF (op IN {Mechanisms.copy, Mechanisms.move}) THEN (* copy or move selection *)
- IF dest # NIL THEN
- m := dest.view.ThisModel();
- IF (dest.view = c.view) OR (m # NIL) & (m = c.view.ThisModel()) THEN (* local drop *)
- IF op = Mechanisms.copy THEN (* local copy *)
- c.CopyLocalSelection(f, dest, x0, y0, destX, destY)
- ELSIF op = Mechanisms.move THEN (* local move *)
- c.MoveLocalSelection(f, dest, x0, y0, destX, destY)
- END
- ELSE (* non-local drop *)
- CopyView(c, v, w, h); (* create copy of selection *)
- IF (op = Mechanisms.copy) OR (noCaret IN c.opts) THEN (* drop copy *)
- Controllers.Drop(x, y, f, x0, y0, v, isSingle, w, h, rx, ry)
- ELSIF op = Mechanisms.move THEN (* drop copy and delete original *)
- Controllers.Drop(x, y, f, x0, y0, v, isSingle, w, h, rx, ry);
- c.DeleteSelection;
- END
- END
- ELSIF (op = Mechanisms.move) & ~(noCaret IN c.opts) THEN
- c.DeleteSelection
- END
- END
- END
- END TrackToDrop;
- PROCEDURE TrackToPick (c: Controller; f: Views.Frame; x, y: INTEGER; buttons: SET;
- VAR pass: BOOLEAN);
- VAR p: Properties.Property; dest: Views.Frame; x0, y0, x1, y1, destX, destY: INTEGER;
- op: INTEGER; isDown: BOOLEAN; m: SET;
- BEGIN
- x0 := x; y0 := y;
- REPEAT
- f.Input(x1, y1, m, isDown)
- UNTIL ~isDown OR (ABS(x1 - x) > 3 * Ports.point) OR (ABS(y1 - y) > 3 * Ports.point);
- pass := ~isDown;
- IF ~pass THEN
- Mechanisms.TrackToPick(f, dest, destX, destY, op, x, y, buttons);
- IF op IN {Mechanisms.pick, Mechanisms.pickForeign} THEN
- Properties.Pick(x, y, f, x0, y0, p);
- IF p # NIL THEN SetProp(c, NIL, p, direct) END
- END
- END
- END TrackToPick;
- PROCEDURE MarkViews (f: Views.Frame);
- VAR x, y: INTEGER; isDown: BOOLEAN; root: Views.RootFrame; m: SET;
- BEGIN
- root := Views.RootOf(f);
- Views.MarkBorders(root);
- REPEAT f.Input(x, y, m, isDown) UNTIL ~isDown;
- Views.MarkBorders(root)
- END MarkViews;
- PROCEDURE Track (c: Controller; f: Views.Frame; VAR msg: Controllers.TrackMsg; VAR focus: Views.View);
- VAR res, l, t, r, b: INTEGER; cursor: INTEGER; sel: Views.View; obj: Views.Frame;
- inSel, pass, extend, add, double, popup: BOOLEAN;
- BEGIN
- cursor := Mechanisms.outside; sel := c.Singleton();
- IF focus # NIL THEN
- c.view.GetRect(f, focus, l, t, r, b);
- IF (BorderVisible(c, f) OR (f IS Views.RootFrame)) & ~(noSelection IN c.opts) THEN
- cursor := Mechanisms.FocusBorderCursor(f, focus, l, t, r, b, msg.x, msg.y)
- ELSIF (msg.x >= l) & (msg.x <= r) & (msg.y >= t) & (msg.y <= b) THEN
- cursor := Mechanisms.inside
- END
- ELSIF sel # NIL THEN
- c.view.GetRect(f, sel, l, t, r, b);
- cursor := Mechanisms.SelBorderCursor(f, sel, l, t, r, b, msg.x, msg.y)
- END;
- IF cursor >= 0 THEN
- IF focus # NIL THEN
- (* resize focus *)
- TrackToResize(c, f, focus, msg.x, msg.y, msg.modifiers);
- focus := NIL
- ELSE
- (* resize singleton *)
- TrackToResize(c, f, sel, msg.x, msg.y, msg.modifiers)
- END
- ELSIF (focus # NIL) & (cursor = Mechanisms.inside) THEN
- (* forward to focus *)
- ELSE
- IF (focus # NIL) & (c.opts * modeOpts # mask) THEN c.SetFocus(NIL) END;
- focus := NIL;
- inSel := c.InSelection(f, msg.x, msg.y);
- extend := Controllers.extend IN msg.modifiers;
- add := Controllers.modify IN msg.modifiers;
- double := Controllers.doubleClick IN msg.modifiers;
- popup := right IN msg.modifiers;
- obj := Views.FrameAt(f, msg.x, msg.y);
- IF ~inSel & (~extend OR (noSelection IN c.opts)) THEN
- IF obj # NIL THEN
- IF ~(noFocus IN c.opts) & NeedFocusAt(obj.view, f, obj, msg.x, msg.y)
- & (~(alt IN msg.modifiers) OR (noSelection IN c.opts)) THEN
- (* set hot focus *)
- focus := obj.view;
- IF ClaimFocusAt(focus, f, obj, msg.x, msg.y, c.opts * modeOpts = mask) THEN
- (* set permanent focus *)
- c.SelectAll(deselect);
- c.SetFocus(focus)
- END
- END;
- IF (focus = NIL) & ~add & ~(noSelection IN c.opts) THEN
- (* select object *)
- c.SelectAll(deselect);
- c.SetSingleton(obj.view); inSel := TRUE
- END
- ELSIF ~add THEN c.SelectAll(deselect)
- END
- END;
- IF focus = NIL THEN
- IF inSel & double & (popup OR (alt IN msg.modifiers)) THEN (* properties *)
- Dialog.Call("StdCmds.ShowProp", "", res)
- ELSIF inSel & double & (obj # NIL) THEN (* primary verb *)
- Dialog.Call("HostMenus.PrimaryVerb", "", res)
- ELSIF ~inSel & (alt IN msg.modifiers) & extend THEN
- MarkViews(f)
- ELSE
- IF inSel & ~extend THEN (* drag *)
- IF (alt IN msg.modifiers) OR (middle IN msg.modifiers) THEN
- IF ~(noCaret IN c.opts) THEN
- TrackToPick(c, f, msg.x, msg.y, msg.modifiers, pass)
- END
- ELSE
- TrackToDrop(c, f, msg.x, msg.y, msg.modifiers, pass)
- END;
- IF ~pass THEN RETURN END
- END;
- IF ~(noSelection IN c.opts) & (~inSel OR extend OR add OR (obj = NIL) & ~popup) THEN (* select *)
- c.TrackMarks(f, msg.x, msg.y, double, extend, add)
- END;
- IF popup THEN Dialog.Call("HostMenus.PopupMenu", "", res) END
- END
- END
- END
- END Track;
- PROCEDURE CopyView (source: Controller; VAR view: Views.View; VAR w, h: INTEGER);
- VAR s: Views.View; m: Model; v: View; p: Properties.BoundsPref;
- BEGIN
- s := source.Singleton();
- IF s # NIL THEN (* create a copy of singular selection *)
- view := Views.CopyOf(s, Views.deep); s.context.GetSize(w, h)
- ELSE (* create a copy of view with a copy of whole selection as contents *)
- m := source.SelectionCopy();
- v := Views.CopyWithNewModel(source.view, m)(View);
- p.w := Views.undefined; p.h := Views.undefined; Views.HandlePropMsg(v, p);
- view := v; w := p.w; h := p.h
- END
- END CopyView;
- PROCEDURE Paste (c: Controller; f: Views.Frame; v: Views.View; w, h: INTEGER);
- VAR m: Models.Model;
- BEGIN
- m := v.ThisModel();
- IF (m # NIL) & c.NativeModel(m) THEN
- (* paste whole contents of source view *)
- c.NativePaste(m, f)
- ELSE
- (* paste whole view *)
- c.PasteView(f, v (* Views.CopyOf(v, Views.deep) *), w, h)
- END
- END Paste;
- PROCEDURE GetValidOps (c: Controller; VAR valid: SET);
- BEGIN
- valid := {}; c.GetValidOps(valid);
- IF noCaret IN c.opts THEN
- valid := valid
- - {Controllers.pasteChar, Controllers.pasteChar,
- Controllers.paste, Controllers.cut}
- END
- END GetValidOps;
- PROCEDURE Transfer (c: Controller; f: Views.Frame;
- VAR msg: Controllers.TransferMessage; VAR focus: Views.View);
- VAR g: Views.Frame; inSelection: BOOLEAN; dMsg: DropPref;
- BEGIN
- focus := NIL;
- g := Views.FrameAt(f, msg.x, msg.y);
- WITH msg: Controllers.PollDropMsg DO
- inSelection := c.InSelection(f, msg.x, msg.y);
- dMsg.mode := c.opts; dMsg.okToDrop := FALSE;
- IF g # NIL THEN Views.HandlePropMsg(g.view, dMsg) END;
- IF (g # NIL) & ~inSelection & (dMsg.okToDrop OR ~(noFocus IN c.opts))THEN
- focus := g.view
- ELSIF ~(noCaret IN c.opts) & c.CanDrop(f, msg.x, msg.y) THEN
- msg.dest := f;
- IF msg.mark THEN
- c.MarkDropTarget(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.w, msg.h, msg.rx, msg.ry,
- msg.type, msg.isSingle, msg.show)
- END
- END
- | msg: Controllers.DropMsg DO
- inSelection := c.InSelection(f, msg.x, msg.y);
- dMsg.mode := c.opts; dMsg.okToDrop := FALSE;
- IF g # NIL THEN Views.HandlePropMsg(g.view, dMsg) END;
- IF (g # NIL) & ~inSelection & (dMsg.okToDrop OR ~(noFocus IN c.opts))THEN
- focus := g.view
- ELSIF ~(noCaret IN c.opts) & c.CanDrop(f, msg.x, msg.y) THEN
- c.Drop(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.w, msg.h,
- msg.rx, msg.ry, msg.view, msg.isSingle)
- END
- | msg: Properties.PollPickMsg DO
- IF g # NIL THEN
- focus := g.view
- ELSE
- msg.dest := f;
- IF msg.mark THEN
- c.MarkPickTarget(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.show)
- END
- END
- | msg: Properties.PickMsg DO
- IF g # NIL THEN
- focus := g.view
- ELSE
- c.PickNativeProp(f, msg.x, msg.y, msg.prop)
- END
- ELSE
- IF g # NIL THEN focus := g.view END
- END
- END Transfer;
- PROCEDURE FocusHasSel (): BOOLEAN;
- VAR msg: Controllers.PollOpsMsg;
- BEGIN
- Controllers.PollOps(msg);
- RETURN msg.selectable & (Controllers.copy IN msg.valid)
- END FocusHasSel;
-
- PROCEDURE FocusEditor (): Controller;
- VAR msg: PollFocusMsg;
- BEGIN
- msg.focus := NIL; msg.ctrl := NIL; msg.all := FALSE;
- Controllers.Forward(msg);
- RETURN msg.ctrl
- END FocusEditor;
- PROCEDURE Edit (c: Controller; f: Views.Frame;
- VAR msg: Controllers.EditMsg; VAR focus: Views.View);
- VAR g: Views.Frame; v: Views.View; res: INTEGER;
- valid: SET; select, units, getFocus, accepts: BOOLEAN;
- sel: Controllers.SelectMsg;
- BEGIN
- IF (c.opts * modeOpts # mask) & (focus = NIL) THEN
- IF (msg.op = Controllers.pasteChar) & (msg.char = ESC) THEN
- c.SelectAll(FALSE)
- ELSIF (c.Singleton() # NIL) & (msg.op = Controllers.pasteChar) &
- (msg.char = ENTER) THEN
- Dialog.Call("HostMenus.PrimaryVerb", "", res)
- ELSE
- GetValidOps(c, valid);
- IF msg.op IN valid THEN
- CASE msg.op OF
- | Controllers.pasteChar:
- IF msg.char >= " " THEN
- c.PasteChar(msg.char)
- ELSIF (AL <= msg.char) & (msg.char <= AD) OR
- (PL <= msg.char) & (msg.char <= DD) THEN
- select := Controllers.extend IN msg.modifiers;
- units := Controllers.modify IN msg.modifiers;
- c.ArrowChar(f, msg.char, units, select)
- ELSE c.ControlChar(f, msg.char)
- END
- | Controllers.cut, Controllers.copy:
- CopyView(c, msg.view, msg.w, msg.h);
- msg.isSingle := c.Singleton() # NIL;
- IF msg.op = Controllers.cut THEN c.DeleteSelection END
- | Controllers.paste:
- IF msg.isSingle THEN
- c.PasteView(f, msg.view (* Views.CopyOf(msg.view, Views.deep) *), msg.w, msg.h)
- ELSE
- Paste(c, f, msg.view, msg.w, msg.h)
- END
- ELSE
- END
- END
- END
- ELSIF (c.opts * modeOpts # mask)
- & (msg.op = Controllers.pasteChar) & (msg.char = ESC)
- & (~(f IS Views.RootFrame) OR (31 IN c.opts))
- & (c = FocusEditor())
- & ((Controllers.extend IN msg.modifiers) OR ~FocusHasSel()) THEN
- IF 31 IN c.opts THEN INCL(msg.modifiers, 31)
- ELSE c.SetSingleton(focus)
- END;
- focus := NIL
- ELSIF (c.opts * modeOpts # mask) & (c = Focus()) THEN
- (* do some generic processing for non-container views *)
- IF (msg.op = Controllers.pasteChar) & (msg.char = ESC) THEN
- g := Views.ThisFrame(f, focus);
- IF g # NIL THEN sel.set := FALSE; Views.ForwardCtrlMsg(g, sel) END
- END
- ELSIF (c.opts * modeOpts = mask) & (msg.op = Controllers.pasteChar) THEN
- IF alt IN msg.modifiers THEN
- CollectControlPref (c, NIL, msg.char, TRUE, v, getFocus, accepts)
- ELSE
- CollectControlPref (c, focus, msg.char, TRUE, v, getFocus, accepts)
- END;
- IF v = NIL THEN
- CheckMaskFocus(c, f, focus);
- CollectControlPref(c, focus, msg.char, TRUE, v, getFocus, accepts)
- END;
- IF v # NIL THEN
- IF getFocus & (v # focus) THEN
- c.SetFocus(v)
- END;
- IF accepts THEN
- g := Views.ThisFrame(f, v);
- IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END
- END;
- focus := NIL
- END
- END
- END Edit;
- PROCEDURE PollCursor (c: Controller; f: Views.Frame; VAR msg: Controllers.PollCursorMsg; VAR focus: Views.View);
- VAR l, t, r, b: INTEGER; cursor: INTEGER; sel: Views.View; obj: Views.Frame; inSel: BOOLEAN;
- BEGIN
- cursor := Mechanisms.outside; sel := c.Singleton();
- IF focus # NIL THEN
- c.view.GetRect(f, focus, l, t, r, b);
- IF (BorderVisible(c, f) OR (f IS Views.RootFrame)) & ~(noSelection IN c.opts) THEN
- cursor := Mechanisms.FocusBorderCursor(f, focus, l, t, r, b, msg.x, msg.y)
- ELSIF (msg.x >= l) & (msg.x <= r) & (msg.y >= t) & (msg.y <= b) THEN
- cursor := Mechanisms.inside
- END
- ELSIF sel # NIL THEN
- c.view.GetRect(f, sel, l, t, r, b);
- cursor := Mechanisms.SelBorderCursor(f, sel, l, t, r, b, msg.x, msg.y)
- END;
- IF cursor >= 0 THEN
- msg.cursor := cursor; focus := NIL
- ELSIF (focus # NIL) & (cursor = Mechanisms.inside) THEN
- msg.cursor := Ports.arrowCursor
- ELSE
- IF noCaret IN c.opts THEN msg.cursor := Ports.arrowCursor
- ELSE msg.cursor := c.NativeCursorAt(f, msg.x, msg.y) (* if nothing else, use native cursor *)
- END;
- focus := NIL; inSel := FALSE;
- IF ~(noSelection IN c.opts) THEN inSel := c.InSelection(f, msg.x, msg.y) END;
- IF ~inSel THEN
- obj := Views.FrameAt(f, msg.x, msg.y);
- IF obj # NIL THEN
- IF ~(noFocus IN c.opts) & NeedFocusAt(obj.view, f, obj, msg.x, msg.y) THEN
- focus := obj.view;
- msg.cursor := Ports.arrowCursor
- ELSIF ~(noSelection IN c.opts) THEN
- inSel := TRUE
- END
- END
- END;
- IF focus = NIL THEN
- IF inSel THEN
- msg.cursor := Ports.arrowCursor
- END
- END
- END
- END PollCursor;
- PROCEDURE PollOps (c: Controller; f: Views.Frame;
- VAR msg: Controllers.PollOpsMsg; VAR focus: Views.View);
- BEGIN
- IF focus = NIL THEN
- msg.type := "";
- IF ~(noSelection IN c.opts) THEN c.GetContextType(msg.type) END;
- msg.selectable := ~(noSelection IN c.opts) & c.Selectable();
- GetValidOps(c, msg.valid);
- msg.singleton := c.Singleton()
- END
- END PollOps;
- PROCEDURE ReplaceView (c: Controller; old, new: Views.View);
- BEGIN
- ASSERT(old.context # NIL, 20);
- ASSERT((new.context = NIL) OR (new.context = old.context), 22);
- IF old.context.ThisModel() = c.model THEN
- c.model.ReplaceView(old, new)
- END;
- IF c.singleton = old THEN c.singleton := new END;
- IF c.focus = old THEN c.focus := new END
- END ReplaceView;
- PROCEDURE ViewProp (v: Views.View): Properties.Property;
- VAR poll: Properties.PollMsg;
- BEGIN
- poll.prop := NIL; Views.HandlePropMsg(v, poll); RETURN poll.prop
- END ViewProp;
- PROCEDURE SetViewProp (v: Views.View; old, p: Properties.Property);
- VAR set: Properties.SetMsg;
- BEGIN
- set.old := old; set.prop := p; Views.HandlePropMsg(v, set)
- END SetViewProp;
- PROCEDURE SizeProp (v: Views.View): Properties.Property;
- VAR sp: Properties.SizeProp;
- BEGIN
- NEW(sp); sp.known := {Properties.width, Properties.height}; sp.valid := sp.known;
- v.context.GetSize(sp.width, sp.height);
- RETURN sp
- END SizeProp;
- PROCEDURE SetSizeProp (v: Views.View; p: Properties.SizeProp);
- VAR w, h: INTEGER;
- BEGIN
- IF p.valid # {Properties.width, Properties.height} THEN
- v.context.GetSize(w, h)
- END;
- IF Properties.width IN p.valid THEN w := p.width END;
- IF Properties.height IN p.valid THEN h := p.height END;
- v.context.SetSize(w, h)
- END SetSizeProp;
- PROCEDURE ThisProp (c: Controller; direct: BOOLEAN): Properties.Property;
- CONST scanCutoff = MAX(INTEGER) (* 50 *); (* bound number of polled embedded views *)
- VAR v: Views.View; np, vp, p: Properties.Property; k: INTEGER; trunc, equal: BOOLEAN;
- BEGIN
- trunc := FALSE; k := 1;
- np := NIL; c.PollNativeProp(direct, np, trunc);
- v := NIL; c.GetFirstView(direct, v);
- IF v # NIL THEN
- Properties.Insert(np, SizeProp(v));
- vp := ViewProp(v);
- k := scanCutoff; c.GetNextView(direct, v);
- WHILE (v # NIL) & (k > 0) DO
- DEC(k);
- Properties.Insert(np, SizeProp(v));
- Properties.Intersect(vp, ViewProp(v), equal);
- c.GetNextView(direct, v)
- END;
- IF c.singleton # NIL THEN Properties.Merge(np, vp); vp := np
- ELSE Properties.Merge(vp, np)
- END
- ELSE vp := np
- END;
- IF trunc OR (k = 0) THEN
- p := vp; WHILE p # NIL DO p.valid := {}; p := p.next END
- END;
- IF noCaret IN c.opts THEN
- p := vp; WHILE p # NIL DO p.readOnly := p.valid; p := p.next END
- END;
- RETURN vp
- END ThisProp;
- PROCEDURE SetProp (c: Controller; old, p: Properties.Property; direct: BOOLEAN);
- TYPE
- ViewList = POINTER TO RECORD next: ViewList; view: Views.View END;
- VAR v: Views.View; q, sp: Properties.Property; equal: BOOLEAN; s: Stores.Operation;
- list, last: ViewList;
- BEGIN
- IF noCaret IN c.opts THEN RETURN END;
- Views.BeginScript(c.view, "#System:SetProp", s);
- q := p; WHILE (q # NIL) & ~(q IS Properties.SizeProp) DO q := q.next END;
- list := NIL; v := NIL; c.GetFirstView(direct, v);
- WHILE v # NIL DO
- IF list = NIL THEN NEW(list); last := list
- ELSE NEW(last.next); last := last.next
- END;
- last.view := v;
- c.GetNextView(direct, v)
- END;
- c.SetNativeProp(direct, old, p);
- WHILE list # NIL DO
- v := list.view; list := list.next;
- SetViewProp(v, old, p);
- IF direct & (q # NIL) THEN
- (* q IS Properties.SizeProp *)
- IF old # NIL THEN
- sp := SizeProp(v);
- Properties.Intersect(sp, old, equal);
- Properties.Intersect(sp, old, equal)
- END;
- IF (old = NIL) OR equal THEN
- SetSizeProp(v, q(Properties.SizeProp))
- END
- END
- END;
- Views.EndScript(c.view, s)
- END SetProp;
- PROCEDURE (c: Controller) HandleCtrlMsg* (f: Views.Frame;
- VAR msg: Controllers.Message; VAR focus: Views.View), NEW, EXTENSIBLE;
- BEGIN
- focus := c.focus;
- WITH msg: Controllers.PollCursorMsg DO
- PollCursor(c, f, msg, focus)
- | msg: Controllers.PollOpsMsg DO
- PollOps(c, f, msg, focus)
- | msg: PollFocusMsg DO
- IF msg.all OR (c.opts * modeOpts # mask) & (c.focus # NIL) THEN msg.ctrl := c END
- | msg: Controllers.TrackMsg DO
- Track(c, f, msg, focus)
- | msg: Controllers.EditMsg DO
- Edit(c, f, msg, focus)
- | msg: Controllers.TransferMessage DO
- Transfer(c, f, msg, focus)
- | msg: Controllers.SelectMsg DO
- IF focus = NIL THEN c.SelectAll(msg.set) END
- | msg: Controllers.TickMsg DO
- FadeMarks(c, show);
- CheckMaskFocus(c, f, focus)
- | msg: Controllers.MarkMsg DO
- c.bVis := msg.show;
- c.Mark(f, f.l, f.t, f.r, f.b, msg.show)
- | msg: Controllers.ReplaceViewMsg DO
- ReplaceView(c, msg.old, msg.new)
- | msg: Properties.CollectMsg DO
- IF focus = NIL THEN
- msg.poll.prop := ThisProp(c, direct)
- END
- | msg: Properties.EmitMsg DO
- IF focus = NIL THEN
- SetProp(c, msg.set.old, msg.set.prop, direct)
- END
- ELSE
- END
- END HandleCtrlMsg;
- (** miscellaneous **)
- PROCEDURE Focus* (): Controller;
- VAR msg: PollFocusMsg;
- BEGIN
- msg.focus := NIL; msg.ctrl := NIL; msg.all := TRUE;
- Controllers.Forward(msg);
- RETURN msg.ctrl
- END Focus;
- PROCEDURE FocusSingleton* (): Views.View;
- VAR c: Controller; v: Views.View;
- BEGIN
- c := Focus();
- IF c # NIL THEN v := c.Singleton() ELSE v := NIL END;
- RETURN v
- END FocusSingleton;
-
- PROCEDURE CloneOf* (m: Model): Model;
- VAR h: Model;
- BEGIN
- ASSERT(m # NIL, 20);
- Kernel.NewObj(h, Kernel.TypeOf(m));
- h.InitFrom(m);
- RETURN h
- END CloneOf;
- END Containers.
|