Obx/Mod/Wrappers.odc

MODULE ObxWrappers;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT Dialog, Stores, Models, Views, Controllers, Properties, StdLog;

	CONST minVersion = 2; maxVersion = 2;

	TYPE
		View = POINTER TO RECORD (Views.View)
			inner: Views.View	(* v # NIL *)
		END;

	PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
		VAR version: INTEGER;
	BEGIN
		rd.ReadVersion(minVersion, maxVersion, version);
		IF ~rd.cancelled THEN
			Views.ReadView(rd, v.inner)	(* generate Views.Alien if necessary *)
		END
	END Internalize;

	PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteVersion(maxVersion);
		Views.WriteView(wr, v.inner)	(* handle Views.Alien if necessary *)
	END Externalize;

	PROCEDURE (v: View) CopyFromModelView (source: Views.View; model: Models.Model);
	BEGIN
		WITH source: View DO
			IF model = NIL THEN
				v.inner := Views.CopyOf(source.inner, Views.deep)
			ELSE
				v.inner := Views.CopyWithNewModel(source.inner, model)
			END
		END
	END CopyFromModelView;

	PROCEDURE (v: View) ThisModel (): Models.Model;
	BEGIN
		RETURN v.inner.ThisModel()
	END ThisModel;

	PROCEDURE (v: View) InitContext (context: Models.Context);
	BEGIN
		v.InitContext^(context);
		v.inner.InitContext(context)	(* wrapper and wrapped view share the same context *)
	END InitContext;

	PROCEDURE (v: View) Neutralize;
	BEGIN
		v.inner.Neutralize
	END Neutralize;

	(* GetNewFrame: wrapper uses standard frame *)
	(* GetBackground: wrapper has no intrinsic background color *)

	PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
	BEGIN
		Views.InstallFrame(f, v.inner, 0, 0, 0, TRUE)	(* create and install wrapped view's frame *)
	END Restore;

	(* RestoreMarks: wrapper has no intrinsic marks, wrapped view's RestoreMarks is called by framework *)
	(* HandleModelMsg: framework performs message propagation *)
	(* HandleViewMsg: framework performs message propagation *)

	PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
	BEGIN
		(* here comes the behavior which is specific to this wrapper -
			it modifies the wrapped view's behavior *)
		WITH msg: Controllers.EditMsg DO
			(* sample special behavior: copy typing into log *)
			IF msg.op = Controllers.pasteChar THEN StdLog.Char(msg.char); StdLog.Ln END	
		ELSE
		END;
		focus := v.inner	(* forward all controller messages to wrapped view *)
	END HandleCtrlMsg;

	PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
	BEGIN
		Views.HandlePropMsg(v.inner, msg)	(* forward all property messages to wrapped view *)
	END HandlePropMsg;


	PROCEDURE Wrap*;
		VAR poll: Controllers.PollOpsMsg; w: View; replace: Controllers.ReplaceViewMsg;
	BEGIN
		Controllers.PollOps(poll);
		IF (poll.singleton # NIL) & ~(poll.singleton IS View) THEN
			NEW(w); w.inner := poll.singleton; Stores.Join(w, w.inner);
			replace.old := poll.singleton; replace.new := w;
			Controllers.Forward(replace)
		ELSE Dialog.Beep
		END
	END Wrap;

	PROCEDURE Unwrap*;
		VAR poll: Controllers.PollOpsMsg; replace: Controllers.ReplaceViewMsg;
	BEGIN
		Controllers.PollOps(poll);
		IF (poll.singleton # NIL) & (poll.singleton IS View) THEN
			replace.old := poll.singleton; replace.new := poll.singleton(View).inner;
			Controllers.Forward(replace)
		ELSE Dialog.Beep
		END
	END Unwrap;

END ObxWrappers.