MODULE Containers;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- 20160719, center #117, fixes for non-local drop behavior
	- 20170905, center #173, adding new modifiers to Controllers
	- 20210425, ad, replaced soft links to HostMenus with soft links to StdMenuTool
	"
	issues	= "
	- ...
	"

**)

	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;

	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;
			script: Stores.Operation;
	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 *)
							IF (c.view.Domain() # NIL) & (c.view.Domain() = dest.view.Domain()) THEN
								Views.BeginScript(c.view, "#System:Moving", script)
							ELSE script := NIL
							END;
							c.DeleteSelection; (* delete first because Controllers.Drop can remove the selection *)
							Controllers.Drop(x, y, f, x0, y0, v, isSingle, w, h, rx, ry);
							IF script # NIL THEN Views.EndScript(c.view, script) END
						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, pick: 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 := Controllers.popup IN msg.modifiers;
			pick := Controllers.pick 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)
							& (~pick 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 pick) THEN (* properties *)
					Dialog.Call("StdCmds.ShowProp", "", res)
				ELSIF inSel & double & (obj # NIL) THEN (* primary verb *)
					Dialog.Call("StdMenuTool.PrimaryVerb", "", res)
				ELSIF ~inSel & pick & extend THEN
					MarkViews(f)
				ELSE
					IF inSel & ~extend THEN (* drag *)
						IF pick 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("StdMenuTool.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
				c.SetFocus(g.view);
				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("StdMenuTool.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 Controllers.pick 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 Wheel (c: Controller; f: Views.Frame;
			VAR msg: Controllers.WheelMsg; VAR focus: Views.View);
		VAR g: Views.Frame; dx, dy: INTEGER;
	BEGIN
		g := Views.FrameAt(f, msg.x, msg.y);
		IF g # NIL THEN focus := g.view; ASSERT(focus.context.ThisModel() = c.model, 20) END
	END Wheel;

	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
		| msg: Controllers.WheelMsg DO Wheel(c, f, msg, focus)
		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.
