modules added from BlackBox System/Mod

BlackBox/System/Mod/Containers.txt

@@ -0,0 +1,1381 @@
+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.

BlackBox/System/Mod/Controllers.txt

@@ -0,0 +1,426 @@
+MODULE Controllers;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Controllers.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Kernel, Services, Ports, Stores, Models, Views;
+
+	CONST
+		(** Forward target **)
+		targetPath* = TRUE; frontPath* = FALSE;
+
+		(** ScrollMsg.op **)
+		decLine* = 0; incLine* = 1; decPage* = 2; incPage* = 3; gotoPos* = 4;
+
+		(** PageMsg.op **)
+		nextPageX* = 0; nextPageY* = 1; gotoPageX* = 2; gotoPageY* = 3;
+
+		(** PollOpsMsg.valid, EditMsg.op **)
+		cut* = 0; copy* = 1;
+		pasteChar* = 2; (* pasteLChar* = 3; *) paste* = 4; (* pasteView* = 5; *)
+
+		(** TrackMsg.modifiers, EditMsg.modifiers **)
+		doubleClick* = 0;	(** clicking history **)
+		extend* = 1; modify* = 2;	(** modifier keys **)
+		(* extend = Sub.extend; modify = Sub.modify *)
+
+		(** PollDropMsg.mark, PollDrop mark **)
+		noMark* = FALSE; mark* = TRUE;
+		(** PollDropMsg.show, PollDrop show **)
+		hide* = FALSE; show* = TRUE;
+
+		minVersion = 0; maxVersion = 0;
+
+
+	TYPE
+
+		(** messages **)
+
+		Message* = Views.CtrlMessage;
+
+		PollFocusMsg* = EXTENSIBLE RECORD (Message)
+			focus*: Views.Frame	(** OUT, preset to NIL **)
+		END;
+
+		PollSectionMsg* = RECORD (Message)
+			focus*, vertical*: BOOLEAN;	(** IN **)
+			wholeSize*: INTEGER;	(** OUT, preset to 1 **)
+			partSize*: INTEGER;	(** OUT, preset to 1 **)
+			partPos*: INTEGER;	(** OUT, preset to 0 **)
+			valid*, done*: BOOLEAN	(** OUT, preset to (FALSE, FALSE) **)
+		END;
+
+		PollOpsMsg* = RECORD (Message)
+			type*: Stores.TypeName;	(** OUT, preset to "" **)
+			pasteType*: Stores.TypeName;	(** OUT, preset to "" **)
+			singleton*: Views.View;	(** OUT, preset to NIL **)
+			selectable*: BOOLEAN;	(** OUT, preset to FALSE **)
+			valid*: SET	(** OUT, preset to {} **)
+		END;
+
+		ScrollMsg* = RECORD (Message)
+			focus*, vertical*: BOOLEAN;	(** IN **)
+			op*: INTEGER;	(** IN **)
+			pos*: INTEGER;	(** IN **)
+			done*: BOOLEAN	(** OUT, preset to FALSE **)
+		END;
+
+		PageMsg* = RECORD (Message)
+			op*: INTEGER;	(** IN **)
+			pageX*, pageY*: INTEGER;	(** IN **)
+			done*, eox*, eoy*: BOOLEAN	(** OUT, preset to (FALSE, FALSE, FALSE) **)
+		END;
+
+		TickMsg* = RECORD (Message)
+			tick*: INTEGER	(** IN **)
+		END;
+
+		MarkMsg* = RECORD (Message)
+			show*: BOOLEAN;	(** IN **)
+			focus*: BOOLEAN	(** IN **)
+		END;
+
+		SelectMsg* = RECORD (Message)
+			set*: BOOLEAN	(** IN **)
+		END;
+
+
+		RequestMessage* = ABSTRACT RECORD (Message)
+			requestFocus*: BOOLEAN	(** OUT, preset (by framework) to FALSE **)
+		END;
+
+		EditMsg* = RECORD (RequestMessage)
+			op*: INTEGER;	(** IN **)
+			modifiers*: SET;	(** IN, valid if op IN {pasteChar, pasteLchar} **)
+			char*: CHAR;	(** IN, valid if op = pasteChar **)
+			view*: Views.View; w*, h*: INTEGER;	(** IN, valid if op  = paste **)
+														(** OUT, valid if op IN {cut, copy} **)
+			isSingle*: BOOLEAN;	(** dito **)
+			clipboard*: BOOLEAN	(** IN, valid if op IN {cut, copy, paste} **)
+		END;
+
+		ReplaceViewMsg* = RECORD (RequestMessage)
+			old*, new*: Views.View	(** IN **)
+		END;
+
+
+		CursorMessage* = ABSTRACT RECORD (RequestMessage)
+			x*, y*: INTEGER	(** IN, needs translation when passed on **)
+		END;
+
+		PollCursorMsg* = RECORD (CursorMessage)
+			cursor*: INTEGER;	(** OUT, preset to Ports.arrowCursor **)
+			modifiers*: SET	(** IN **)
+		END;
+
+		TrackMsg* = RECORD (CursorMessage)
+			modifiers*: SET	(** IN **)
+		END;
+
+		WheelMsg* = RECORD (CursorMessage)
+			done*: BOOLEAN; 		(** must be set if the message is handled **)
+			op*, nofLines*: INTEGER;
+		END;
+
+
+		TransferMessage* = ABSTRACT RECORD (CursorMessage)
+			source*: Views.Frame;	(** IN, home frame of transfer originator, may be NIL if unknown **)
+			sourceX*, sourceY*: INTEGER	(** IN, reference point in source frame, defined if source # NIL **)
+		END;
+
+		PollDropMsg* = RECORD (TransferMessage)
+			mark*: BOOLEAN;	(** IN, request to mark drop target **)
+			show*: BOOLEAN;	(** IN, if mark then show/hide target mark **)
+			type*: Stores.TypeName;	(** IN, type of view to drop **)
+			isSingle*: BOOLEAN;	(** IN, view to drop is singleton **)
+			w*, h*: INTEGER;	(** IN, size of view to drop, may be 0, 0 **)
+			rx*, ry*: INTEGER;	(** IN, reference point in view **)
+			dest*: Views.Frame	(** OUT, preset to NIL, set if DropMsg is acceptable **)
+		END;
+
+		DropMsg* = RECORD (TransferMessage)
+			view*: Views.View;	(** IN, drop this *)
+			isSingle*: BOOLEAN;	(** IN, view to drop is singleton **)
+			w*, h*: INTEGER;	(** IN, proposed size *)
+			rx*, ry*: INTEGER	(** IN, reference point in view **)
+		END;
+
+
+		(** controllers **)
+
+		Controller* = POINTER TO ABSTRACT RECORD (Stores.Store) END;
+
+
+		(** forwarders **)
+
+		Forwarder* = POINTER TO ABSTRACT RECORD
+			next: Forwarder
+		END;
+
+		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
+		PathInfo = POINTER TO RECORD
+			path: BOOLEAN; prev: PathInfo
+		END;
+		
+		BalanceCheckAction = POINTER TO RECORD (Services.Action) 
+			wait: WaitAction
+		END;
+		WaitAction = POINTER TO RECORD (Services.Action) 
+			check: BalanceCheckAction
+		END;
+
+	VAR
+		path-: BOOLEAN;
+
+		list: Forwarder;
+		
+		cleaner: TrapCleaner;
+		prevPath, cache: PathInfo;
+		
+
+
+	(** BalanceCheckAction **)
+	
+	PROCEDURE (a: BalanceCheckAction) Do;
+	BEGIN
+		Services.DoLater(a.wait, Services.resolution);
+		ASSERT(prevPath = NIL, 100);
+	END Do;
+	
+	PROCEDURE (a: WaitAction) Do;
+	BEGIN
+		Services.DoLater(a.check, Services.immediately)
+	END Do;
+
+	(** Cleaner **)
+
+	PROCEDURE (c: TrapCleaner) Cleanup;
+	BEGIN
+		path := frontPath;
+		prevPath := NIL
+	END Cleanup;
+
+	PROCEDURE NewPathInfo(): PathInfo;
+		VAR c: PathInfo;
+	BEGIN
+		IF cache = NIL THEN NEW(c)
+		ELSE c := cache; cache := cache.prev
+		END;
+		RETURN c
+	END NewPathInfo;
+	
+	PROCEDURE DisposePathInfo(c: PathInfo);
+	BEGIN
+		c.prev := cache; cache := c
+	END DisposePathInfo;
+
+
+	(** Controller **)
+
+	PROCEDURE (c: Controller) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
+	(** pre: ~c.init **)
+	(** post: c.init **)
+		VAR thisVersion: INTEGER;
+	BEGIN
+		c.Internalize^(rd);
+		rd.ReadVersion(minVersion, maxVersion, thisVersion)
+	END Internalize;
+
+	PROCEDURE (c: Controller) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
+	(** pre: c.init **)
+	BEGIN
+		c.Externalize^(wr);
+		wr.WriteVersion(maxVersion)
+	END Externalize;
+
+
+	(** Forwarder **)
+
+	PROCEDURE (f: Forwarder) Forward* (target: BOOLEAN; VAR msg: Message), NEW, ABSTRACT;
+	PROCEDURE (f: Forwarder) Transfer* (VAR msg: TransferMessage), NEW, ABSTRACT;
+
+	PROCEDURE Register* (f: Forwarder);
+		VAR t: Forwarder;
+	BEGIN
+		ASSERT(f # NIL, 20);
+		t := list; WHILE (t # NIL) & (t # f) DO t := t.next END;
+		IF t = NIL THEN f.next := list; list := f END
+	END Register;
+
+	PROCEDURE Delete* (f: Forwarder);
+		VAR t: Forwarder;
+	BEGIN
+		ASSERT(f # NIL, 20);
+		IF f = list THEN
+			list := list.next
+		ELSE
+			t := list; WHILE (t # NIL) & (t.next # f) DO t := t.next END;
+			IF t # NIL THEN t.next := f.next END
+		END;
+		f.next := NIL
+	END Delete;
+
+
+	PROCEDURE ForwardVia* (target: BOOLEAN; VAR msg: Message);
+		VAR t: Forwarder;
+	BEGIN
+		t := list; WHILE t # NIL DO t.Forward(target, msg); t := t.next END
+	END ForwardVia;
+
+	PROCEDURE SetCurrentPath* (target: BOOLEAN);
+		VAR p: PathInfo;
+	BEGIN
+		IF prevPath = NIL THEN Kernel.PushTrapCleaner(cleaner) END;
+		p := NewPathInfo(); p.prev := prevPath; prevPath := p; p.path := path;
+		path := target
+	END SetCurrentPath;
+	
+	PROCEDURE ResetCurrentPath*;
+		VAR p: PathInfo;
+	BEGIN
+		IF prevPath # NIL THEN (* otherwise trap cleaner may have already removed prefPath objects *)
+			p := prevPath; prevPath := p.prev; path := p.path;
+			IF prevPath = NIL THEN Kernel.PopTrapCleaner(cleaner) END;
+			DisposePathInfo(p)
+		END
+	END ResetCurrentPath;
+
+	PROCEDURE Forward* (VAR msg: Message);
+	BEGIN
+		ForwardVia(path, msg)
+	END Forward;
+
+	PROCEDURE PollOps* (VAR msg: PollOpsMsg);
+	BEGIN
+		msg.type := "";
+		msg.pasteType := "";
+		msg.singleton := NIL;
+		msg.selectable := FALSE;
+		msg.valid := {};
+		Forward(msg)
+	END PollOps;
+
+	PROCEDURE PollCursor* (x, y: INTEGER; modifiers: SET; OUT cursor: INTEGER);
+		VAR msg: PollCursorMsg;
+	BEGIN
+		msg.x := x; msg.y := y; msg.cursor := Ports.arrowCursor; msg.modifiers := modifiers;
+		Forward(msg);
+		cursor := msg.cursor
+	END PollCursor;
+
+	PROCEDURE Transfer* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER; VAR msg: TransferMessage);
+		VAR t: Forwarder;
+	BEGIN
+		ASSERT(source # NIL, 20);
+		msg.x := x; msg.y := y;
+		msg.source := source; msg.sourceX := sourceX; msg.sourceY := sourceY;
+		t := list; WHILE t # NIL DO t.Transfer(msg); t := t.next END
+	END Transfer;
+
+	PROCEDURE PollDrop* (x, y: INTEGER;
+							source: Views.Frame; sourceX, sourceY: INTEGER;
+							mark, show: BOOLEAN;
+							type: Stores.TypeName;
+							isSingle: BOOLEAN;
+							w, h, rx, ry: INTEGER;
+							OUT dest: Views.Frame; OUT destX, destY: INTEGER);
+		VAR msg: PollDropMsg;
+	BEGIN
+		ASSERT(source # NIL, 20);
+		msg.mark := mark; msg.show := show; msg.type := type; msg.isSingle := isSingle;
+		msg.w := w; msg.h := h; msg.rx := rx; msg.ry := ry; msg.dest := NIL;
+		Transfer(x, y, source, sourceX, sourceY, msg);
+		dest := msg.dest; destX := msg.x; destY := msg.y
+	END PollDrop;
+
+	PROCEDURE Drop* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER;
+									view: Views.View; isSingle: BOOLEAN; w, h, rx, ry: INTEGER);
+		VAR msg: DropMsg;
+	BEGIN
+		ASSERT(source # NIL, 20); ASSERT(view # NIL, 21);
+		msg.view := view; msg.isSingle := isSingle;
+		msg.w := w; msg.h := h; msg.rx := rx; msg.ry := ry;
+		Transfer(x, y, source, sourceX, sourceY, msg)
+	END Drop;
+
+	PROCEDURE PasteView* (view: Views.View; w, h: INTEGER; clipboard: BOOLEAN);
+		VAR msg: EditMsg;
+	BEGIN
+		ASSERT(view # NIL, 20);
+		msg.op := paste; msg.isSingle := TRUE;
+		msg.clipboard := clipboard;
+		msg.view := view; msg.w := w; msg.h := h;
+		Forward(msg)
+	END PasteView;
+
+
+	PROCEDURE FocusFrame* (): Views.Frame;
+		VAR msg: PollFocusMsg;
+	BEGIN
+		msg.focus := NIL; Forward(msg); RETURN msg.focus
+	END FocusFrame;
+
+	PROCEDURE FocusView* (): Views.View;
+		VAR focus: Views.Frame;
+	BEGIN
+		focus := FocusFrame();
+		IF focus # NIL THEN RETURN focus.view ELSE RETURN NIL END
+	END FocusView;
+
+	PROCEDURE FocusModel* (): Models.Model;
+		VAR focus: Views.Frame;
+	BEGIN
+		focus := FocusFrame();
+		IF focus # NIL THEN RETURN focus.view.ThisModel() ELSE RETURN NIL END
+	END FocusModel;
+
+
+	PROCEDURE HandleCtrlMsgs (op: INTEGER; f, g: Views.Frame; VAR msg: Message; VAR mark, front, req: BOOLEAN);
+	(* g = f.up OR g = NIL *)
+		CONST pre = 0; translate = 1; backoff = 2; final = 3;
+	BEGIN
+		CASE op OF
+		  pre:
+			WITH msg: MarkMsg DO
+				IF msg.show & (g # NIL) THEN mark := TRUE; front := g.front END
+			| msg: RequestMessage DO
+				msg.requestFocus := FALSE
+			ELSE
+			END
+		| translate:
+			WITH msg: CursorMessage DO
+				msg.x := msg.x + f.gx - g.gx;
+				msg.y := msg.y + f.gy - g.gy
+			ELSE
+			END
+		| backoff:
+			WITH msg: MarkMsg DO
+				IF ~msg.show THEN mark := FALSE; front := FALSE END
+			| msg: RequestMessage DO
+				req := msg.requestFocus
+			ELSE
+			END
+		| final:
+			WITH msg: PollFocusMsg DO
+				IF msg.focus = NIL THEN msg.focus := f END
+			| msg: MarkMsg DO
+				IF ~msg.show THEN mark := FALSE; front := FALSE END
+			| msg: RequestMessage DO
+				req := msg.requestFocus
+			ELSE
+			END
+		END
+	END HandleCtrlMsgs;
+
+
+	PROCEDURE Init;
+		VAR action: BalanceCheckAction; w: WaitAction;
+	BEGIN
+		Views.InitCtrl(HandleCtrlMsgs);
+		NEW(cleaner);
+		NEW(action); NEW(w); action.wait := w; w.check := action; Services.DoLater(action, Services.immediately);
+	END Init;
+
+BEGIN
+	Init
+END Controllers.

BlackBox/System/Mod/Converters.txt

@@ -0,0 +1,105 @@
+MODULE Converters;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Converters.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Meta, Files, Stores, Dialog;
+
+	CONST
+		(* hints *)
+		importAll* = 0;	(* can import all file types *)
+		canceled = 8;
+
+	TYPE
+		Importer* = PROCEDURE (f: Files.File; OUT s: Stores.Store);
+		Exporter* = PROCEDURE (s: Stores.Store; f: Files.File);
+		Converter* = POINTER TO RECORD
+			next-: Converter;
+			imp-, exp-: Dialog.String;
+			storeType-: Stores.TypeName;
+			fileType-: Files.Type;
+			opts-: SET
+		END;
+
+		ImpVal = RECORD (Meta.Value) p: Importer END;
+		ExpVal = RECORD (Meta.Value) p: Exporter END;
+
+	VAR
+		list-: Converter;
+		doc: Converter;
+
+	PROCEDURE GetCommand (name: Dialog.String; VAR val: Meta.Value; VAR ok: BOOLEAN);
+		VAR i: Meta.Item;
+	BEGIN
+		Meta.LookupPath(name, i);
+		IF (i.obj = Meta.procObj) OR (i.obj = Meta.varObj) & (i.typ = Meta.procTyp) THEN
+			i.GetVal(val, ok)
+		ELSE ok := FALSE
+		END
+	END GetCommand;
+
+
+	PROCEDURE Register* (imp, exp: Dialog.String; storeType: Stores.TypeName; fileType: Files.Type; opts: SET);
+		VAR e, f: Converter;
+	BEGIN
+		ASSERT((imp # "") OR (exp # ""), 20); ASSERT(fileType # "", 21);
+		NEW(e); e.next := NIL;
+		e.imp := imp; e.exp := exp; e.fileType := fileType; e.storeType := storeType; e.opts := opts;
+		IF (storeType = "") & (doc = NIL) THEN doc := e END;
+		IF list = NIL THEN list := e
+		ELSE f := list;
+			WHILE f.next # NIL DO f := f.next END;
+			f.next := e
+		END
+	END Register;
+
+
+	PROCEDURE Import* (loc: Files.Locator; name: Files.Name; VAR conv: Converter; OUT s: Stores.Store);
+		VAR file: Files.File; val: ImpVal; ok: BOOLEAN;
+	BEGIN
+		ASSERT(loc # NIL, 20); ASSERT(name # "", 21);
+		file := Files.dir.Old(loc, name, Files.shared); s := NIL;
+		IF file # NIL THEN
+			IF conv = NIL THEN
+				conv := list;
+				WHILE (conv # NIL) & ((conv.fileType # file.type) OR (conv.imp = "")) DO conv := conv.next END;
+				IF conv = NIL THEN
+					conv := list; WHILE (conv # NIL) & ~(importAll IN conv.opts) DO conv := conv.next END
+				END
+			ELSE ASSERT(conv.imp # "", 22)
+			END;
+			IF conv # NIL THEN
+				GetCommand(conv.imp, val, ok);
+				IF ok THEN val.p(file, s)
+				ELSE Dialog.ShowMsg("#System:ConverterFailed")
+				END
+			ELSE Dialog.ShowMsg("#System:NoConverterFound")
+			END
+		END
+	END Import;
+
+	PROCEDURE Export* (loc: Files.Locator; name: Files.Name; conv: Converter; s: Stores.Store);
+		VAR res: INTEGER; file: Files.File; val: ExpVal; ok: BOOLEAN;
+	BEGIN
+		ASSERT(s # NIL, 20); ASSERT(~(s IS Stores.Alien), 21);
+		ASSERT(loc # NIL, 22); ASSERT(name # "", 23);
+		file := Files.dir.New(loc, Files.ask); (* fileLoc := loc; *)
+		IF file # NIL THEN
+			IF conv = NIL THEN
+				conv := doc
+			ELSE ASSERT(conv.exp # "", 24)
+			END;
+			GetCommand(conv.exp, val, ok);
+			IF ok THEN
+				val.p(s, file);
+				IF loc.res # canceled THEN
+					file.Register(name, conv.fileType, Files.ask, res); loc.res := res
+				END
+			ELSE Dialog.ShowMsg("#System:ConverterFailed"); loc.res := canceled
+			END
+		END
+	END Export;
+
+BEGIN
+	list := NIL
+END Converters.

BlackBox/System/Mod/Dates.txt

@@ -0,0 +1,191 @@
+MODULE Dates;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Dates.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Kernel;
+
+	CONST
+		monday* = 0;
+		tuesday* = 1;
+		wednesday* = 2;
+		thursday* = 3;
+		friday* = 4;
+		saturday* = 5;
+		sunday* = 6;
+
+		short* = 0;
+		long* = 1;
+		abbreviated* = 2;
+		plainLong* = 3;
+		plainAbbreviated* = 4;
+
+	TYPE
+		Date* = RECORD
+			year*, month*, day*: INTEGER
+		END;
+
+		Time* = RECORD
+			hour*, minute*, second*: INTEGER
+		END;
+
+		Hook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
+
+	VAR M, N: ARRAY 8 OF INTEGER; hook: Hook;
+
+	PROCEDURE (h: Hook) GetTime* (OUT d: Date; OUT t: Time), NEW, ABSTRACT;
+	PROCEDURE (h: Hook) GetUTCTime* (OUT d: Date; OUT t: Time), NEW, ABSTRACT;
+	PROCEDURE (h: Hook) GetUTCBias* (OUT bias: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (h: Hook) DateToString* (d: Date; format: INTEGER; OUT str: ARRAY OF CHAR), NEW, ABSTRACT;
+	PROCEDURE (h: Hook) TimeToString* (t: Time; OUT str: ARRAY OF CHAR), NEW, ABSTRACT;
+
+	PROCEDURE SetHook* (h: Hook);
+	BEGIN
+		hook := h
+	END SetHook;
+
+	PROCEDURE  ValidTime* (IN t: Time): BOOLEAN;
+	BEGIN
+		RETURN
+			(t.hour >= 0) & (t.hour <= 23)
+			& (t.minute >= 0) & (t.minute <= 59)
+			& (t.second >= 0) & (t.second <= 59)
+	END ValidTime;
+	
+	PROCEDURE ValidDate* (IN d: Date): BOOLEAN;
+		VAR y, m, d1: INTEGER;
+	BEGIN
+		IF (d.year < 1) OR (d.year > 9999) OR (d.month < 1) OR (d.month > 12) OR (d.day < 1) THEN
+			RETURN FALSE
+		ELSE
+			y := d.year; m := d.month;
+			IF m = 2 THEN
+				IF (y < 1583) & (y MOD 4 = 0)
+				OR (y MOD 4 = 0) & ((y MOD 100 # 0) OR (y MOD 400 = 0)) THEN
+					d1 := 29
+				ELSE d1 := 28
+				END
+			ELSIF m IN {1, 3, 5, 7, 8, 10, 12} THEN d1 := 31
+			ELSE d1 := 30
+			END;
+			IF (y = 1582) & (m = 10) & (d.day > 4) & (d.day < 15) THEN RETURN FALSE END;
+			RETURN d.day <= d1
+		END
+	END ValidDate;
+
+	PROCEDURE Day* (IN d: Date): INTEGER;
+		VAR y, m, n: INTEGER;
+	BEGIN
+		y := d.year; m := d.month - 3;
+		IF m < 0 THEN INC(m, 12); DEC(y) END;
+		n := y * 1461 DIV 4 + (m * 153 + 2) DIV 5 + d.day - 306;
+		IF n > 577737 THEN n := n - (y DIV 100 * 3 - 5) DIV 4 END;
+		RETURN n
+	END Day;
+
+	PROCEDURE DayToDate* (n: INTEGER; OUT d: Date);
+		VAR c, y, m: INTEGER;
+	BEGIN
+		IF n > 577737 THEN
+			n := n * 4 + 1215; c := n DIV 146097; n := n MOD 146097 DIV 4
+		ELSE
+			n := n + 305; c := 0
+		END;
+		n := n * 4 + 3; y := n DIV 1461; n := n MOD 1461 DIV 4;
+		n := n * 5 + 2; m := n DIV 153; n := n MOD 153 DIV 5;
+		IF m > 9 THEN m := m - 12; INC(y) END;
+		d.year := SHORT(100 * c + y);
+		d.month := SHORT(m + 3);
+		d.day := SHORT(n + 1)
+	END DayToDate;
+
+	PROCEDURE GetDate* (OUT d: Date);
+		VAR t: Time;
+	BEGIN
+		ASSERT(hook # NIL, 100);
+		hook.GetTime(d, t)
+	END GetDate;
+
+	PROCEDURE GetTime* (OUT t: Time);
+		VAR d: Date;
+	BEGIN
+		ASSERT(hook # NIL, 100);
+		hook.GetTime(d, t)
+	END GetTime;
+
+	(* UTC = Coordinated Universal Time, also konown as Greenwich Mean time (GMT). *)
+
+	PROCEDURE GetUTCDate* (OUT d: Date);
+		VAR t: Time;
+	BEGIN
+		ASSERT(hook # NIL, 100);
+		hook.GetUTCTime(d, t)
+	END GetUTCDate;
+
+	PROCEDURE GetUTCTime* (OUT t: Time);
+		VAR d: Date;
+	BEGIN
+		ASSERT(hook # NIL, 100);
+		hook.GetUTCTime(d, t)
+	END GetUTCTime;
+	
+	PROCEDURE GetUTCBias* (OUT bias: INTEGER);
+	(*
+		Returns the current bias, in minutes, for local time translation on this computer. The bias is the difference, 
+		in minutes, between Coordinated Universal Time (UTC) and local time. All translations between UTC and
+		local time are based on the following formula: 
+			UTC = local time + bias 
+ 	*)		
+	BEGIN
+		ASSERT(hook # NIL, 100);
+		hook.GetUTCBias(bias)
+	END GetUTCBias;
+	
+
+	PROCEDURE GetEasterDate* (year: INTEGER; OUT d: Date);
+		VAR  k, m, n, a, b, c, d0, e, o: INTEGER; month, day: INTEGER;
+	BEGIN
+		ASSERT((year >= 1583) & (year <= 2299), 20);
+		k := year DIV 100 - 15;
+		m := M[k]; n := N[k];
+		a := year MOD 19; b := year MOD 4; c := year MOD 7;
+		d0 := (19*a + m) MOD 30; e := (2*b+4*c+6*d0+n) MOD 7;
+		o := 21+d0+e; month := 3+o DIV 31; day := o MOD 31+1;
+		IF month = 4 THEN
+			IF day = 26 THEN day := 19
+			ELSIF (day = 25) & (d0=28) & (e = 6) & (a > 10) THEN day := 18
+			END
+		END;
+		d.year := year;
+		d.month := month;
+		d.day := day
+	END GetEasterDate;
+
+	PROCEDURE  DayOfWeek* (IN d: Date): INTEGER;
+	(** post: res = 0: Monday .. res = 6: Sunday **)
+	BEGIN
+		RETURN SHORT((4+Day(d)) MOD 7)
+	END DayOfWeek;
+
+	PROCEDURE DateToString* (IN d: Date; format: INTEGER; OUT str: ARRAY OF CHAR);
+	BEGIN
+		ASSERT(hook # NIL, 100);
+		hook.DateToString(d, format, str)
+	END DateToString;
+
+	PROCEDURE TimeToString* (IN t: Time; OUT str: ARRAY OF CHAR);
+	BEGIN
+		ASSERT(hook # NIL, 100);
+		hook.TimeToString(t, str)
+	END TimeToString;
+
+BEGIN
+	M[0] := 22; N[0] := 2;
+	M[1] := 22; N[1] := 2;
+	M[2] := 23; N[2] := 3;
+	M[3] := 23; N[3] := 4;
+	M[4] := 24; N[4] := 5;
+	M[5] := 24; N[5] := 5;
+	M[6] := 24; N[6] := 6;
+	M[7] := 25; N[7] := 0;
+END Dates.

BlackBox/System/Mod/Documents.txt

@@ -0,0 +1,1286 @@
+MODULE Documents;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Documents.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT
+		Kernel, Files, Ports, Dates, Printers,
+		Stores, Sequencers, Models, Views, Controllers, Properties,
+		Dialog, Printing, Containers;
+
+	CONST
+		(** Document.SetPage/PollPage decorate **)
+		plain* = FALSE; decorate* = TRUE;
+		
+		(** Controller.opts **)
+		pageWidth* = 16; pageHeight* = 17; winWidth* = 18; winHeight* = 19;
+
+		point = Ports.point;
+		mm = Ports.mm;
+
+		defB = 8 * point;	(* defB also used by HostWindows in DefBorders *)
+
+		scrollUnit = 16 * point;
+		abort = 1;
+
+		resizingKey = "#System:Resizing";
+		pageSetupKey = "#System:PageSetup";
+		
+		docTag = 6F4F4443H; docVersion = 0;
+
+		minVersion = 0; maxModelVersion = 0; maxCtrlVersion = 0;
+		maxDocVersion = 0; maxStdDocVersion = 0;
+
+
+	TYPE
+		Document* = POINTER TO ABSTRACT RECORD (Containers.View) END;
+
+		Context* = POINTER TO ABSTRACT RECORD (Models.Context) END;
+
+		Directory* = POINTER TO ABSTRACT RECORD END;
+
+
+		Model = POINTER TO RECORD (Containers.Model)
+			doc: StdDocument;
+			view: Views.View;
+			l, t, r, b: INTEGER	(* possibly  r, b >= Views.infinite *)
+			(* l, t: constant (= defB) *)
+			(* r-l, b-t: invalid in some cases, use PollRect *)
+		END;
+
+		Controller = POINTER TO RECORD (Containers.Controller)
+			doc: StdDocument
+		END;
+
+		StdDocument = POINTER TO RECORD (Document)
+			model: Model;
+			original: StdDocument;	(* original # NIL => d IS copy of original *)
+			pw, ph, pl, pt, pr, pb: INTEGER;	(* invalid if original # NIL, use PollPage *)
+			decorate: BOOLEAN;
+			x, y: INTEGER	(* scroll state *)
+		END;
+
+		StdContext = POINTER TO RECORD (Context)
+			model: Model
+		END;
+
+		StdDirectory = POINTER TO RECORD (Directory) END;
+		
+		SetRectOp = POINTER TO RECORD (Stores.Operation)
+			model: Model;
+			w, h: INTEGER
+		END;
+		SetPageOp = POINTER TO RECORD (Stores.Operation)
+			d: StdDocument;
+			pw, ph, pl, pt, pr, pb: INTEGER;
+			decorate: BOOLEAN
+		END;
+		ReplaceViewOp = POINTER TO RECORD (Stores.Operation)
+			model: Model;
+			new: Views.View
+		END;
+
+		PrinterContext = POINTER TO RECORD (Models.Context)
+			param: Printing.Par;
+			date: Dates.Date;
+			time: Dates.Time;
+			pr: Printers.Printer;
+			l, t, r, b: INTEGER;	(* frame *)
+			pw, ph: INTEGER	(* paper *)
+		END;
+		
+		UpdateMsg = RECORD (Views.Message)
+			doc: StdDocument
+		END;
+		
+		
+		PContext = POINTER TO RECORD (Models.Context)
+			view: Views.View;
+			w, h: INTEGER	(* content size *)
+		END;
+		Pager = POINTER TO RECORD (Views.View)
+			con: PContext;
+			w, h: INTEGER;	(* page size *)
+			x, y: INTEGER	(* origin *)
+		END;
+		
+		PrintingHook = POINTER TO RECORD (Printing.Hook) END;
+
+		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
+
+	VAR
+		dir-, stdDir-: Directory;
+		cleaner: TrapCleaner;
+		current: INTEGER;
+
+
+	(** Cleaner **)
+
+	PROCEDURE (c: TrapCleaner) Cleanup;
+	BEGIN
+		Printing.par := NIL; current := -1
+	END Cleanup;
+
+
+	(** Document **)
+
+	PROCEDURE (d: Document) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE;
+		VAR thisVersion: INTEGER;
+	BEGIN
+		IF rd.cancelled THEN RETURN END;
+		rd.ReadVersion(minVersion, maxDocVersion, thisVersion)
+	END Internalize2;
+
+	PROCEDURE (d: Document) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE;
+	BEGIN
+		wr.WriteVersion(maxDocVersion)
+	END Externalize2;
+
+	PROCEDURE (d: Document) GetNewFrame* (VAR frame: Views.Frame);
+		VAR f: Views.RootFrame;
+	BEGIN
+		NEW(f); frame := f
+	END GetNewFrame;
+
+	PROCEDURE (d: Document) GetBackground* (VAR color: Ports.Color);
+	BEGIN
+		color := Ports.background
+	END GetBackground;
+	
+	PROCEDURE (d: Document) DocCopyOf* (v: Views.View): Document, NEW, ABSTRACT;
+	PROCEDURE (d: Document) SetView* (view: Views.View; w, h: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (d: Document) ThisView* (): Views.View, NEW, ABSTRACT;
+	PROCEDURE (d: Document) OriginalView* (): Views.View, NEW, ABSTRACT;
+
+	PROCEDURE (d: Document) SetRect* (l, t, r, b: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (d: Document) PollRect* (VAR l, t, r, b: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (d: Document) SetPage* (w, h, l, t, r, b: INTEGER; decorate: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (d: Document) PollPage* (VAR w, h, l, t, r, b: INTEGER;
+																VAR decorate: BOOLEAN), NEW, ABSTRACT;
+
+
+	(** Context **)
+
+	PROCEDURE (c: Context) ThisDoc* (): Document, NEW, ABSTRACT;
+
+
+	(** Directory **)
+
+	PROCEDURE (d: Directory) New* (view: Views.View; w, h: INTEGER): Document, NEW, ABSTRACT;
+
+
+	(* operations *)
+
+	PROCEDURE (op: SetRectOp) Do;
+		VAR m: Model; w, h: INTEGER; upd: UpdateMsg;
+	BEGIN
+		m := op.model;
+		w := m.r - m.l; h := m.b - m.t;
+		m.r := m.l + op.w; m.b := m.t + op.h;
+		op.w := w; op.h := h;
+		IF m.doc.context # NIL THEN
+			upd.doc := m.doc;
+			Views.Domaincast(m.doc.Domain(), upd)
+		END
+	END Do;
+
+	PROCEDURE (op: SetPageOp) Do;
+		VAR d: StdDocument; pw, ph, pl, pt, pr, pb: INTEGER; decorate: BOOLEAN; upd: UpdateMsg;
+	BEGIN
+		d := op.d;
+		pw := d.pw; ph := d.ph; pl := d.pl; pt := d.pt; pr := d.pr; pb := d.pb;
+		decorate := d.decorate;
+		d.pw := op.pw; d.ph := op.ph; d.pl := op.pl; d.pt := op.pt; d.pr := op.pr; d.pb := op.pb;
+		d.decorate := op.decorate;
+		op.pw := pw; op.ph := d.ph; op.pl := pl; op.pt := pt; op.pr := pr; op.pb := pb;
+		op.decorate := decorate;
+		IF d.context # NIL THEN
+			upd.doc := d;
+			Views.Domaincast(d.Domain(), upd)
+		END
+	END Do;
+
+	PROCEDURE (op: ReplaceViewOp) Do;
+		VAR new: Views.View; upd: UpdateMsg;
+	BEGIN
+		new := op.new; op.new := op.model.view; op.model.view := new;
+		upd.doc := op.model.doc;
+		IF upd.doc.context # NIL THEN
+			Views.Domaincast(upd.doc.Domain(), upd)
+		END
+	END Do;
+
+
+	(* printing support for StdDocument *)
+
+	PROCEDURE CheckOrientation (d: Document; prt: Printers.Printer);
+		VAR w, h, l, t, r, b: INTEGER; decorate: BOOLEAN;
+	BEGIN
+		d.PollPage(w, h, l, t, r, b, decorate);
+		prt.SetOrientation(w > h)
+	END CheckOrientation;
+
+	PROCEDURE NewPrinterContext (d: Document; prt: Printers.Printer; p: Printing.Par): PrinterContext;
+		VAR c: PrinterContext;
+			pw, ph,  x0, y0, x1, y1, l, t, r, b: INTEGER; decorate: BOOLEAN;
+	BEGIN
+		prt.GetRect(x0, y0, x1, y1);
+		d.PollPage(pw, ph, l, t, r, b, decorate);
+		INC(l, x0); INC(t, y0); INC(r, x0); INC(b, y0);
+		NEW(c); (* c.Domain() := d.Domain(); (* dom *)*) c.param := p; Dates.GetDate(c.date); Dates.GetTime(c.time);
+		c.pr := prt;
+		c.l := l; c.t := t; c.r := r; c.b := b;
+		c.pw := pw + 2 * x0; c.ph := ph + 2 * y0;	(* paper reduced to printer range *)
+		RETURN c
+	END NewPrinterContext;
+
+	PROCEDURE Decorate (c: PrinterContext; f: Views.Frame);
+		VAR p: Printing.Par; x0, x1, y, asc, dsc, w: INTEGER; alt: BOOLEAN;
+	BEGIN
+		p := c.param;
+		alt := p.page.alternate & ~ODD(p.page.first + Printing.Current() (* p.page.current *));
+		IF alt THEN x0 := c.pw - c.r; x1 := c.pw - c.l
+		ELSE x0 := c.l; x1 := c.r
+		END;
+		IF (alt & (p.header.left # "")) OR (~alt & (p.header.right # "")) THEN
+			p.header.font.GetBounds(asc, dsc, w);
+			y := c.t - p.header.gap - dsc;
+			Printing.PrintBanner(f, p.page, p.header, c.date, c.time, x0, x1, y)
+		END;
+		IF (alt & (p.footer.left # "")) OR (~alt & (p.footer.right # "")) THEN
+			p.footer.font.GetBounds(asc, dsc, w);
+			y := c.b + p.footer.gap + asc;
+			Printing.PrintBanner(f, p.page, p.footer, c.date, c.time, x0, x1, y)
+		END
+	END Decorate;
+
+
+	(* support for StdDocument paging *)
+
+	PROCEDURE HasFocus (v: Views.View; f: Views.Frame): BOOLEAN;
+		VAR focus: Views.View; dummy: Controllers.PollFocusMsg;
+	BEGIN
+		focus := NIL; dummy.focus := NIL;
+		v.HandleCtrlMsg(f, dummy, focus);
+		RETURN focus # NIL
+	END HasFocus;
+	
+	PROCEDURE ScrollDoc(v: StdDocument; x, y: INTEGER);
+	BEGIN
+		IF (x # v.x) OR (y # v.y) THEN
+			Views.Scroll(v, x - v.x, y - v.y);
+			v.x := x; v.y := y
+		END
+	END ScrollDoc;
+
+	PROCEDURE PollSection (v: StdDocument; f: Views.Frame; VAR msg: Controllers.PollSectionMsg);
+		VAR mv: Views.View; g: Views.Frame; vs, ps, ws, p, l, t, r, b: INTEGER; c: Containers.Controller;
+	BEGIN
+		mv := v.model.view;
+		g := Views.ThisFrame(f, mv);
+		c := v.ThisController();
+		IF c.Singleton() # NIL THEN g := NIL END;
+		IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
+		IF (g = NIL) OR ~msg.done & (~msg.focus OR ~HasFocus(mv, g)) THEN
+			v.PollRect(l, t, r, b);
+			IF msg.vertical THEN
+				ps := f.b - f.t; vs := b + t; p := -v.y
+			ELSE
+				ps := f.r - f.l; vs := r + l;  p := -v.x
+			END;
+			IF ps > vs THEN ps := vs END;
+			ws := vs - ps;
+			IF p > ws THEN
+				p := ws;
+				IF msg.vertical THEN ScrollDoc(v, v.x, -p)
+				ELSE ScrollDoc(v, -p, v.y)
+				END
+			END;
+			msg.wholeSize := vs;
+			msg.partSize := ps;
+			msg.partPos := p;
+			msg.valid := ws > Ports.point
+		END;
+		msg.done := TRUE
+	END PollSection;
+
+	PROCEDURE Scroll (v: StdDocument; f: Views.Frame; VAR msg: Controllers.ScrollMsg);
+		VAR mv: Views.View; g: Views.Frame; vs, ps, ws, p, l, t, r, b: INTEGER; c: Containers.Controller;
+	BEGIN
+		mv := v.model.view;
+		g := Views.ThisFrame(f, mv);
+		c := v.ThisController();
+		IF c.Singleton() # NIL THEN g := NIL END;
+		IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
+		IF (g = NIL) OR ~msg.done & (~msg.focus OR ~HasFocus(mv, g)) THEN
+			v.PollRect(l, t, r, b);
+			IF msg.vertical THEN
+				ps := f.b - f.t; vs := b + t; p := -v.y
+			ELSE
+				ps := f.r - f.l; vs := r + l; p := -v.x
+			END;
+			ws := vs - ps;
+			CASE msg.op OF
+			  Controllers.decLine: p := MAX(0, p - scrollUnit)
+			| Controllers.incLine: p := MIN(ws, p + scrollUnit)
+			| Controllers.decPage: p := MAX(0, p - ps + scrollUnit)
+			| Controllers.incPage: p := MIN(ws, p + ps - scrollUnit)
+			| Controllers.gotoPos: p := MAX(0, MIN(ws, msg.pos))
+			ELSE
+			END;
+			IF msg.vertical THEN ScrollDoc(v, v.x, -p)
+			ELSE ScrollDoc(v, -p, v.y)
+			END
+		END;
+		msg.done := TRUE
+	END Scroll;
+	
+	PROCEDURE MakeVisible* (d: Document; f: Views.Frame; l, t, r, b: INTEGER);
+		VAR x, y, w, h, dw, dh, ml, mt, mr, mb: INTEGER;
+	BEGIN
+		WITH d: StdDocument DO
+			d.context.GetSize(w, h);
+			x := -d.x; y := -d.y;
+			d.PollRect(ml, mt, mr, mb);
+			dw := mr + ml - w; dh := mb + mt - h;
+			IF dw > 0 THEN
+				IF r > x + w - 2 * ml THEN x := r - w + 2 * ml END;
+				IF l < x THEN x := l END;
+				IF x < 0 THEN x := 0 ELSIF x > dw THEN x := dw END
+			END;
+			IF dh > 0 THEN
+				IF b > y + h - 2 * mt THEN y := b - h + 2 * mt END;
+				IF t < y THEN y := t END;
+				IF y < 0 THEN y := 0 ELSIF y > dh THEN y := dh END
+			END;
+			ScrollDoc(d, -x, -y)
+		END
+	END MakeVisible;
+
+	PROCEDURE Page (d: StdDocument; f: Views.Frame;
+								VAR msg: Controllers.PageMsg);
+		VAR g: Views.Frame;
+	BEGIN
+		g := Views.ThisFrame(f, d.model.view);
+		IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END
+	END Page;
+	
+
+	(* Model *)
+
+	PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
+		VAR c: StdContext; thisVersion: INTEGER; l, t, r, b: INTEGER;
+	BEGIN
+		m.Internalize^(rd);
+		IF rd.cancelled THEN RETURN END;
+		rd.ReadVersion(minVersion, maxModelVersion, thisVersion);
+		IF rd.cancelled THEN RETURN END;
+		Views.ReadView(rd, m.view);
+		rd.ReadInt(l); rd.ReadInt(t); rd.ReadInt(r); rd.ReadInt(b);
+		m.l := defB; m.t := defB; m.r := defB + r - l; m.b := defB + b - t;
+		NEW(c); c.model := m; m.view.InitContext(c)
+	END Internalize;
+
+	PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
+	BEGIN
+		ASSERT(m.doc.original = NIL, 100);
+		m.Externalize^(wr);
+		wr.WriteVersion(maxModelVersion);
+		Views.WriteView(wr, m.view);
+		wr.WriteInt(m.l); wr.WriteInt(m.t); wr.WriteInt(m.r); wr.WriteInt(m.b)
+	END Externalize;
+
+	PROCEDURE (m: Model) CopyFrom (source: Stores.Store);
+		VAR c: StdContext;
+	BEGIN
+		WITH source: Model DO
+			m.view := Stores.CopyOf(source.view)(Views.View);
+			m.l := source.l; m.t := source.t; m.r := source.r; m.b := source.b;
+			NEW(c); c.model := m; m.view.InitContext(c)
+		END
+	END CopyFrom;
+	
+	PROCEDURE (m: Model) InitFrom (source: Containers.Model);
+		VAR c: StdContext;
+	BEGIN
+		WITH source: Model DO
+			m.view := Stores.CopyOf(source.view)(Views.View);
+			m.l := source.l; m.t := source.t; m.r := source.r; m.b := source.b;
+			NEW(c); c.model := m; m.view.InitContext(c)
+		END
+	END InitFrom;
+
+	PROCEDURE (m: Model) GetEmbeddingLimits (OUT minW, maxW, minH, maxH: INTEGER);
+	BEGIN
+		minW := 5 * mm; minH := 5 * mm;
+		maxW := MAX(INTEGER) DIV 2; maxH := MAX(INTEGER) DIV 2
+	END GetEmbeddingLimits;
+
+	PROCEDURE (m: Model) ReplaceView (old, new: Views.View);
+		VAR con: Models.Context; op: ReplaceViewOp;
+	BEGIN
+		ASSERT(old # NIL, 20); con := old.context;
+		ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = m, 22);
+		ASSERT(new # NIL, 23);
+		ASSERT((new.context = NIL) OR (new.context = con), 24);
+		IF new # old THEN
+			IF new.context = NIL THEN new.InitContext(con) END;
+			Stores.Join(m, new);
+			NEW(op); op.model := m; op.new := new;
+			Models.Do(m, "#System:ReplaceView", op)
+		END
+	END ReplaceView;
+
+
+	(* StdDocument *)
+
+	PROCEDURE (d: StdDocument) Internalize2 (VAR rd: Stores.Reader);
+		VAR thisVersion: INTEGER; c: Containers.Controller;
+	BEGIN
+		d.Internalize2^(rd);
+		IF rd.cancelled THEN RETURN END;
+		rd.ReadVersion(minVersion, maxStdDocVersion, thisVersion);
+		IF rd.cancelled THEN RETURN END;
+		rd.ReadInt(d.pw); rd.ReadInt(d.ph);
+		rd.ReadInt(d.pl); rd.ReadInt(d.pt); rd.ReadInt(d.pr); rd.ReadInt(d.pb);
+		rd.ReadBool(d.decorate);
+		(* change infinite height to "fit to window" *)
+		c := d.ThisController();
+		IF (c # NIL) & (d.model.b >= 29000 * Ports.mm) & (c.opts * {winHeight, pageHeight} = {}) THEN
+			c.SetOpts(c.opts + {winHeight})
+		END;
+		c.SetOpts(c.opts - {Containers.noSelection});
+		d.x := 0; d.y := 0;
+		Stores.InitDomain(d)
+	END Internalize2;
+
+	PROCEDURE (d: StdDocument) Externalize2 (VAR wr: Stores.Writer);
+	BEGIN
+		ASSERT(d.original = NIL, 100);
+		d.Externalize2^(wr);
+		wr.WriteVersion(maxStdDocVersion);
+		wr.WriteInt(d.pw); wr.WriteInt(d.ph);
+		wr.WriteInt(d.pl); wr.WriteInt(d.pt); wr.WriteInt(d.pr); wr.WriteInt(d.pb);
+		wr.WriteBool(d.decorate)
+	END Externalize2;
+
+	PROCEDURE (d: StdDocument) CopyFromModelView2 (source: Views.View; model: Models.Model);
+	BEGIN
+		WITH source: StdDocument DO
+			d.pw := source.pw; d.ph := source.ph;
+			d.pl := source.pl; d.pt := source.pt; d.pr := source.pr; d.pb := source.pb;
+			d.decorate := source.decorate
+		END
+	END CopyFromModelView2;
+	
+	PROCEDURE (d: StdDocument) AcceptableModel (m: Containers.Model): BOOLEAN;
+	BEGIN
+		RETURN m IS Model
+	END AcceptableModel;
+	
+	PROCEDURE (d: StdDocument) InitModel2 (m: Containers.Model);
+	BEGIN
+		ASSERT((d.model = NIL) OR (d.model = m), 20);
+		ASSERT(m IS Model, 23);
+		WITH m: Model DO d.model := m; m.doc := d END
+	END InitModel2;
+	
+	PROCEDURE (d: StdDocument) PollRect (VAR l, t, r, b: INTEGER);
+		VAR c: Containers.Controller; doc: StdDocument; ww, wh, pw, ph: INTEGER;
+	BEGIN
+		IF d.original = NIL THEN doc := d ELSE doc := d.original END;
+		l := d.model.l; t := d.model.t;
+		pw := doc.pr - doc.pl; ph := doc.pb - doc.pt;
+		IF d.context = NIL THEN ww := 0; wh := 0
+		ELSIF d.context IS PrinterContext THEN ww := pw; wh := ph
+		ELSE d.context.GetSize(ww, wh); DEC(ww, 2 * l); DEC(wh, 2 * t)
+		END;
+		c := d.ThisController();
+		IF pageWidth IN c.opts THEN r := l + pw
+		ELSIF winWidth IN c.opts THEN
+			IF ww > 0 THEN r := l + ww ELSE r := d.model.r END
+		ELSE r := l + doc.model.r - doc.model.l
+		END;
+		IF pageHeight IN c.opts THEN b := t + ph
+		ELSIF winHeight IN c.opts THEN 
+			IF wh > 0 THEN b := t + wh ELSE b := d.model.b END
+		ELSE b := t + doc.model.b - doc.model.t
+		END;
+		ASSERT(r > l, 60); ASSERT(b > t, 61)
+	END PollRect;
+
+	PROCEDURE (d: StdDocument) PollPage (VAR w, h, l, t, r, b: INTEGER; VAR decorate: BOOLEAN);
+		VAR doc: StdDocument;
+	BEGIN
+		IF d.original = NIL THEN doc := d ELSE doc := d.original END;
+		w := doc.pw; h := doc.ph;
+		l := doc.pl; t := doc.pt; r := doc.pr; b := doc.pb;
+		decorate := doc.decorate
+	END PollPage;
+
+	PROCEDURE (d: StdDocument) DocCopyOf (v: Views.View): Document;
+		VAR c0, c1: Containers.Controller; u: Views.View; new: Document; w, h: INTEGER;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		ASSERT(~(v IS Document), 21);
+		ASSERT(d.Domain() = v.Domain(), 22);
+		ASSERT(d.Domain() # NIL, 23);
+		Views.BeginModification(3, v);  
+		u := Views.CopyOf(v, Views.shallow);
+		v.context.GetSize(w, h);
+		new := dir.New(u, w, h);
+		WITH new: StdDocument DO
+			IF d.original # NIL THEN new.original := d.original ELSE new.original := d END
+		END;
+		c0 := d.ThisController();
+		c1 := new.ThisController();
+		c1.SetOpts(c0.opts);
+		Views.EndModification(3, v);
+		RETURN new
+	END DocCopyOf;
+
+	PROCEDURE (d: StdDocument) Restore (f: Views.Frame; l, t, r, b: INTEGER);
+		VAR c: Containers.Controller; m: Model; con: Models.Context; s: Views.View;
+	BEGIN
+		m := d.model; con := d.context;
+		WITH con: PrinterContext DO
+			IF con.param.page.alternate & ~ODD(con.param.page.first + Printing.Current()) THEN
+				Views.InstallFrame(f, m.view, con.pw - con.r, con.t, 0, FALSE)
+			ELSE
+				Views.InstallFrame(f, m.view, con.l, con.t, 0, FALSE)
+			END
+		ELSE
+			c := d.ThisController(); s := c.Singleton();
+			Views.InstallFrame(f, m.view, m.l + d.x, m.t + d.y, 0, s = NIL)
+		END
+	END Restore;
+
+	PROCEDURE (d: StdDocument) GetRect (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER);
+		VAR l0, t0, r0, b0: INTEGER;
+	BEGIN
+		d.PollRect(l0, t0, r0, b0);
+		l := l0 + d.x; t := t0 + d.y; r := r0 + d.x; b := b0 + d.y
+	END GetRect;
+
+	PROCEDURE (d: StdDocument) SetView (view: Views.View; w, h: INTEGER);
+		CONST
+			wA4 = 210 * mm; hA4 = 296 * mm;	(* A4 default paper size *)
+			lm = 20 * mm; tm = 20 * mm; rm = 20 * mm; bm = 20 * mm;
+		VAR m: Model; c: StdContext; prt: Printers.Printer;
+			ctrl: Containers.Controller; opts: SET; rp: Properties.ResizePref;
+			u, minW, maxW, minH, maxH,  defW, defH,  dw, dh,  pw, ph,
+			pageW, pageH,  paperW, paperH,  leftM, topM, rightM, botM: INTEGER;
+			l, t, r, b: INTEGER; port: Ports.Port;
+	BEGIN
+		ASSERT(view # NIL, 20); ASSERT(~(view IS Document), 21);
+		ASSERT(d.original = NIL, 100);
+		m := d.model;
+		NEW(c); c.model := m; view.InitContext(c);
+		IF d.context # NIL THEN Stores.Join(d, view) END;
+		IF Printers.dir # NIL THEN prt := Printers.dir.Current() ELSE prt := NIL END;
+		IF prt # NIL THEN
+			prt.SetOrientation(FALSE);
+			port := prt.ThisPort(); prt.GetRect(l, t, r, b);
+			port.GetSize(pw, ph); u := port.unit;
+			paperW := r - l; paperH := b - t;
+			pageW := paperW - lm - rm; pageH := paperH - tm - bm;
+			leftM := lm; topM := tm; rightM := rm; botM := bm;
+			IF pageW > pw * u THEN pageW := pw * u END;
+			IF pageH > ph * u THEN pageH := ph * u END;
+			IF leftM + l < 0 THEN dw := -(leftM + l)
+			ELSIF paperW - rightM + l > pw * u THEN dw := pw * u - (paperW - rightM + l)
+			ELSE dw := 0
+			END;
+			IF topM + t < 0 THEN dh := -(topM + t)
+			ELSIF paperH - botM + t > ph * u THEN dh := ph * u - (paperH - botM + t)
+			ELSE dh := 0
+			END;
+			INC(leftM, dw); INC(topM, dh); INC(rightM, dw); INC(botM, dh)
+		ELSE
+			paperW := wA4; paperH := hA4;
+			pageW := paperW - lm - rm; pageH := paperH - tm - bm;
+			leftM := lm; topM := tm; rightM := rm; botM := bm
+		END;
+		m.GetEmbeddingLimits(minW, maxW, minH, maxH);
+		defW := MAX(minW, pageW - m.l - defB);
+		defH := MAX(minH, pageH - m.t - defB);
+		Properties.PreferredSize(view, minW, maxW, minH, maxH, defW, defH, w, h);
+		opts := {}; rp.fixed := FALSE;
+		rp.horFitToPage := FALSE;
+		rp.verFitToPage := FALSE;
+		rp.horFitToWin := FALSE;
+		rp.verFitToWin := FALSE;
+		Views.HandlePropMsg(view, rp);
+		IF rp.horFitToPage THEN INCL(opts, pageWidth)
+		ELSIF rp.horFitToWin THEN INCL(opts, winWidth)
+		END;
+		IF rp.verFitToPage THEN INCL(opts, pageHeight)
+		ELSIF rp.verFitToWin THEN INCL(opts, winHeight)
+		END;
+		Views.BeginModification(Views.notUndoable, d);
+		m.view := view; d.x := 0; d.y := 0;
+		ctrl := d.ThisController();
+		ctrl.SetOpts(ctrl.opts - {pageWidth..winHeight});
+		d.SetPage(paperW, paperH, leftM, topM, paperW - rightM, paperH - botM, plain);
+		ASSERT(w > 0, 100); ASSERT(h > 0, 101);
+		d.SetRect(m.l, m.t, m.l + w, m.t + h);
+		ctrl.SetOpts(ctrl.opts + opts);
+		Views.EndModification(Views.notUndoable, d);
+		Stores.Join(d, view);
+		Views.Update(d, Views.rebuildFrames)
+	END SetView;
+
+	PROCEDURE (d: StdDocument) ThisView (): Views.View;
+	BEGIN
+		RETURN d.model.view
+	END ThisView;
+	
+	PROCEDURE (d: StdDocument) OriginalView (): Views.View;
+	BEGIN
+		IF d.original = NIL THEN RETURN d.model.view
+		ELSE RETURN d.original.model.view
+		END
+	END OriginalView;
+
+	PROCEDURE (d: StdDocument) SetRect (l, t, r, b: INTEGER);
+		VAR m: Model; op: SetRectOp; c: Containers.Controller; w, h: INTEGER;
+	BEGIN
+		ASSERT(l < r, 22); ASSERT(t < b, 25);
+		m := d.model;
+		IF (m.l # l) OR (m.t # t) THEN
+			m.r := l + m.r - m.l; m.l := l;
+			m.b := t + m.b - m.t; m.t := t;
+			Views.Update(d, Views.rebuildFrames)
+		END;
+		IF d.original # NIL THEN m := d.original.model END;
+		c := d.ThisController(); w := r - l; h := b - t;
+		IF (pageWidth IN c.opts) OR (winWidth IN c.opts) THEN w := m.r - m.l END;
+		IF (pageHeight IN c.opts) OR (winHeight IN c.opts) THEN h := m.b - m.t END;
+		IF (w # m.r - m.l) OR (h # m.b - m.t) THEN
+			NEW(op); op.model := m; op.w:= w; op.h := h;
+			Views.Do(d, resizingKey, op)
+		END
+	END SetRect;
+
+	PROCEDURE (d: StdDocument) SetPage (pw, ph, pl, pt, pr, pb: INTEGER; decorate: BOOLEAN);
+		VAR op: SetPageOp; doc: StdDocument;
+	BEGIN
+		IF d.original = NIL THEN doc := d ELSE doc := d.original END;
+		IF (doc.pw # pw) OR (doc.ph # ph) OR (doc.decorate # decorate)
+		OR (doc.pl # pl) OR (doc.pt # pt) OR (doc.pr # pr) OR (doc.pb # pb) THEN
+			ASSERT(0 <= pw, 20);
+			ASSERT(0 <= ph, 22);
+			ASSERT(0 <= pl, 24); ASSERT(pl < pr, 25); ASSERT(pr <= pw, 26);
+			ASSERT(0 <= pt, 27); ASSERT(pt < pb, 28); ASSERT(pb <= ph, 29);
+			NEW(op);
+			op.d := doc;
+			op.pw := pw; op.ph := ph; op.pl := pl; op.pt := pt; op.pr := pr; op.pb := pb;
+			op.decorate := decorate;
+			Views.Do(doc, pageSetupKey, op)
+		END
+	END SetPage;
+
+	PROCEDURE (v: StdDocument) HandleViewMsg2 (f: Views.Frame; VAR msg: Views.Message);
+	BEGIN
+		WITH msg: UpdateMsg DO
+			IF (msg.doc = v) OR (msg.doc = v.original) THEN
+				Views.Update(v, Views.rebuildFrames)
+			END
+		ELSE
+		END
+	END HandleViewMsg2;
+
+	PROCEDURE (d: StdDocument) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
+																				VAR focus: Views.View);
+	BEGIN
+		WITH f: Views.RootFrame DO
+			WITH msg: Controllers.PollSectionMsg DO
+				PollSection(d, f, msg); focus := NIL
+			| msg: Controllers.ScrollMsg DO
+				Scroll(d, f, msg); focus := NIL
+			| msg: Controllers.PageMsg DO
+				Page(d, f, msg); focus := NIL
+			ELSE
+			END
+		END
+	END HandleCtrlMsg2;
+
+
+	(* Controller *)
+
+	PROCEDURE (c: Controller) Internalize2 (VAR rd: Stores.Reader);
+		VAR v: INTEGER;
+	BEGIN
+		rd.ReadVersion(minVersion, maxCtrlVersion, v)
+	END Internalize2;
+
+	PROCEDURE (c: Controller) Externalize2 (VAR wr: Stores.Writer);
+	BEGIN
+		wr.WriteVersion(maxCtrlVersion)
+	END Externalize2;
+
+	PROCEDURE (c: Controller) InitView2 (v: Views.View);
+	BEGIN
+		IF v # NIL THEN c.doc := v(StdDocument) ELSE c.doc := NIL END
+	END InitView2;
+
+	PROCEDURE (c: Controller) GetContextType (OUT type: Stores.TypeName);
+	END GetContextType;
+
+	PROCEDURE (c: Controller) GetValidOps (OUT valid: SET);
+	BEGIN
+		IF c.Singleton() # NIL THEN
+			valid := {Controllers.copy}
+		END
+	END GetValidOps;
+
+	PROCEDURE (c: Controller) NativeModel (m: Models.Model): BOOLEAN;
+	BEGIN
+		RETURN m IS Model
+	END NativeModel;
+
+	PROCEDURE (c: Controller) NativeView (v: Views.View): BOOLEAN;
+	BEGIN
+		RETURN v IS StdDocument
+	END NativeView;
+
+	PROCEDURE (c: Controller) NativeCursorAt (f: Views.Frame; x, y: INTEGER): INTEGER;
+	BEGIN
+		RETURN Ports.arrowCursor
+	END NativeCursorAt;
+
+	PROCEDURE (c: Controller) PollNativeProp (selection: BOOLEAN; VAR p: Properties.Property;
+																		VAR truncated: BOOLEAN);
+	END PollNativeProp;
+
+	PROCEDURE (c: Controller) SetNativeProp (selection: BOOLEAN; p, old: Properties.Property);
+	END SetNativeProp;
+
+	PROCEDURE (c: Controller) GetFirstView (selection: BOOLEAN; OUT v: Views.View);
+	BEGIN
+		IF selection THEN v := c.Singleton() ELSE v := c.doc.model.view END
+	END GetFirstView;
+
+	PROCEDURE (c: Controller) GetNextView (selection: BOOLEAN; VAR v: Views.View);
+	BEGIN
+		v := NIL
+	END GetNextView;
+
+	PROCEDURE (c: Controller) GetPrevView (selection: BOOLEAN; VAR v: Views.View);
+	BEGIN
+		v := NIL
+	END GetPrevView;
+
+	PROCEDURE (c: Controller) TrackMarks (f: Views.Frame; x, y: INTEGER;
+															units, extend, add: BOOLEAN);
+	BEGIN
+		c.Neutralize
+	END TrackMarks;
+	
+	PROCEDURE (c: Controller) RestoreMarks2 (f: Views.Frame; l, t, r, b: INTEGER);
+	BEGIN
+		IF c.doc.context IS PrinterContext THEN Decorate(c.doc.context(PrinterContext), f) END
+	END RestoreMarks2;
+
+	PROCEDURE (c: Controller) Resize (view: Views.View; l, t, r, b: INTEGER);
+		VAR d: StdDocument; l0, t0: INTEGER;
+	BEGIN
+		d := c.doc;
+		ASSERT(view = d.model.view, 20);
+		l0 := d.model.l; t0 := d.model.t;
+		d.SetRect(l0, t0, l0 + r - l, t0 + b - t)
+	END Resize;
+
+	PROCEDURE (c: Controller) DeleteSelection;
+	END DeleteSelection;
+
+	PROCEDURE (c: Controller) MoveLocalSelection (f, dest: Views.Frame; x, y: INTEGER;
+														dx, dy: INTEGER);
+		VAR m: Model; l, t, r, b: INTEGER;
+	BEGIN
+		IF f = dest THEN
+			m := c.doc.model; DEC(dx, x); DEC(dy, y);
+			l := m.l + dx; t := m.t + dy;
+			r := m.r + dx; b := m.b + dy;
+			c.Resize(m.view, l, t, r, b);
+			IF c.Singleton() = NIL THEN c.SetSingleton(m.view) END
+		END
+	END MoveLocalSelection;
+
+	PROCEDURE (c: Controller) SelectionCopy (): Model;
+	BEGIN
+		RETURN NIL
+	END SelectionCopy;
+
+	PROCEDURE (c: Controller) NativePaste (m: Models.Model; f: Views.Frame);
+		VAR m0: Model;
+	BEGIN
+		WITH m: Model DO
+			m0 := c.doc.model;
+			m0.ReplaceView(m0.view, m.view);
+			c.doc.SetRect(m.l, m.t, m.r, m.b)
+		END
+	END NativePaste;
+
+	PROCEDURE (c: Controller) PasteView (f: Views.Frame; v: Views.View; w, h: INTEGER);
+		VAR m: Model; minW, maxW, minH, maxH, defW, defH: INTEGER;
+	BEGIN
+		m := c.doc.model;
+		m.GetEmbeddingLimits(minW, maxW, minH, maxH);
+		defW := m.r - m.l; defH := m.b - m.t;
+		Properties.PreferredSize(v, minW, maxW, minH, maxH, defW, defH, w, h);
+		m.ReplaceView(m.view, v);
+		c.doc.SetRect(m.l, m.t, m.l + w, m.t + h)
+	END PasteView;
+
+	PROCEDURE (c: Controller) Drop (src, dst: Views.Frame; sx, sy, x, y, w, h, rx, ry: INTEGER;
+												v: Views.View; isSingle: BOOLEAN);
+		VAR m: Model; minW, maxW, minH, maxH, defW, defH: INTEGER;
+	BEGIN
+		m := c.doc.model;
+		m.GetEmbeddingLimits(minW, maxW, minH, maxH);
+		defW := m.r - m.l; defH := m.b - m.t;
+		Properties.PreferredSize(v, minW, maxW, minH, maxH, defW, defH, w, h);
+		m.ReplaceView(m.view, v);
+		c.doc.SetRect(m.l, m.t, m.l + w, m.t + h)
+	END Drop;
+
+	(* selection *)
+
+	PROCEDURE (c: Controller) Selectable (): BOOLEAN;
+	BEGIN
+		RETURN TRUE
+	END Selectable;
+
+	PROCEDURE (c: Controller) SelectAll (select: BOOLEAN);
+	BEGIN
+		IF ~select & (c.Singleton() # NIL) THEN
+			c.SetSingleton(NIL)
+		ELSIF select & (c.Singleton() = NIL) THEN
+			c.SetSingleton(c.doc.model.view)
+		END
+	END SelectAll;
+
+	PROCEDURE (c: Controller) InSelection (f: Views.Frame; x, y: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN c.Singleton() # NIL
+	END InSelection;
+
+	(* caret *)
+
+	PROCEDURE (c: Controller) HasCaret (): BOOLEAN;
+	BEGIN
+		RETURN FALSE
+	END HasCaret;
+
+	PROCEDURE (c: Controller) MarkCaret (f: Views.Frame; show: BOOLEAN);
+	END MarkCaret;
+
+	PROCEDURE (c: Controller) CanDrop (f: Views.Frame; x, y: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN FALSE
+	END CanDrop;
+
+	(* handlers *)
+
+	PROCEDURE (c: Controller) HandleCtrlMsg (f: Views.Frame;
+								 VAR msg: Controllers.Message; VAR focus: Views.View);
+		VAR l, t, r, b: INTEGER;
+	BEGIN
+		IF ~(Containers.noFocus IN c.opts) THEN
+			WITH msg: Controllers.TickMsg DO
+				IF c.Singleton() = NIL THEN c.SetFocus(c.doc.model.view) END
+			| msg: Controllers.CursorMessage DO
+				IF c.Singleton() = NIL THEN	(* delegate to focus, even if not directly hit *)
+					focus := c.ThisFocus();
+					c.doc.GetRect(f, focus, l, t, r, b);	(* except for resize in lower right corner *)
+					IF (c.opts * {pageWidth..winHeight} # {})
+						OR (msg.x < r) OR (msg.y < b) THEN RETURN END
+				END
+			ELSE
+			END
+		END;
+		c.HandleCtrlMsg^(f, msg, focus)
+	END HandleCtrlMsg;
+	
+	
+	PROCEDURE (c: Controller) PasteChar (ch: CHAR);
+	END PasteChar;
+	
+	PROCEDURE (c: Controller) ControlChar (f: Views.Frame; ch: CHAR);
+	END ControlChar;
+	
+	PROCEDURE (c: Controller) ArrowChar (f: Views.Frame; ch: CHAR; units, select: BOOLEAN);
+	END ArrowChar;
+	
+	PROCEDURE (c: Controller) CopyLocalSelection (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER);
+	END CopyLocalSelection;
+
+
+	(* StdContext *)
+
+	PROCEDURE (c: StdContext) ThisModel (): Models.Model;
+	BEGIN
+		RETURN c.model
+	END ThisModel;
+
+	PROCEDURE (c: StdContext) GetSize (OUT w, h: INTEGER);
+		VAR m: Model; dc: Models.Context; l, t, r, b: INTEGER;
+	BEGIN
+		m := c.model;
+		m.doc.PollRect(l, t, r, b); w := r - l; h := b - t;
+		dc := m.doc.context;
+		IF dc # NIL THEN
+			WITH dc: PrinterContext DO
+				w := MIN(w, dc.r - dc.l); h := MIN(h, dc.b - dc.t)
+			ELSE
+			END
+		END;
+		ASSERT(w > 0, 60); ASSERT(h > 0, 61)
+	END GetSize;
+
+	PROCEDURE (c: StdContext) SetSize (w, h: INTEGER);
+		VAR m: Model; d: StdDocument; minW, maxW, minH, maxH,  defW, defH: INTEGER;
+	BEGIN
+		m := c.model; d := m.doc; ASSERT(d # NIL, 20);
+		m.GetEmbeddingLimits(minW, maxW, minH, maxH);
+		defW := m.r - m.l; defH := m.b - m.t;
+		Properties.PreferredSize(m.view, minW, maxW, minH, maxH, defW, defH, w, h);
+		d.SetRect(m.l, m.t, m.l + w, m.t + h)
+	END SetSize;
+
+	PROCEDURE (c: StdContext) Normalize (): BOOLEAN;
+	BEGIN
+		RETURN TRUE
+	END Normalize;
+
+	PROCEDURE (c: StdContext) ThisDoc (): Document;
+	BEGIN
+		RETURN c.model.doc
+	END ThisDoc;
+
+	PROCEDURE (c: StdContext) MakeVisible (l, t, r, b: INTEGER);
+	BEGIN
+		MakeVisible(c.model.doc, NIL, l, t, r, b)
+	END MakeVisible;
+
+
+	(* PrinterContext *)
+
+	PROCEDURE (c: PrinterContext) GetSize (OUT w, h: INTEGER);
+		VAR p: Ports.Port;
+	BEGIN
+		p := c.pr.ThisPort();
+		p.GetSize(w, h);
+		w := w * p.unit;
+		h := h * p.unit
+	END GetSize;
+
+	PROCEDURE (c: PrinterContext) Normalize (): BOOLEAN;
+	BEGIN
+		RETURN TRUE
+	END Normalize;
+	
+	PROCEDURE (c: PrinterContext) SetSize (w, h: INTEGER);
+	END SetSize;
+	
+	PROCEDURE (c: PrinterContext) ThisModel (): Models.Model;
+	BEGIN
+		RETURN NIL
+	END ThisModel;
+
+
+	(* StdDirectory *)
+
+	PROCEDURE (d: StdDirectory) New (view: Views.View; w, h: INTEGER): Document;
+		VAR doc: StdDocument; m: Model; c: Controller;
+	BEGIN
+		ASSERT(view # NIL, 20); ASSERT(~(view IS Document), 21);
+		NEW(m);
+		NEW(doc); doc.InitModel(m);
+		NEW(c); doc.SetController(c);
+		doc.SetRect(defB, defB, defB + 1, defB + 1);	(* set top-left point *)
+		doc.SetView(view, w, h);	(* joins store graphs of doc and view *)
+		Stores.InitDomain(doc);	(* domains of new documents are bound *)
+		RETURN doc
+	END New;
+
+
+	(** PContext **)
+
+	PROCEDURE (c: PContext) GetSize (OUT w, h: INTEGER);
+	BEGIN
+		w := c.w; h := c.h
+	END GetSize;
+	
+	PROCEDURE (c: PContext) Normalize (): BOOLEAN;
+	BEGIN
+		RETURN TRUE
+	END Normalize;
+	
+	PROCEDURE (c: PContext) SetSize (w, h: INTEGER);
+	END SetSize;
+	
+	PROCEDURE (c: PContext) ThisModel (): Models.Model;
+	BEGIN
+		RETURN NIL
+	END ThisModel;
+	
+
+	(** Pager **)
+	
+
+	PROCEDURE (p: Pager) Restore (f: Views.Frame; l, t, r, b: INTEGER);
+	BEGIN
+		Views.InstallFrame(f, p.con.view, -p.x, -p.y, 0, FALSE)
+	END Restore;
+	
+	PROCEDURE (p: Pager) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);
+		VAR v: Views.View; g: Views.Frame;
+	BEGIN
+		WITH msg: Controllers.PageMsg DO
+			v := p.con.view; g := Views.ThisFrame(f, v);
+			IF g = NIL THEN
+				Views.InstallFrame(f, v, 0, 0, 0, FALSE);
+				g := Views.ThisFrame(f, v)
+			END;
+			IF g # NIL THEN
+				Views.ForwardCtrlMsg(g, msg);
+				IF ~msg.done THEN
+					IF p.con.w > p.w THEN 	(* needs horizontal paging *)
+						IF msg.op = Controllers.gotoPageX THEN p.x := msg.pageX * p.w; msg.done := TRUE
+						ELSIF msg.op = Controllers.nextPageX THEN p.x := p.x + p.w; msg.done := TRUE
+						END;
+						IF p.x >= p.con.w THEN msg.eox := TRUE; p.x := 0 END
+					END;
+					IF p.con.h > p.h THEN	(* needs vertical paging *)
+						IF msg.op = Controllers.gotoPageY THEN p.y := msg.pageY * p.h; msg.done := TRUE
+						ELSIF msg.op = Controllers.nextPageY THEN p.y := p.y + p.h; msg.done := TRUE
+						END;
+						IF p.y >= p.con.h THEN msg.eoy := TRUE; p.y := 0 END
+					END
+				END
+			END
+		ELSE focus := p.con.view
+		END
+	END HandleCtrlMsg;
+	
+	PROCEDURE NewPager (v: Views.View; w, h, pw, ph: INTEGER): Pager;
+		VAR p: Pager; c: PContext;
+	BEGIN
+		NEW(c); c.view := v; c.w := w; c.h := h; v.InitContext(c);
+		NEW(p); p.con := c; p.w := pw; p.h := ph; p.x := 0; p.y := 0;
+		Stores.Join(v, p);
+		RETURN p
+	END NewPager;
+	
+	PROCEDURE PrinterDoc (d: Document; c: PrinterContext): Document;
+		VAR v, u, p: Views.View; w, h, l, t, r, b, pw, ph: INTEGER; pd: Document;
+			ct: Containers.Controller; dec: BOOLEAN; seq: ANYPTR;
+	BEGIN
+		v := d.ThisView();
+
+		IF d.Domain() # NIL THEN seq:=d.Domain().GetSequencer();
+			IF seq#NIL THEN seq(Sequencers.Sequencer).BeginModification(Sequencers.invisible, d) END
+		END;
+		u := Views.CopyOf(v, Views.shallow);
+		IF d.Domain() # NIL THEN seq:=d.Domain().GetSequencer();
+			IF seq#NIL THEN seq(Sequencers.Sequencer).EndModification(Sequencers.invisible, d) END
+		END;
+
+		d.PollPage(w, h, l, t, r, b, dec); pw := r - l; ph := b - t;	(* page size *)
+		v.context.GetSize(w, h);
+		ct := d.ThisController();
+		IF winWidth IN ct.opts THEN w := pw END;	(* fit to win -> fit to page *)
+		IF winHeight IN ct.opts THEN h := ph END;
+		p := NewPager(u, w, h, pw, ph);
+		ASSERT(Stores.Joined(p, d), 100);
+		pd := dir.New(p, pw, ph);
+		pd.InitContext(c);
+		RETURN pd
+	END PrinterDoc;
+	
+
+	(** miscellaneous **)
+
+	PROCEDURE Print* (d: Document; p: Printers.Printer; par: Printing.Par);
+		VAR dom: Stores.Domain; d1: Document; f: Views.RootFrame; g: Views.Frame;
+			c: PrinterContext; from, to, this, copies, w, h, u, k: INTEGER; page: Controllers.PageMsg;
+			title: Views.Title; port: Ports.Port;
+	BEGIN
+		ASSERT(d # NIL, 20); ASSERT(p # NIL, 21);
+		ASSERT(par # NIL, 22);
+		ASSERT(par.page.from >= 0, 23); ASSERT(par.page.from <= par.page.to, 24);
+		ASSERT(par.copies > 0, 25);
+		IF (par.header.right # "") OR (par.page.alternate & (par.header.left # "")) THEN
+			ASSERT(par.header.font # NIL, 26)
+		END;
+		IF (par.footer.right # "") OR (par.page.alternate & (par.footer.left # "")) THEN
+			ASSERT(par.footer.font # NIL, 27)
+		END;
+		IF par.page.title = "" THEN title := "(" + Dialog.appName + ")" ELSE title := par.page.title END;
+		from := par.page.from; to := par.page.to;
+		copies := par.copies;
+		CheckOrientation(d, p);
+		p.OpenJob(copies, title);
+		IF p.res = 0 THEN
+			dom := d.Domain();
+			ASSERT(dom # NIL, 100);
+			c := NewPrinterContext(d, p, par);
+			d1 := PrinterDoc(d, c);
+			CheckOrientation(d, p);	(* New in PrinterDoc resets printer orientation *)
+			d1.GetNewFrame(g); f := g(Views.RootFrame); f.ConnectTo(p.ThisPort());
+			Views.SetRoot(f, d1, FALSE, {}); Views.AdaptRoot(f);
+			current := 0; (*par.page.current := 0; *)
+			d1.Restore(f, 0, 0, 0, 0);	(* install frame for doc's view *)
+			Kernel.PushTrapCleaner(cleaner);
+			port := p.ThisPort();
+			Printing.par := par;
+			page.op := Controllers.gotoPageX; page.pageX := 0;
+			page.done := FALSE; page.eox := FALSE;
+			Views.ForwardCtrlMsg(f, page);
+			IF page.done THEN this := 0 ELSE this := from END;
+			page.op := Controllers.gotoPageY; page.pageY := this;
+			page.done := FALSE; page.eoy := FALSE;
+			Views.ForwardCtrlMsg(f, page);
+			IF ~page.done & (from > 0) OR page.eox OR page.eoy THEN to := -1 END;
+			WHILE this <= to DO
+				IF this >= from THEN
+					current := this; (*par.page.current := this;*)
+					port.GetSize(w, h); u := port.unit;
+					FOR k := copies TO par.copies DO
+						p.OpenPage;
+						IF p.res = 0 THEN
+							Views.RemoveFrames(f, 0, 0, w * u, h * u);
+							Views.RestoreRoot(f, 0, 0, w * u, h * u)
+						END;
+						p.ClosePage
+					END
+				END;
+				IF p.res # abort THEN INC(this) ELSE to := -1 END;
+				IF this <= to THEN
+					page.op := Controllers.nextPageX;
+					page.done := FALSE; page.eox := FALSE;
+					Views.ForwardCtrlMsg(f, page);
+					IF ~page.done OR page.eox THEN
+						IF page.done THEN
+							page.op := Controllers.gotoPageX; page.pageX := 0;
+							page.done := FALSE; page.eox := FALSE;
+							Views.ForwardCtrlMsg(f, page)
+						END;
+						page.op := Controllers.nextPageY;
+						page.done := FALSE; page.eoy := FALSE;
+						Views.ForwardCtrlMsg(f, page);
+						IF ~page.done OR page.eoy THEN to := -1 END
+					END
+				END
+			END;
+			Printing.par := NIL;
+			Kernel.PopTrapCleaner(cleaner)
+		ELSE Dialog.ShowMsg("#System:FailedToOpenPrintJob")
+		END;
+		p.CloseJob
+	END Print;
+
+	PROCEDURE (hook: PrintingHook) Current(): INTEGER;
+	BEGIN
+		RETURN current
+	END Current;
+	
+	PROCEDURE (hook: PrintingHook) Print (v: Views.View; par: Printing.Par);
+		VAR dom: Stores.Domain;  d: Document; f: Views.RootFrame; c: PrinterContext;
+			w, h, u: INTEGER; p: Printers.Printer; g: Views.Frame; title: Views.Title;
+			k, copies: INTEGER; port: Ports.Port;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		p := Printers.dir.Current();
+		ASSERT(p # NIL, 21);
+		IF v IS Document THEN Print(v(Document), p, par); RETURN END;
+		IF (v.context # NIL) & (v.context IS Context) THEN
+			Print(v.context(Context).ThisDoc(), p, par); RETURN
+		END;
+		p.SetOrientation(FALSE);
+		IF par.page.title = "" THEN title := "(" + Dialog.appName + ")" ELSE title := par.page.title END;
+		copies := par.copies;
+		p.OpenJob(copies, title);
+		IF p.res = 0 THEN
+			Printing.par := par;
+			Stores.InitDomain(v);
+			dom := v.Domain();
+			v := Views.CopyOf(v, Views.shallow) ;
+			d := dir.New(v, Views.undefined, Views.undefined);
+			c := NewPrinterContext(d, (* dom, *) p, par);
+			d.InitContext(c); (* Stores.InitDomain(d, c.Domain()); (* nicht mehr noetig *) *)
+			d.GetNewFrame(g); f := g(Views.RootFrame); 
+			port := p.ThisPort(); f.ConnectTo(port);
+			Views.SetRoot(f, d, FALSE, {}); Views.AdaptRoot(f);
+			port.GetSize(w, h); u := port.unit;
+			FOR k := copies TO par.copies DO
+				p.OpenPage;
+				IF p.res = 0 THEN
+					Views.RemoveFrames(f, 0, 0, w * u, h * u); Views.RestoreRoot(f, 0, 0, w * u, h * u)
+				END;
+				p.ClosePage
+			END
+		END;
+		Printing.par := NIL;
+		p.CloseJob
+	END Print;
+
+
+	PROCEDURE ImportDocument* (f: Files.File; OUT s: Stores.Store);
+		VAR r: Stores.Reader; tag, version: INTEGER;
+	BEGIN
+		ASSERT(f # NIL, 20);
+		r.ConnectTo(f);
+		r.ReadInt(tag);
+		IF tag = docTag THEN
+			r.ReadInt(version);
+			ASSERT(version = docVersion, 100);
+			r.ReadStore(s);
+			IF s IS Document THEN s := s(Document).ThisView()
+			ELSE s := NIL
+			END
+		END
+	END ImportDocument;
+
+	PROCEDURE ExportDocument* (s: Stores.Store; f: Files.File);
+		VAR w: Stores.Writer; v: Views.View;
+	BEGIN
+		ASSERT(s # NIL, 20);
+		ASSERT(s IS Views.View, 21);
+		ASSERT(f # NIL, 22);
+		v := s(Views.View);
+		IF (v.context # NIL) & (v.context IS Context) THEN
+			v := v.context(Context).ThisDoc()
+		END;
+		IF ~(v IS Document) THEN
+			IF v.context # NIL THEN
+				v := Views.CopyOf(v, Views.shallow)
+			END;
+			v := dir.New(v, Views.undefined, Views.undefined)
+		END;
+		w.ConnectTo(f);
+		w.WriteInt(docTag); w.WriteInt(docVersion);
+		w.WriteStore(v)
+	END ExportDocument;
+
+
+	PROCEDURE SetDir* (d: Directory);
+	BEGIN
+		ASSERT(d # NIL, 20);
+		dir := d;
+		IF stdDir = NIL THEN stdDir := d END
+	END SetDir;
+	
+	PROCEDURE Init;
+		VAR d: StdDirectory; h: PrintingHook;
+	BEGIN
+		NEW(d); SetDir(d);
+		NEW(h); Printing.SetHook(h);
+		NEW(cleaner)
+	END Init;
+
+BEGIN
+	Init
+END Documents.

BlackBox/System/Mod/Fonts.txt

@@ -0,0 +1,59 @@
+MODULE Fonts;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Fonts.odc *)
+	(* DO NOT EDIT *)
+
+	CONST
+		(** universal units **)
+		mm* = 36000;
+		point* = 12700;	(** 1/72 inch **)
+
+		italic* = 0; underline* = 1; strikeout* = 2;	(** style elements **)
+
+		normal* = 400; bold* = 700;
+		
+		default* = "*";
+
+	TYPE
+		Typeface* = ARRAY 64 OF CHAR;
+
+		Font* = POINTER TO ABSTRACT RECORD
+			typeface-: Typeface;
+			size-: INTEGER;
+			style-: SET;
+			weight-: INTEGER
+		END;
+
+		TypefaceInfo* = POINTER TO RECORD
+			next*: TypefaceInfo;
+			typeface*: Typeface
+		END;
+
+		Directory* = POINTER TO ABSTRACT RECORD
+		END;
+		
+	VAR dir-: Directory;
+
+	PROCEDURE (f: Font) Init* (typeface: Typeface; size: INTEGER; style: SET; weight: INTEGER), NEW;
+	BEGIN
+		ASSERT(f.size = 0, 20); ASSERT(size # 0, 21);
+		f.typeface := typeface$; f.size := size; f.style := style; f.weight := weight
+	END Init;
+
+	PROCEDURE (f: Font) GetBounds* (OUT asc, dsc, w: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (f: Font) StringWidth* (IN s: ARRAY OF CHAR): INTEGER, NEW, ABSTRACT;
+	PROCEDURE (f: Font) SStringWidth* (IN s: ARRAY OF SHORTCHAR): INTEGER, NEW, ABSTRACT;
+	PROCEDURE (f: Font) IsAlien* (): BOOLEAN, NEW, ABSTRACT;
+	
+	PROCEDURE (d: Directory) This* (typeface: Typeface; size: INTEGER; style: SET; weight: INTEGER): Font, NEW, ABSTRACT;
+	PROCEDURE (d: Directory) Default* (): Font, NEW, ABSTRACT;
+	PROCEDURE (d: Directory) TypefaceList* (): TypefaceInfo, NEW, ABSTRACT;
+	
+	PROCEDURE SetDir* (d: Directory);
+	BEGIN
+		ASSERT(d # NIL, 20);
+		dir := d
+	END SetDir;
+
+END Fonts.
+

BlackBox/System/Mod/Integers.txt

@@ -0,0 +1,848 @@
+MODULE Integers;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Integers.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Files, Math;
+
+	CONST
+		B = 10000; DecPerDig = 4; BinBase = 16 * 1024;
+		KaratsubaBreak = 41;
+
+	TYPE
+		Index = INTEGER;
+		Digit = SHORTINT;
+		DoubleDigit = INTEGER;
+
+		IntegerDesc = ARRAY OF Digit;	(* to hide internal structure from interface *)
+		Integer* = POINTER TO IntegerDesc;
+		Buffer = RECORD
+			digit: Integer;
+			beg, len: Index
+		END;
+
+	VAR zero, one, two, buf6: Integer;
+
+	PROCEDURE CopyOf (x: Integer; len: Index): Integer;
+		VAR buf: Integer;
+	BEGIN
+		ASSERT(len > 0, 20);
+		NEW(buf, len);
+		REPEAT DEC(len); buf[len] := x[len] UNTIL len = 0;
+		RETURN buf
+	END CopyOf;
+
+	(* Operations on Digits *)
+
+	PROCEDURE Add (x, y, sum: Integer; xL, yL: Index; OUT sumL: Index);
+		VAR i, l: Index; c: Digit;
+	BEGIN
+		l := MIN(xL, yL);
+		i := 0; c := 0;
+		WHILE i < l DO c := SHORT(c DIV B + x[i] + y[i]); sum[i] := SHORT(c MOD B); INC(i) END;
+		WHILE i < xL DO c := SHORT(c DIV B + x[i]); sum[i] := SHORT(c MOD B); INC(i) END;
+		WHILE i < yL DO c := SHORT(c DIV B + y[i]); sum[i] := SHORT(c MOD B); INC(i) END;
+		IF c >= B THEN sum[i] := SHORT(c DIV B); INC(i) END;
+		sumL := i
+	END Add;
+
+	PROCEDURE Subtract (x, y, dif: Integer; xL, yL: Index; OUT difL: Index);
+		VAR i: Index; c, d: Digit;
+	BEGIN
+		ASSERT(xL >= yL, 20);
+		i := 0; difL := 0; c := 0;
+		WHILE i < yL DO
+			c := SHORT(c DIV B + x[i] - y[i]); d := SHORT(c MOD B);
+			IF d # 0 THEN
+				WHILE difL # i DO dif[difL] := 0; INC(difL) END;
+				dif[i] := d; INC(difL)
+			END;
+			INC(i)
+		END;
+		WHILE i < xL DO
+			c := SHORT(c DIV B + x[i]); d := SHORT(c MOD B);
+			IF d # 0 THEN
+				WHILE difL # i DO dif[difL] := 0; INC(difL) END;
+				dif[i] := d; INC(difL)
+			END;
+			INC(i)
+		END;
+		ASSERT(c DIV B = 0, 100)
+	END Subtract;
+
+	PROCEDURE OneDigitMult (a, b: Buffer; VAR c: Buffer);
+		VAR i: Index; carry, factor: DoubleDigit;
+	BEGIN
+		ASSERT(a.len = 1, 20);
+		factor := a.digit[a.beg]; i := 0; carry := 0;
+		WHILE i # b.len DO
+			carry := carry DIV B + factor * b.digit[b.beg + i]; c.digit[c.beg + i] := SHORT(carry MOD B);
+			INC(i)
+		END;
+		IF carry >= B THEN c.digit[c.beg + i] := SHORT(carry DIV B); INC(i) END;
+		c.len := i
+	END OneDigitMult;
+
+	PROCEDURE SimpleMult (a, b: Buffer; VAR c: Buffer);
+		VAR i, j, k: Index; c0, c1: DoubleDigit;
+	BEGIN
+		ASSERT(a.len <= b.len, 20);
+		c.len := a.len + b.len - 1;
+		i := 0; c0 := 0; c1 := 0;
+		REPEAT
+			IF i < b.len THEN
+				IF i < a.len THEN j := i; k := 0 ELSE j := a.len - 1; k := i - a.len + 1 END;
+				REPEAT
+					c0 := c0 + a.digit[a.beg + j] * b.digit[b.beg + k];
+					IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN
+						c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase
+					END;
+					DEC(j); INC(k)
+				UNTIL j < 0
+			ELSE
+				j := a.len - 1; k := i - a.len + 1;
+				REPEAT
+					c0 := c0 + a.digit[a.beg + j] * b.digit[b.beg + k];
+					IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN
+						c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase
+					END;
+					DEC(j); INC(k)
+				UNTIL k = b.len
+			END;
+			IF c1 = 0 THEN c.digit[c.beg + i] := SHORT(c0 MOD B); c0 := c0 DIV B
+			ELSE
+				c0 := c0 + BinBase * (c1 MOD B);
+				c.digit[c.beg + i] := SHORT(c0 MOD B); c0 := c0 DIV B; c1 := c1 DIV B
+			END;
+			INC(i)
+		UNTIL i = c.len;
+		IF c0 # 0 THEN c.digit[c.beg + c.len] := SHORT(c0); INC(c.len) END
+	END SimpleMult;
+
+	PROCEDURE AddBuf (a, b: Buffer; VAR c: Buffer);	(* c := a + b *)
+		VAR i: Index; carry: Digit;
+	BEGIN
+		ASSERT(a.len <= b.len, 20);
+		i := 0; carry := 0;
+		WHILE i # a.len DO
+			carry := SHORT(carry DIV B + a.digit[a.beg + i] + b.digit[b.beg + i]);
+			c.digit[c.beg + i] := SHORT(carry MOD B);
+			INC(i)
+		END;
+		WHILE (i # b.len) & (carry >= B) DO
+			carry := SHORT(carry DIV B + b.digit[b.beg + i]); c.digit[c.beg + i] := SHORT(carry MOD B);
+			INC(i)
+		END;
+		IF carry >= B THEN c.digit[c.beg + i] := SHORT(carry DIV B); INC(i)
+		ELSE
+			WHILE i # b.len DO c.digit[c.beg + i] := b.digit[b.beg + i]; INC(i) END
+		END;
+		c.len := i
+	END AddBuf;
+
+	PROCEDURE AddToBuf (VAR a: Buffer; b: Buffer; shift: Index);	(* a := a + b * B^shift *)
+		VAR i, n: Index; carry: Digit;
+	BEGIN
+		b.beg := b.beg - shift; b.len := b.len + shift; i := shift; n := MIN(a.len, b.len); carry := 0;
+		WHILE i # n DO
+			carry := SHORT(carry DIV B + a.digit[a.beg + i] + b.digit[b.beg + i]);
+			a.digit[a.beg + i] := SHORT(carry MOD B);
+			INC(i)
+		END;
+		IF i # a.len THEN
+			WHILE (i # a.len) & (carry >= B) DO
+				carry := SHORT(carry DIV B + a.digit[a.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B);
+				INC(i)
+			END;
+			IF carry >= B THEN a.digit[a.beg + i] := SHORT(carry DIV B); INC(i) END
+		ELSE
+			WHILE (i # b.len) & (carry >= B) DO
+				carry := SHORT(carry DIV B + b.digit[b.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B);
+				INC(i)
+			END;
+			IF carry >= B THEN a.digit[a.beg + i] := SHORT(carry DIV B); INC(i)
+			ELSE
+				WHILE i # b.len DO a.digit[a.beg + i] := b.digit[b.beg + i]; INC(i) END
+			END
+		END;
+		a.len := MAX(i, a.len)
+	END AddToBuf;
+
+	PROCEDURE SubtractFromBuf (VAR a: Buffer; b, c: Buffer);	(* a := a - b - c *)
+		VAR i: Index; carry: Digit;
+	BEGIN
+		ASSERT(b.len <= c.len, 20);
+		i := 0; carry := 0;
+		WHILE i # b.len DO
+			carry := SHORT(carry DIV B + a.digit[a.beg + i] - b.digit[b.beg + i] - c.digit[c.beg + i]);
+			a.digit[a.beg + i] := SHORT(carry MOD B);
+			INC(i)
+		END;
+		WHILE i # c.len DO
+			carry := SHORT(carry DIV B + a.digit[a.beg + i] - c.digit[c.beg + i]);
+			a.digit[a.beg + i] := SHORT(carry MOD B);
+			INC(i)
+		END;
+		WHILE carry < 0 DO
+			carry := SHORT(carry DIV B + a.digit[a.beg + i]); a.digit[a.beg + i]  := SHORT(carry MOD B);
+			INC(i)
+		END;
+		ASSERT(i <= a.len, 100);
+		WHILE (a.len # 0) & (a.digit[a.beg + a.len - 1] = 0) DO DEC(a.len) END
+	END SubtractFromBuf;
+
+	PROCEDURE KStep (a, b: Buffer; VAR c: Buffer; stack: Buffer);
+		VAR n2, i: Index; a0, a1, b0, b1, c0, c1, h: Buffer;
+	BEGIN
+		ASSERT(a.len <= b.len, 20);
+		IF a.len = 0 THEN c.len := 0
+		ELSIF a.len = 1 THEN OneDigitMult(a, b, c)
+		ELSIF a.len <= KaratsubaBreak THEN SimpleMult(a, b, c)
+		ELSE
+			n2 := b.len DIV 2;
+			c0.digit := c.digit; c0.beg := c.beg; c1.digit := c.digit; c1.beg := c.beg + 2 * n2;
+			a0.digit := a.digit; a0.beg := a.beg; a0.len := MIN(a.len, n2);
+			a1.digit := a.digit; a1.beg := a.beg + n2; a1.len := MAX(0, a.len - n2);
+			WHILE (a0.len # 0) & (a0.digit[a0.beg + a0.len - 1] = 0) DO DEC(a0.len) END;
+			b0.digit := b.digit; b0.beg := b.beg; b0.len := MIN(b.len, n2);
+			b1.digit := b.digit; b1.beg := b.beg + n2; b1.len := MAX(0, b.len - n2);
+			WHILE (b0.len # 0) & (b0.digit[b0.beg + b0.len - 1] = 0) DO DEC(b0.len) END;
+			IF (a0.len # 0) OR (b0.len # 0) THEN
+				IF a0.len <= a1.len THEN AddBuf(a0, a1, c1) ELSE AddBuf(a1, a0, c1) END;
+				IF b0.len <= b1.len THEN AddBuf(b0, b1, c0) ELSE AddBuf(b1, b0, c0) END;
+				h.digit := stack.digit; h.beg := stack.beg; stack.beg := stack.beg + c0.len + c1.len;
+				IF c0.len <= c1.len THEN KStep(c0, c1, h, stack) ELSE KStep(c1, c0, h, stack) END;
+				IF a0.len <= b0.len THEN KStep(a0, b0, c0, stack) ELSE KStep(b0, a0, c0, stack) END;
+				KStep(a1, b1, c1, stack);
+				IF c0.len <= c1.len THEN SubtractFromBuf(h, c0, c1) ELSE SubtractFromBuf(h, c1, c0) END;
+				IF c1.len # 0 THEN
+					i := c0.beg + c0.len;
+					WHILE i < c1.beg DO c.digit[i] := 0; INC(i) END;
+					c.len := c1.beg + c1.len - c.beg
+				ELSE
+					WHILE c0.len < n2 DO c0.digit[c0.beg + c0.len] := 0; INC(c0.len) END;
+					c.len := c0.len
+				END;
+				ASSERT(h.len # 0, 100);
+				AddToBuf(c, h, n2)
+			ELSE
+				KStep(a1, b1, c1, stack); c.len := c1.beg + c1.len - c.beg;
+				i := c.beg;
+				WHILE i # c1.beg DO c.digit[i] := 0; INC(i) END
+			END
+		END
+	END KStep;
+
+	PROCEDURE Karatsuba (x, y, pro:Integer; xL, yL: Index; OUT proL: Index);
+		VAR a, b, c, stack: Buffer;
+	BEGIN
+		ASSERT(xL <= yL, 20);
+		a.digit := x; a.beg := 0; a.len := xL; b.digit := y; b.beg := 0; b.len := yL;
+		c.digit := pro; c.beg := 0;
+		NEW(stack.digit, 2 * b.len); stack.beg := 0;
+		KStep(a, b, c, stack);
+		proL := c.len
+	END Karatsuba;
+	
+	PROCEDURE Multiply (x, y, pro: Integer; xL, yL: Index; OUT proL: Index);
+		VAR i, j, k: Index; c0, c1: DoubleDigit;
+	BEGIN
+		ASSERT(xL <= yL, 20);
+		IF xL > KaratsubaBreak THEN Karatsuba(x, y, pro, xL, yL, proL)
+		ELSIF xL = 1 THEN
+			proL := 0; c1 := x[0]; c0 := 0;
+			WHILE proL < yL DO
+				c0 := c1 * y[proL] + c0; pro[proL] := SHORT(c0 MOD B);
+				c0 := c0 DIV B ; INC(proL)
+			END;
+			IF c0 # 0 THEN pro[proL] := SHORT(c0); INC(proL) END
+		ELSE
+			proL := xL + yL - 1;
+			i := 0; c0 := 0; c1 := 0;
+			REPEAT
+				IF i < yL THEN
+					IF i < xL THEN j := i; k := 0 ELSE j := xL - 1; k := i - xL + 1 END;
+					REPEAT
+						c0 := c0 + x[j] * y[k];
+						IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN
+							c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase
+						END;
+						DEC(j); INC(k)
+					UNTIL j < 0
+				ELSE
+					j := xL - 1; k := i - xL + 1;
+					REPEAT
+						c0 := c0 + x[j] * y[k];
+						IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN
+							c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase
+						END;
+						DEC(j); INC(k)
+					UNTIL k = yL
+				END;
+				IF c1 = 0 THEN pro[i] := SHORT(c0 MOD B); c0 := c0 DIV B
+				ELSE c0 := c0 + BinBase * (c1 MOD B); pro[i] := SHORT(c0 MOD B);
+					c0 := c0 DIV B; c1 := c1 DIV B
+				END;
+				INC(i)
+			UNTIL i = proL;
+			IF c0 # 0 THEN pro[proL] := SHORT(c0); INC(proL) END
+		END
+	END Multiply;
+
+	PROCEDURE DecomposeQuoRem (x, y: Integer; xL, yL: Index);
+		VAR ix, iy, j: Index; d, q, h, yLead, ySecond: DoubleDigit; yBuf: Integer;
+	BEGIN
+		ASSERT((yL # 0) & (y[yL - 1] # 0), 20);
+		IF yL = 1 THEN
+			j := xL - 1; h := 0; d := y[0];
+			WHILE j >= 0 DO h := x[j] + h * B; x[j + 1] := SHORT(h DIV d); h := h MOD d; DEC(j) END;
+			x[0] := SHORT(h)
+		ELSIF xL >= yL THEN
+			x[xL] := 0; d := (B DIV 2 - 1) DIV y[yL - 1] + 1; yBuf := CopyOf(y, yL);
+			IF d # 1 THEN
+				j := 0; h := 0;
+				WHILE j < xL DO h := d * x[j] + h DIV B; x[j] := SHORT(h MOD B); INC(j) END;
+				x[xL] := SHORT(h DIV B);
+				j := 0; h := 0;
+				WHILE j < yL DO h := d * yBuf[j] + h DIV B; yBuf[j] := SHORT(h MOD B); INC(j) END;
+				ASSERT(h DIV B = 0, 100)
+			END;
+			yLead := yBuf[yL - 1]; ySecond := yBuf[yL - 2]; j := xL;
+			WHILE j >= yL DO
+				IF x[j] # yLead THEN q := (x[j] * B + x[j - 1]) DIV yLead ELSE q := B - 1 END;
+				WHILE ySecond * q > (x[j] * B + x[j - 1] - yLead * q) * B + x[j - 2] DO
+					DEC(q)
+				END;
+				ix := j - yL; iy := 0; h := 0;
+				WHILE iy < yL DO
+					h := x[ix] - q * yBuf[iy] + h DIV B; x[ix] := SHORT(h MOD B); INC(ix); INC(iy)
+				END;
+				IF (-x[j]) # (h DIV B) THEN
+					ix := j - yL; iy := 0; h := 0;
+					WHILE iy < yL DO
+						h := h DIV B + x[ix] + yBuf[iy]; x[ix] := SHORT(h MOD B); INC(ix); INC(iy)
+					END;
+					x[j] := SHORT(q - 1)
+				ELSE x[j] := SHORT(q)
+				END;
+				DEC(j)
+			END;
+			IF d # 1 THEN
+				j := yL; h := 0;
+				WHILE j # 0 DO DEC(j); h := h + x[j]; x[j] := SHORT(h DIV d); h := (h MOD d) * B END
+			END
+		END
+	END DecomposeQuoRem;
+
+	PROCEDURE GetQuoRem (x, y: Integer; xL, yL: Index; xNeg, yNeg: BOOLEAN;
+												quo, rem: Integer; OUT quoL, remL: Index; OUT quoNeg, remNeg: BOOLEAN;
+												doQuo, doRem: BOOLEAN);
+		VAR i: Index; c: Digit; xBuf: Integer;
+	BEGIN
+		ASSERT(xL >= yL, 20);
+		xBuf := CopyOf(x, xL + 1);
+		DecomposeQuoRem(xBuf, y, xL, yL);
+		i := xL;
+		WHILE (i >= yL) & (xBuf[i] = 0) DO DEC(i) END;
+		quoL := i - yL + 1;
+		i := yL - 1;
+		WHILE (i >= 0) & (xBuf[i] = 0) DO DEC(i) END;
+		remL := i + 1;
+		IF doQuo THEN
+			quoNeg := xNeg # yNeg;
+			IF quoNeg & (remL # 0) THEN
+				i := 0; c := 1;
+				WHILE (i # quoL) & (c # 0) DO
+					c := SHORT(c + xBuf[i + yL]); quo[i] := SHORT(c MOD B); c := SHORT(c DIV B);
+					INC(i)
+				END;
+				IF c = 0 THEN
+					WHILE i # quoL DO quo[i] := xBuf[i + yL]; INC(i) END
+				ELSE quo[i] := c; INC(quoL)
+				END
+			ELSE
+				i := 0;
+				WHILE i # quoL DO quo[i] := xBuf[i + yL]; INC(i) END
+			END
+		END;
+		IF doRem THEN
+			remNeg := yNeg & (remL # 0);
+			IF (xNeg # yNeg) & (remL # 0) THEN Subtract(y, xBuf, rem, yL, remL, remL)
+			ELSE
+				i := 0;
+				WHILE i # remL DO rem[i] := xBuf[i]; INC(i) END
+			END
+		END
+	END GetQuoRem;
+
+	PROCEDURE BinPower (x: Integer; exp: INTEGER; y: Integer; xL: Index; OUT yL: Index);
+		VAR zL: Index; b: INTEGER; z: Integer;
+	BEGIN
+		ASSERT(exp > 0, 20); ASSERT(xL # 0, 21);
+		b := 1;
+		WHILE 2 * b <= exp DO b := 2 * b END;
+		y[0] := 1; yL := 1; NEW(z, LEN(y^));
+		(* y^b * x^exp = const.) & (2 * b > exp) *)
+		WHILE (exp # 0) OR (b # 1) DO
+			IF exp >= b THEN
+				exp := exp - b;
+				IF xL <= yL THEN Multiply(x, y, z, xL, yL, zL) ELSE Multiply(y, x, z, yL, xL, zL) END
+			ELSE b := b DIV 2; Multiply(y, y, z, yL, yL, zL)
+			END;
+			yL := zL;
+			REPEAT DEC(zL); y[zL] := z[zL] UNTIL zL = 0
+		END
+	END BinPower;
+
+	(* Data Format Support *)
+
+	PROCEDURE New (nofDigits: Index): Integer;
+		VAR x: Integer;
+	BEGIN
+		NEW(x, nofDigits + 2); RETURN x
+	END New;
+
+	PROCEDURE SetLength (x: Integer; len: Index; negative: BOOLEAN);
+		VAR low, high: Digit;
+	BEGIN
+		ASSERT(len >= 0, 20); ASSERT(~negative OR (len # 0), 21);
+		IF negative THEN len := -len END;
+		low := SHORT(len MOD 10000H - 8000H); high := SHORT(len DIV 10000H);
+		x[LEN(x^) - 1] := low; x[LEN(x^) - 2] := high
+	END SetLength;
+
+	PROCEDURE GetLength (x: Integer; OUT len: Index; OUT negative: BOOLEAN);
+		VAR low, high: Digit;
+	BEGIN
+		low := x[LEN(x^) - 1]; high := x[LEN(x^) - 2];
+		len := low + 8000H + high * 10000H;
+		negative := len < 0; len := ABS(len)
+	END GetLength;
+
+	(* Exported Services *)
+
+	PROCEDURE Long* (x: LONGINT): Integer;
+		VAR i: Index; negative: BOOLEAN; int: Integer;
+	BEGIN
+		IF x # 0 THEN
+			negative := x < 0; x := ABS(x);
+			int := New(5); i := 0;
+			REPEAT int[i] := SHORT(SHORT(x MOD B)); x := x DIV B; INC(i) UNTIL x = 0;
+			SetLength(int, i, negative)
+		ELSE int := zero
+		END;
+		RETURN int
+	END Long;
+
+	PROCEDURE Short* (x: Integer): LONGINT;
+		VAR i: Index; res: LONGINT; negative: BOOLEAN;
+	BEGIN
+		res := 0; GetLength(x, i, negative);
+		WHILE i # 0 DO DEC(i); res := res * B + x[i] END;
+		IF negative THEN res := -res END;
+		RETURN res
+	END Short;
+
+	PROCEDURE Entier* (x: REAL): Integer;
+		VAR mL, yL, i: Index; mx: REAL; ex: INTEGER; neg: BOOLEAN; y, z: Integer;
+
+		PROCEDURE Inc(m: Integer; VAR mL: Index);
+			VAR i: Index;
+		BEGIN
+			i := 0;
+			WHILE m[i] = B - 1 DO m[i] := 0; INC(i) END;
+			INC(m[i]);
+			IF i = mL THEN INC(mL); m[mL] := 0 END
+		END Inc;
+
+		PROCEDURE Double (m: Integer; VAR mL: Index);
+			VAR i: Index; c: Digit;
+		BEGIN
+			i := 0; c := 0;
+			WHILE i < mL DO
+				c := SHORT(c + m[i] * 2); m[i] := SHORT(c MOD B); c := SHORT(c DIV B);
+				INC(i)
+			END;
+			IF c # 0 THEN INC(mL); m[mL] := 0; m[i] := c END
+		END Double;
+
+	BEGIN
+		IF (x >= 1) OR (x < 0) THEN
+			neg := x < 0; x := ABS(x);
+			mL := 0; buf6[0] := 0; mx := Math.Mantissa(x); ex := Math.Exponent(x);
+			WHILE (mx # 0) & (ex > 0) DO	(* mx * 2^ex + m * 2^ex = const. *)
+				IF ENTIER(mx) = 1 THEN Inc(buf6, mL); mx := mx - 1
+				ELSE ASSERT(ENTIER(mx) = 0, 100)
+				END;
+				Double(buf6, mL); mx := 2 * mx; DEC(ex)
+			END;
+			IF (ENTIER(mx) = 1) & (ex = 0) THEN Inc(buf6, mL); mx := mx - 1 END;
+			IF ex > 0 THEN
+				y := New(mL + SHORT(ENTIER(Math.Ln(2) * ex / Math.Ln(B)) + 1));
+				z := New(SHORT(ENTIER(Math.Ln(2) * ex / Math.Ln(B)) + 1));
+				BinPower(two, ex, z, 1, yL);
+				IF mL <= yL THEN Multiply(buf6, z, y, mL, yL, yL) ELSE Multiply(z, buf6, y, yL, mL, yL) END
+			ELSE
+				y := New(mL + 1); yL := mL;
+				i := 0;
+				WHILE i # mL DO y[i] := buf6[i]; INC(i) END
+			END;
+			IF neg & (mx # 0) THEN Inc(y, yL) END;
+			SetLength(y, yL, neg)
+		ELSE y := zero
+		END;
+		RETURN y
+	END Entier;
+
+	PROCEDURE Float* (x: Integer): REAL;
+		VAR i: Index; y: REAL; negative: BOOLEAN;
+	BEGIN
+		y := 0; GetLength(x, i, negative);
+		WHILE i # 0 DO DEC(i); y := y * B + x[i] END;
+		IF negative THEN y := -y END;
+		RETURN y
+	END Float;
+
+	PROCEDURE Sign* (x: Integer): INTEGER;
+		VAR len: Index; negative: BOOLEAN;
+	BEGIN
+		GetLength(x, len, negative);
+		IF len = 0 THEN RETURN 0
+		ELSIF negative THEN RETURN -1
+		ELSE RETURN 1
+		END
+	END Sign;
+
+	PROCEDURE Abs* (x: Integer): Integer;
+		VAR len: Index; negative: BOOLEAN; y: Integer;
+	BEGIN
+		GetLength(x, len, negative);
+		IF negative THEN
+			y := New(len); SetLength(y, len, FALSE);
+			REPEAT DEC(len); y[len] := x[len] UNTIL len = 0
+		ELSE y := x
+		END;
+		RETURN y
+	END Abs;
+
+	PROCEDURE Digits10Of* (x: Integer): INTEGER;
+		VAR i, n: Index; d: Digit; negative: BOOLEAN;
+	BEGIN
+		GetLength(x, n, negative);
+		IF n # 0 THEN
+			d := x[n - 1]; i := 0;
+			REPEAT INC(i); d := SHORT(d DIV 10) UNTIL d = 0;
+			n := DecPerDig * (n - 1) + i
+		END;
+		RETURN n
+	END Digits10Of;
+
+	PROCEDURE ThisDigit10* (x: Integer; exp10: INTEGER): CHAR;
+		VAR i, n: Index; d: Digit; negative: BOOLEAN;
+	BEGIN
+		ASSERT(exp10 >= 0, 20);
+		GetLength(x, n, negative); i := exp10 DIV DecPerDig;
+		IF n > i THEN
+			d := x[i]; i := exp10 MOD DecPerDig;
+			WHILE i # 0 DO d := SHORT(d DIV 10); DEC(i) END;
+			d := SHORT(d MOD 10)
+		ELSE d := 0
+		END;
+		RETURN CHR(ORD("0") + d)
+	END ThisDigit10;
+
+	PROCEDURE Compare* (x, y: Integer): INTEGER;
+		VAR xL, yL: Index; res: INTEGER; xNeg, yNeg: BOOLEAN;
+	BEGIN
+		GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
+		IF xNeg = yNeg THEN
+			IF (xL = yL) & (xL # 0) THEN
+				DEC(xL);
+				WHILE (xL # 0) & (x[xL] = y[xL]) DO DEC(xL) END;
+				IF x[xL] = y[xL] THEN res := 0 ELSIF (x[xL] < y[xL]) = xNeg THEN res := 1 ELSE res := -1 END
+			ELSE
+				IF xL = yL THEN res := 0 ELSIF (xL < yL) = xNeg THEN res := 1 ELSE res := -1 END
+			END
+		ELSIF xNeg THEN res := -1
+		ELSE res := 1
+		END;
+		RETURN res
+	END Compare;
+
+	PROCEDURE AddOp (x, y: Integer; subtract: BOOLEAN): Integer;
+		VAR i, d, xL, yL, intL: Index; xNeg, yNeg: BOOLEAN; int: Integer;
+	BEGIN
+		GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
+		IF yL = 0 THEN int := x
+		ELSIF xL = 0 THEN
+			IF subtract THEN
+				int := New(yL); SetLength(int, yL, ~yNeg);
+				REPEAT DEC(yL); int[yL] := y[yL] UNTIL yL = 0
+			ELSE int := y
+			END
+		ELSIF (xNeg = yNeg) # subtract THEN
+			int := New(MAX(xL, yL) + 1); Add(x, y, int, xL, yL, intL); SetLength(int, intL, xNeg)
+		ELSE
+			d := xL - yL;
+			IF d # 0 THEN i := MAX(xL, yL) - 1
+			ELSE
+				i := xL;
+				REPEAT DEC(i); d := x[i] - y[i] UNTIL (i = 0) OR (d # 0)
+			END;
+			IF d > 0 THEN
+				int := New(i + 1); Subtract(x, y, int, xL, yL, intL); SetLength(int, intL, xNeg)
+			ELSIF d < 0 THEN
+				int := New(i + 1); Subtract(y, x, int, yL, xL, intL); SetLength(int, intL, yNeg # subtract)
+			ELSE int := zero
+			END
+		END;
+		RETURN int
+	END AddOp;
+
+	PROCEDURE Sum* (x, y: Integer): Integer;
+	BEGIN
+		RETURN AddOp(x, y, FALSE)
+	END Sum;
+
+	PROCEDURE Difference*(x, y: Integer): Integer;
+	BEGIN
+		RETURN AddOp(x, y, TRUE)
+	END Difference;
+
+	PROCEDURE Product* (x, y: Integer): Integer;
+		VAR xL, yL, intL: Index; neg, xNeg, yNeg: BOOLEAN; int: Integer;
+	BEGIN
+		GetLength(x, xL, xNeg); GetLength(y, yL, yNeg); neg := xNeg # yNeg;
+		IF xL > yL THEN int := x; x := y; y := int; intL := xL; xL := yL; yL := intL; xNeg := yNeg END;
+		(* x.nofDigits <= y.nofDigits - yNeg no more valid! *)
+		IF xL = 0 THEN int := zero
+		ELSIF (xL = 1) & (x[0] = 1) THEN
+			IF xNeg THEN
+				int := New(yL); SetLength(int, yL, neg);
+				REPEAT DEC(yL); int[yL] := y[yL] UNTIL yL = 0
+			ELSE int := y
+			END
+		ELSE
+			int := New(xL + yL); Multiply(x, y, int, xL, yL, intL); SetLength(int, intL, neg)
+		END;
+		RETURN int
+	END Product;
+
+	PROCEDURE Quotient* (x, y: Integer): Integer;
+		VAR xL, yL, intL, remL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN;
+			int: Integer;
+	BEGIN	
+		GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
+		ASSERT(yL # 0, 20);
+		IF xL < yL THEN int := zero
+		ELSIF (yL = 1) & (y[0] = 1) THEN
+			IF yNeg THEN
+				int := New(xL); SetLength(int, xL, ~xNeg);
+				REPEAT DEC(xL); int[xL] := x[xL] UNTIL xL = 0
+			ELSE int := x
+			END
+		ELSE
+			int := New(xL - yL + 2);
+			GetQuoRem(x, y, xL, yL, xNeg, yNeg, int, NIL, intL, remL, qNeg, rNeg, TRUE, FALSE);
+			SetLength(int, intL, qNeg)
+		END;
+		RETURN int
+	END Quotient;
+
+	PROCEDURE Remainder* (x, y: Integer): Integer;
+		VAR xL, yL, intL, quoL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN;
+			int: Integer;
+	BEGIN
+		GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
+		ASSERT(yL # 0, 20);
+		IF xL < yL THEN int := x
+		ELSIF (yL = 1) & (y[0] = 1) THEN int := zero
+		ELSE
+			int := New(yL);
+			GetQuoRem(x, y, xL, yL, xNeg, yNeg, NIL, int, quoL, intL, qNeg, rNeg, FALSE, TRUE);
+			SetLength(int, intL, rNeg)
+		END;
+		RETURN int
+	END Remainder;
+
+	PROCEDURE QuoRem* (x, y: Integer; OUT quo, rem: Integer);
+		VAR xL, yL, quoL, remL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN;
+	BEGIN
+		GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
+		ASSERT(yL # 0, 20);
+		IF xL < yL THEN quo := zero; rem := x
+		ELSIF (yL = 1) & (y[0] = 1) THEN
+			rem := zero;
+			IF yNeg THEN
+				quo := New(xL); SetLength(quo, xL, ~xNeg);
+				REPEAT DEC(xL); quo[xL] := x[xL] UNTIL xL = 0
+			ELSE quo := x
+			END
+		ELSE
+			quo := New(xL - yL + 2); rem := New(yL);
+			GetQuoRem(x, y, xL, yL, xNeg, yNeg, quo, rem, quoL, remL, qNeg, rNeg, TRUE, TRUE);
+			SetLength(quo, quoL, qNeg); SetLength(rem, remL, rNeg)
+		END
+	END QuoRem;
+
+	PROCEDURE GCD* (x, y: Integer): Integer;
+		VAR xL, yL, i: Index; h: Digit; negative: BOOLEAN; xBuf, yBuf, int: Integer;
+	BEGIN
+		GetLength(x, xL, negative); GetLength(y, yL, negative);
+		IF xL = 0 THEN int := y
+		ELSIF yL = 0 THEN int := x
+		ELSE
+			IF xL >= yL THEN xBuf := CopyOf(x, xL + 1); yBuf := CopyOf(y, yL + 1)
+			ELSE xBuf := CopyOf(y, yL + 1); yBuf := CopyOf(x, xL + 1); i := xL; xL := yL; yL := i
+			END;
+			WHILE yL # 0 DO
+				DecomposeQuoRem(xBuf, yBuf, xL, yL);
+				xL := yL;
+				WHILE (xL # 0) & (xBuf[xL - 1] = 0) DO DEC(xL) END;
+				i := yL;
+				WHILE i # 0 DO DEC(i); h := xBuf[i]; xBuf[i] := yBuf[i]; yBuf[i] := h END;
+				i := xL; xL := yL; yL := i
+			END;
+			int := New(xL); SetLength(int, xL, FALSE);
+			WHILE xL # 0 DO DEC(xL); int[xL] := xBuf[xL] END
+		END;
+		RETURN int
+	END GCD;
+
+	PROCEDURE Power* (x: Integer; exp: INTEGER): Integer;
+		VAR xL, intL: Index; negative: BOOLEAN; int: Integer;
+	BEGIN
+		ASSERT(exp >= 0, 20);
+		GetLength(x, xL, negative);
+		IF xL = 0 THEN int := zero
+		ELSIF (xL = 1) & (x[0] = 1) THEN
+			IF negative & ~ODD(exp) THEN
+				int := New(xL); SetLength(int, xL, FALSE);
+				REPEAT DEC(xL); int[xL] := x[xL] UNTIL xL = 0
+			ELSE int := x
+			END
+		ELSIF exp = 0 THEN int := one
+		ELSIF exp = 1 THEN int := x
+		ELSE
+			int := New(SHORT((xL - 1) * exp + ENTIER(Math.Ln(x[xL - 1] + 1) * exp / Math.Ln(B)) + 1));
+			BinPower(x, exp, int, xL, intL); SetLength(int, intL, negative & ODD(exp))
+		END;
+		RETURN int
+	END Power;
+
+	(* Read from and Write to String and File *)
+
+	PROCEDURE ConvertFromString* (IN s: ARRAY OF CHAR; OUT x: Integer);
+		VAR i, j, k: INTEGER; dig, b: Digit; ch: CHAR; negative: BOOLEAN; new: Integer;
+	BEGIN
+		i := 0; ch := s[0];
+		WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END;
+		negative := ch = "-";
+		IF negative THEN INC(i); ch := s[i] END;
+		IF ch = "+" THEN INC(i); ch := s[i] END;
+		WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END;
+		ASSERT((ch >= "0") & (ch <= "9"), 20);
+		WHILE ch = "0" DO INC(i); ch := s[i] END;
+		IF (ch > "0") & (ch <= "9") THEN
+			j := i;
+			REPEAT INC(j); ch := s[j] UNTIL (ch < "0") OR (ch > "9");
+			k := (j - i - 1) DIV DecPerDig + 2;
+			new := New(k); SetLength(new, k - 1, negative);
+			k := (j - i) MOD DecPerDig;
+			IF k # 0 THEN
+				b := 1; DEC(k);
+				WHILE k # 0 DO DEC(k); b := SHORT(b * 10) END
+			ELSE b := B DIV 10
+			END;
+			REPEAT
+				dig := 0;
+				WHILE b # 0 DO
+					dig := SHORT(dig + b * (ORD(s[i]) - ORD("0"))); b := SHORT(b DIV 10);
+					INC(i)
+				END;
+				new[(j - i) DIV DecPerDig] := dig; b := B DIV 10
+			UNTIL i = j;
+			x := new
+		ELSE x := zero
+		END
+	END ConvertFromString;
+
+	PROCEDURE ConvertToString* (x: Integer; OUT s: ARRAY OF CHAR);
+		VAR j: Index; i: INTEGER; d, b: Digit; negative: BOOLEAN;
+	BEGIN
+		GetLength(x, j, negative);
+		IF negative THEN s[0] := "-"; i := 1 ELSE i := 0 END;
+		IF j # 0 THEN
+			DEC(j); d := x[j]; b := B DIV 10;
+			WHILE d DIV b = 0 DO b := SHORT(b DIV 10) END;
+			REPEAT
+				s[i] := CHR(d DIV b + ORD("0")); INC(i); d := SHORT(d MOD b); b := SHORT(b DIV 10)
+			UNTIL b = 0;
+			WHILE j # 0 DO
+				DEC(j); d := x[j]; b := B DIV 10;
+				REPEAT
+					s[i] := CHR(d DIV b + ORD("0")); INC(i); d := SHORT(d MOD b); b := SHORT(b DIV 10)
+				UNTIL b = 0
+			END
+		ELSE s[i] := "0"; INC(i)
+		END;
+		s[i] := 0X
+	END ConvertToString;
+
+	PROCEDURE Internalize* (r: Files.Reader; OUT x: Integer);
+		VAR len: Index; n, version: INTEGER; negative: BOOLEAN;
+			new: Integer; buf: ARRAY 4 OF BYTE;
+	BEGIN
+		r.ReadByte(buf[0]); version := buf[0];
+		ASSERT((version = 0) OR (version >= 128), 20);
+		IF version = 0 THEN
+			r.ReadBytes(buf, 0, 4);
+			len := (((buf[0] MOD 128) * 256 + buf[1] MOD 256) * 256
+				+ buf[2] MOD 256) * 256 + buf[3] MOD 256;
+			new := New(len); SetLength(new, len, buf[0] < 0);
+			WHILE len # 0 DO
+				DEC(len);
+				r.ReadBytes(buf, 0, 2); new[len] := SHORT((buf[0] MOD 256) * 256 + buf[1] MOD 256)
+			END;
+			x := new
+		ELSE (* version >= 128 *)
+			r.ReadByte(buf[1]); n := (buf[0] MOD 256) * 256 + buf[1] MOD 256 - 32768;
+			r.ReadBytes(buf, 0, 2); DEC(n);
+			len := (buf[0] MOD 256) * 256 + buf[1] MOD 256; negative := len < 0; len := ABS(len);
+			new := New(len); SetLength(new, len, negative);
+			WHILE n # len DO DEC(n); r.ReadBytes(buf, 0, 2) END;
+			WHILE len # 0 DO
+				DEC(len);
+				r.ReadBytes(buf, 0, 2); new[len] := SHORT((buf[0] MOD 256) * 256 + buf[1] MOD 256)
+			END;
+			x := new
+		END
+	END Internalize;
+
+	PROCEDURE Externalize* (w: Files.Writer; x: Integer);
+		VAR len, l: Index; d: Digit; i: INTEGER; negative: BOOLEAN; buf: ARRAY 4 OF BYTE;
+
+		PROCEDURE Byte(x: INTEGER): BYTE;
+		BEGIN
+			ASSERT((x >= MIN(BYTE)) & (x <= MAX(BYTE) - MIN(BYTE)), 20);
+			IF x > MAX(BYTE) THEN RETURN SHORT(SHORT(x - 256)) ELSE RETURN SHORT(SHORT(x)) END
+		END Byte;
+
+	BEGIN
+		GetLength(x, len, negative); l := len; i := 4;
+		REPEAT DEC(i); buf[i] := Byte(l MOD 256); l := l DIV 256 UNTIL i = 0;
+		IF negative THEN buf[0] := Byte(128 + buf[0] MOD 256) END;
+		w.WriteByte(0); w.WriteBytes(buf, 0, 4);
+		WHILE len # 0 DO
+			DEC(len);
+			d := x[len]; buf[0] := Byte(d DIV 256); buf[1] := Byte(d MOD 256); w.WriteBytes(buf, 0, 2)
+		END
+	END Externalize;
+
+BEGIN
+	ASSERT(B <= BinBase, 20);
+	zero := New(0); SetLength(zero, 0, FALSE);
+	one := New(1); one[0] := 1; SetLength(one, 1, FALSE);
+	two := New(1); two[0] := 2; SetLength(two, 1, FALSE);
+	NEW(buf6, 6)
+END Integers.

BlackBox/System/Mod/Log.txt

@@ -0,0 +1,144 @@
+MODULE Log;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Log.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Kernel;
+
+	TYPE
+		Hook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
+
+	VAR
+		synch*: BOOLEAN;	(* ~synch => output only on FlushBuf *)
+		force*: BOOLEAN;	(* force => every call causes a Views.Restore *)
+
+		hook: Hook;
+
+	PROCEDURE (log: Hook) Guard* (o: ANYPTR): BOOLEAN, NEW, ABSTRACT;
+
+	PROCEDURE (log: Hook) ClearBuf*, NEW, ABSTRACT;
+	PROCEDURE (log: Hook) FlushBuf*, NEW, ABSTRACT;
+
+	PROCEDURE (log: Hook) Beep*, NEW, ABSTRACT;
+	PROCEDURE (log: Hook) Char* (ch: CHAR), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) Int* (n: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) Real* (x: REAL), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) String* (IN str: ARRAY OF CHAR), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) Bool* (x: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) Set* (x: SET), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) IntForm* (x: INTEGER; base, minWidth: INTEGER; fillCh: CHAR;
+														showBase: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) RealForm* (x: REAL; precision, minW, expW: INTEGER;
+																fillCh: CHAR), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) Tab*, NEW, ABSTRACT;
+	PROCEDURE (log: Hook) Ln*, NEW, ABSTRACT;
+	PROCEDURE (log: Hook) Para*, NEW, ABSTRACT;
+	PROCEDURE (log: Hook) View* (v: ANYPTR), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) ViewForm* (v: ANYPTR; w, h: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (log: Hook) ParamMsg* (IN s, p0, p1, p2: ARRAY OF CHAR), NEW, ABSTRACT;
+
+
+	PROCEDURE SetHook*(h: Hook);
+	BEGIN
+		hook := h
+	END SetHook;
+
+	PROCEDURE ClearBuf*;
+	BEGIN
+		IF hook # NIL THEN hook.ClearBuf END
+	END ClearBuf;
+
+	PROCEDURE FlushBuf*;
+	BEGIN
+		IF hook # NIL THEN hook.FlushBuf END
+	END FlushBuf;
+
+	PROCEDURE Guard* (o: ANYPTR): BOOLEAN;
+	BEGIN
+		RETURN (hook # NIL) & hook.Guard(o)
+	END Guard;
+
+
+	PROCEDURE Beep*;
+	BEGIN
+		IF hook # NIL THEN hook.Beep() END
+	END Beep;
+
+	PROCEDURE Char* (ch: CHAR);
+	BEGIN
+		IF hook # NIL THEN hook.Char(ch) END
+	END Char;
+
+	PROCEDURE Int* (n: INTEGER);
+	BEGIN
+		IF hook # NIL THEN hook.Int(n) END
+	END Int;
+
+	PROCEDURE Real* (x: REAL);
+	BEGIN
+		IF hook # NIL THEN hook.Real(x) END
+	END Real;
+
+	PROCEDURE String* (str: ARRAY OF CHAR);
+	BEGIN
+		IF hook # NIL THEN hook.String(str) END
+	END String;
+
+	PROCEDURE Bool* (x: BOOLEAN);
+	BEGIN
+		IF hook # NIL THEN hook.Bool(x) END
+	END Bool;
+
+	PROCEDURE Set* (x: SET);
+	BEGIN
+		IF hook # NIL THEN hook.Set(x) END
+	END Set;
+
+	PROCEDURE IntForm* (x: INTEGER; base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN);
+	BEGIN
+		IF hook # NIL THEN hook.IntForm(x, base, minWidth, fillCh, showBase) END
+	END IntForm;
+
+	PROCEDURE RealForm* (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR);
+	BEGIN
+		IF hook # NIL THEN hook.RealForm(x, precision, minW, expW, fillCh) END
+	END RealForm;
+
+	PROCEDURE Tab*;
+	BEGIN
+		IF hook # NIL THEN hook.Tab END
+	END Tab;
+
+	PROCEDURE Ln*;
+	BEGIN
+		IF hook # NIL THEN hook.Ln END
+	END Ln;
+
+	PROCEDURE Para*;
+	BEGIN
+		IF hook # NIL THEN hook.Para END
+	END Para;
+
+	PROCEDURE View* (v: ANYPTR);
+	BEGIN
+		IF hook # NIL THEN hook.View(v) END
+	END View;
+
+	PROCEDURE ViewForm* (v: ANYPTR; w, h: INTEGER);
+	BEGIN
+		IF hook # NIL THEN hook.ViewForm(v, w, h) END
+	END ViewForm;
+
+	PROCEDURE ParamMsg* (s, p0, p1, p2: ARRAY OF CHAR);
+	BEGIN
+		IF hook # NIL THEN hook.ParamMsg(s, p0, p1, p2) END
+	END ParamMsg;
+
+	PROCEDURE Msg* (s: ARRAY OF CHAR);
+	BEGIN
+		ParamMsg(s, "", "", "")
+	END Msg;
+
+BEGIN
+	synch := TRUE; force := FALSE
+END Log.

BlackBox/System/Mod/Mechanisms.txt

@@ -0,0 +1,129 @@
+MODULE Mechanisms;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Mechanisms.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Kernel, Views;
+
+	CONST
+		(** FocusBorderCursor/SelBorderCursor result **)
+		inside* = -1; outside* = -2;	(** plus defined Ports cursors **)
+
+		(** TrackToResize op **)
+		cancelResize* = 0; resize* = 1;
+
+		(** TrackToDrop op **)
+		cancelDrop* = 0; copy* = 1; move* = 2; link* = 3;
+
+		(** TrackToPick op **)
+		cancelPick* = 0; pick* = 1; pickForeign* = 2;
+
+	TYPE
+		Hook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
+
+	VAR hook: Hook;
+
+	PROCEDURE SetHook*(h: Hook);
+	BEGIN
+		hook := h
+	END SetHook;
+
+	PROCEDURE (hook: Hook) MarkFocusBorder* (host: Views.Frame;
+										focus: Views.View; l, t, r, b: INTEGER;
+										show: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (hook: Hook) MarkSingletonBorder* (host: Views.Frame;
+										view: Views.View; l, t, r, b: INTEGER;
+										show: BOOLEAN), NEW, ABSTRACT;
+
+	PROCEDURE (hook: Hook) FocusBorderCursor* (host: Views.Frame;
+										view: Views.View; l, t, r, b: INTEGER;
+										x, y: INTEGER): INTEGER, NEW, ABSTRACT;
+	PROCEDURE (hook: Hook) SelBorderCursor* (host: Views.Frame;
+										view: Views.View; l, t, r, b: INTEGER;
+										x, y: INTEGER): INTEGER, NEW, ABSTRACT;
+
+	PROCEDURE (hook: Hook) TrackToResize* (host: Views.Frame; view: Views.View;
+										minW, maxW, minH, maxH: INTEGER;
+										VAR l, t, r, b: INTEGER; VAR op: INTEGER;
+										VAR x, y: INTEGER; VAR buttons: SET), NEW, ABSTRACT;
+	PROCEDURE (hook: Hook) TrackToDrop* (source: Views.Frame; view: Views.View;
+										isSingle: BOOLEAN; w, h, rx, ry: INTEGER;
+										VAR dest: Views.Frame; VAR destX, destY: INTEGER;
+										VAR op: INTEGER;
+										VAR x, y: INTEGER; VAR buttons: SET), NEW, ABSTRACT;
+	PROCEDURE (hook: Hook) TrackToPick* (source: Views.Frame;
+										VAR dest: Views.Frame; VAR destX, destY: INTEGER;
+										VAR op: INTEGER;
+										VAR x, y: INTEGER; VAR buttons: SET), NEW, ABSTRACT;
+
+	PROCEDURE (hook: Hook) PopUpAndSelect* (f: Views.Frame;
+										n, this: INTEGER;
+										s: ARRAY OF ARRAY OF CHAR;
+										enabled, checked: ARRAY OF BOOLEAN;
+										VAR i: INTEGER;
+										VAR x, y: INTEGER; VAR buttons: SET), NEW, ABSTRACT;
+
+	PROCEDURE MarkFocusBorder* (host: Views.Frame;
+										focus: Views.View; l, t, r, b: INTEGER;
+										show: BOOLEAN);
+	BEGIN
+		hook.MarkFocusBorder(host, focus, l, t, r, b, show)
+	END MarkFocusBorder;
+
+	PROCEDURE MarkSingletonBorder* (host: Views.Frame;
+										view: Views.View; l, t, r, b: INTEGER;
+										show: BOOLEAN);
+	BEGIN
+		hook.MarkSingletonBorder(host, view, l, t, r, b, show)
+	END MarkSingletonBorder;
+
+	PROCEDURE FocusBorderCursor* (host: Views.Frame;
+										view: Views.View; l, t, r, b: INTEGER;
+										x, y: INTEGER): INTEGER;
+	BEGIN
+		RETURN hook.FocusBorderCursor(host, view, l, t, r, b, x, y)
+	END FocusBorderCursor;
+
+	PROCEDURE SelBorderCursor* (host: Views.Frame;
+										view: Views.View; l, t, r, b: INTEGER;
+										x, y: INTEGER): INTEGER;
+	BEGIN
+		RETURN hook.SelBorderCursor(host, view, l, t, r, b, x, y)
+	END SelBorderCursor;
+
+	PROCEDURE TrackToResize* (host: Views.Frame; view: Views.View;
+										minW, maxW, minH, maxH: INTEGER;
+										VAR l, t, r, b: INTEGER; VAR op: INTEGER;
+										VAR x, y: INTEGER; VAR buttons: SET);
+	BEGIN
+		hook.TrackToResize(host, view, minW, maxW, minH, maxH, l, t, r, b, op, x, y, buttons)
+	END TrackToResize;
+
+	PROCEDURE TrackToDrop* (source: Views.Frame; view: Views.View;
+										isSingle: BOOLEAN; w, h, rx, ry: INTEGER;
+										VAR dest: Views.Frame; VAR destX, destY: INTEGER;
+										VAR op: INTEGER;
+										VAR x, y: INTEGER; VAR buttons: SET);
+	BEGIN
+		hook.TrackToDrop(source, view, isSingle, w, h, rx, ry, dest, destX, destY, op, x, y, buttons)
+	END TrackToDrop;
+
+	PROCEDURE TrackToPick* (source: Views.Frame;
+										VAR dest: Views.Frame; VAR destX, destY: INTEGER;
+										VAR op: INTEGER;
+										VAR x, y: INTEGER; VAR buttons: SET);
+	BEGIN
+		hook.TrackToPick(source, dest, destX, destY, op, x, y, buttons)
+	END TrackToPick;
+
+	PROCEDURE PopUpAndSelect* (f: Views.Frame;
+										n, this: INTEGER;
+										s: ARRAY OF ARRAY OF CHAR;
+										enabled, checked: ARRAY OF BOOLEAN;
+										VAR i: INTEGER;
+										VAR x, y: INTEGER; VAR buttons: SET);
+	BEGIN
+		hook.PopUpAndSelect(f, n, this, s, enabled, checked, i, x, y, buttons)
+	END PopUpAndSelect;
+
+END Mechanisms.

BlackBox/System/Mod/Models.txt

@@ -0,0 +1,258 @@
+MODULE Models;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Models.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Kernel, Stores, Sequencers;
+
+	CONST
+		minVersion = 0; maxVersion = 0;
+
+		clean* = Sequencers.clean; 
+		notUndoable* = Sequencers.notUndoable;
+		invisible* = Sequencers.invisible; 
+
+	TYPE
+		Model* = POINTER TO ABSTRACT RECORD (Stores.Store)
+			era: INTEGER;	(* stable era >= x *)
+			guard: INTEGER	(* = TrapCount()+1 if model is addressee of ongoing broadcast *)
+		END;
+
+		Context* = POINTER TO ABSTRACT RECORD END;
+
+		Proposal* = ABSTRACT RECORD END;
+
+
+		Message* = ABSTRACT RECORD
+			model-: Model;
+			era-: INTEGER
+		END;
+
+		NeutralizeMsg* = RECORD (Message) END;
+
+		UpdateMsg* = EXTENSIBLE RECORD (Message) END;
+
+		
+	VAR domainGuard: INTEGER;	(* = TrapCount()+1 if domain is addressee of ongoing domaincast *)
+
+
+	(** 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, maxVersion, thisVersion)
+	END Internalize;
+
+	PROCEDURE (m: Model) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
+	BEGIN
+		m.Externalize^(wr);
+		wr.WriteVersion(maxVersion)
+	END Externalize;
+	
+
+	(** Context **)
+
+	PROCEDURE (c: Context) ThisModel* (): Model, NEW, ABSTRACT;
+	PROCEDURE (c: Context) Normalize* (): BOOLEAN, NEW, ABSTRACT;
+	PROCEDURE (c: Context) GetSize* (OUT w, h: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (c: Context) SetSize* (w, h: INTEGER), NEW, EMPTY;
+	PROCEDURE (c: Context) MakeVisible* (l, t, r, b: INTEGER), NEW, EMPTY;
+	PROCEDURE (c: Context) Consider* (VAR p: Proposal), NEW, EMPTY;
+
+
+	(** miscellaneous **)
+
+	PROCEDURE Era* (m: Model): INTEGER;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		RETURN m.era
+	END Era;
+
+
+	PROCEDURE CopyOf* (m: Model): Model;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		RETURN Stores.CopyOf(m)(Model)
+	END CopyOf;
+
+	PROCEDURE BeginScript* (m: Model; name: Stores.OpName; OUT script: Stores.Operation);
+	(** post: (script # NIL) iff (m.domain # NIL) **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			WITH seq: Sequencers.Sequencer DO
+				seq.BeginScript(name, script)
+			ELSE
+			END
+		ELSE script := NIL
+		END
+	END BeginScript;
+
+	PROCEDURE Do* (m: Model; name: Stores.OpName; op: Stores.Operation);
+	(** pre: m # NIL, op # NIL, ~op.inUse **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20); ASSERT(op # NIL, 21); (* ASSERT(~op.inUse, 22); *)
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			WITH seq: Sequencers.Sequencer DO
+				seq.Do(m, name, op)
+			ELSE
+				op.Do
+			END
+		ELSE
+			op.Do
+		END
+	END Do;
+
+	PROCEDURE LastOp* (m: Model): Stores.Operation;
+	(** pre: m # NIL **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			WITH seq: Sequencers.Sequencer DO
+				RETURN seq.LastOp(m)
+			ELSE
+				RETURN NIL
+			END
+		ELSE
+			RETURN NIL
+		END
+	END LastOp;
+
+	PROCEDURE Bunch* (m: Model);
+	(** pre: m # NIL, m.Domain() # NIL **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20); ASSERT(m.Domain() # NIL, 21);
+		seq := m.Domain().GetSequencer();
+		ASSERT(seq # NIL, 22);
+		WITH seq: Sequencers.Sequencer DO
+			seq.Bunch(m)
+		ELSE
+		END
+	END Bunch;
+
+	PROCEDURE StopBunching* (m: Model);
+	(** pre: m # NIL **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			WITH seq: Sequencers.Sequencer DO
+				seq.StopBunching
+			ELSE
+			END
+		END
+	END StopBunching;
+
+	PROCEDURE EndScript* (m: Model; script: Stores.Operation);
+	(** pre: (script # NIL) iff (m.seq # NIL) **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			ASSERT(script # NIL, 21);
+			WITH seq: Sequencers.Sequencer DO
+				seq.EndScript(script)
+			ELSE
+				ASSERT(script = NIL, 21)
+			END
+		ELSE
+			ASSERT(script = NIL, 21)
+		END
+	END EndScript;
+
+
+	PROCEDURE BeginModification* (type: INTEGER; m: Model);
+	(** pre: m # NIL **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			WITH seq: Sequencers.Sequencer DO
+				seq.BeginModification(type, m)
+			ELSE
+			END
+		END
+	END BeginModification;
+
+	PROCEDURE EndModification* (type: INTEGER; m: Model);
+	(** pre: m # NIL **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			WITH seq: Sequencers.Sequencer DO
+				seq.EndModification(type, m)
+			ELSE
+			END
+		END
+	END EndModification;
+
+	PROCEDURE SetDirty* (m: Model);
+	(** pre: m # NIL **)
+		VAR seq: ANYPTR;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			WITH seq: Sequencers.Sequencer DO
+				seq.SetDirty(TRUE)
+			ELSE
+			END
+		END
+	END SetDirty;
+
+	PROCEDURE Domaincast* (d: Stores.Domain; VAR msg: Message);
+		VAR g: INTEGER; seq: ANYPTR;
+	BEGIN
+		IF d # NIL THEN
+			seq := d.GetSequencer();
+			IF (seq # NIL) & (seq IS Sequencers.Sequencer) THEN
+				msg.model := NIL; msg.era := -1;
+				g := Kernel.trapCount + 1;
+				IF domainGuard > 0 THEN ASSERT(domainGuard # g, 20) END;
+				domainGuard := g;
+				seq(Sequencers.Sequencer).Handle(msg);
+				domainGuard := 0
+			END
+		END
+	END Domaincast;
+
+	PROCEDURE Broadcast* (m: Model; VAR msg: Message);
+	(** pre: model # NIL **)
+	(** post: model.era > model.era', msg.model = model, msg.era = model.era' + 1,
+		model.seq # NIL => msg sent to seq **)
+		VAR seq: ANYPTR; g: INTEGER;
+	BEGIN
+		ASSERT(m # NIL, 20);
+		msg.model := m;
+		IF m.Domain() # NIL THEN seq := m.Domain().GetSequencer() ELSE seq := NIL END;
+		IF seq # NIL THEN
+			WITH seq: Sequencers.Sequencer DO
+				INC(m.era); msg.era := m.era;
+				g := Kernel.trapCount + 1;
+				IF m.guard > 0 THEN ASSERT(m.guard # g, 21) END;
+				m.guard := g;
+				seq.Handle(msg);
+				m.guard := 0
+			ELSE
+			END
+		END
+	END Broadcast;
+
+BEGIN
+	domainGuard := 0
+END Models.

BlackBox/System/Mod/Ports.txt

@@ -0,0 +1,318 @@
+MODULE Ports;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Ports.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Fonts;
+
+	CONST
+		(** colors **)
+		black* = 00000000H; white* = 00FFFFFFH;
+		grey6* = 00F0F0F0H; grey12* = 00E0E0E0H; grey25* = 00C0C0C0H;
+		grey50* = 00808080H; grey75* = 00404040H;
+		red* = 000000FFH; green* = 0000FF00H; blue* = 00FF0000H;
+		defaultColor* = 01000000H;
+
+		(** measures **)
+		mm* = 36000;
+		point* = 12700;
+		inch* = 914400;
+
+		(** size parameter for the DrawRect, DrawOval, DrawLine, DrawPath, and MarkRect procedures **)
+		fill* = -1;
+
+		(** path parameter for DrawPath **)
+		openPoly* = 0; closedPoly* = 1; openBezier* = 2; closedBezier* = 3;
+
+		(** modes for MarkRect **)
+		invert* = 0; hilite* = 1; dim25* = 2; dim50* = 3; dim75* = 4;
+
+		hide* = FALSE; show* = TRUE;
+
+		(** cursors **)
+		arrowCursor* = 0;
+		textCursor* = 1; graphicsCursor* = 2; tableCursor* = 3; bitmapCursor* = 4; refCursor* = 5;
+		
+		(** RestoreRect **)
+		keepBuffer* = FALSE; disposeBuffer* = TRUE;
+
+
+		(** PageMode **)
+		printer* = TRUE; screen* = FALSE;
+
+		
+	TYPE
+		Color* = INTEGER;
+
+		Point* = RECORD
+			x*, y*: INTEGER
+		END;
+
+		Port* = POINTER TO ABSTRACT RECORD
+			unit-: INTEGER;
+			printerMode: BOOLEAN;
+		END;
+
+		Rider* = POINTER TO ABSTRACT RECORD END;
+
+		Frame* = POINTER TO ABSTRACT RECORD
+			unit-, dot-: INTEGER;	(** inv: dot = point - point MOD unit **)
+			rider-: Rider;
+			gx-, gy-: INTEGER
+		END;
+
+
+	VAR
+		background*: Color;
+		dialogBackground*: Color;
+
+
+	(** Port **)
+
+	PROCEDURE (p: Port) Init* (unit: INTEGER; printerMode: BOOLEAN), NEW;
+	BEGIN
+		ASSERT((p.unit = 0) OR (p.unit = unit), 20); ASSERT(unit > 0, 21);
+		ASSERT((p.unit = 0) OR (p.printerMode = printerMode), 22);
+		p.unit := unit;
+		p.printerMode := printerMode;
+	END Init;
+
+	PROCEDURE (p: Port) GetSize* (OUT w, h: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (p: Port) SetSize* (w, h: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (p: Port) NewRider* (): Rider, NEW, ABSTRACT;
+	PROCEDURE (p: Port) OpenBuffer* (l, t, r, b: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (p: Port) CloseBuffer* (), NEW, ABSTRACT;
+
+
+	(** Rider **)
+
+	PROCEDURE (rd: Rider) SetRect* (l, t, r, b: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) GetRect* (OUT l, t, r, b: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) Base* (): Port, NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) Move* (dx, dy: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) SaveRect* (l, t, r, b: INTEGER; VAR res: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) RestoreRect* (l, t, r, b: INTEGER; dispose: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) DrawRect* (l, t, r, b, s: INTEGER; col: Color), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) DrawOval* (l, t, r, b, s: INTEGER; col: Color), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) DrawLine* (x0, y0, x1, y1, s: INTEGER; col: Color), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) DrawPath* (IN p: ARRAY OF Point; n, s: INTEGER; col: Color;
+															path: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) MarkRect* (l, t, r, b, s, mode: INTEGER; show: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) Scroll* (dx, dy: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) SetCursor* (cursor: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) Input* (OUT x, y: INTEGER; OUT modifiers: SET;
+														OUT isDown: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) DrawString* (x, y: INTEGER; col: Color; IN s: ARRAY OF CHAR;
+																font: Fonts.Font), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) CharIndex* (x, pos: INTEGER; IN s: ARRAY OF CHAR;
+																font: Fonts.Font): INTEGER, NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) CharPos* (x, index: INTEGER; IN s: ARRAY OF CHAR;
+																font: Fonts.Font): INTEGER, NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) DrawSString* (x, y: INTEGER; col: Color; IN s: ARRAY OF SHORTCHAR;
+																font: Fonts.Font), NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) SCharIndex* (x, pos: INTEGER; IN s: ARRAY OF SHORTCHAR;
+																font: Fonts.Font): INTEGER, NEW, ABSTRACT;
+	PROCEDURE (rd: Rider) SCharPos* (x, index: INTEGER; IN s: ARRAY OF SHORTCHAR;
+																font: Fonts.Font): INTEGER, NEW, ABSTRACT;
+	
+	
+	(** Frame **)
+
+	PROCEDURE (f: Frame) ConnectTo* (p: Port), NEW, EXTENSIBLE;
+		VAR w, h: INTEGER;
+	BEGIN
+		IF p # NIL THEN
+			f.rider := p.NewRider(); f.unit := p.unit;
+			p.GetSize(w, h);
+			f.dot := point - point MOD f.unit;
+		ELSE
+			f.rider := NIL; f.unit := 0
+		END
+	END ConnectTo;
+
+	PROCEDURE (f: Frame) SetOffset* (gx, gy: INTEGER), NEW, EXTENSIBLE;
+		VAR u: INTEGER;
+	BEGIN
+		u := f.unit;
+		IF ((gx - f.gx) MOD u = 0) & ((gy - f.gy) MOD u = 0) THEN
+			f.rider.Move((gx - f.gx) DIV u, (gy - f.gy) DIV u)
+		END;
+		f.gx := gx; f.gy := gy
+	END SetOffset;
+	
+	PROCEDURE (f: Frame) SaveRect* (l, t, r, b: INTEGER; VAR res: INTEGER), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		ASSERT((l <= r) & (t <= b), 20);
+		u := f.unit;
+		l := (f.gx + l) DIV u; t := (f.gy + t) DIV u;
+		r := (f.gx + r) DIV u; b := (f.gy + b) DIV u;
+		f.rider.SaveRect(l, t, r, b, res);
+	END SaveRect;
+	
+	PROCEDURE (f: Frame) RestoreRect* (l, t, r, b: INTEGER; dispose: BOOLEAN), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		ASSERT((l <= r) & (t <= b), 20);
+		u := f.unit;
+		l := (f.gx + l) DIV u; t := (f.gy + t) DIV u;
+		r := (f.gx + r) DIV u; b := (f.gy + b) DIV u;
+		f.rider.RestoreRect(l, t, r, b, dispose);
+	END RestoreRect;
+	
+	PROCEDURE (f: Frame) DrawRect* (l, t, r, b, s: INTEGER; col: Color), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		ASSERT((l <= r) & (t <= b), 20); ASSERT(s >= fill, 21);
+		u := f.unit;
+		l := (f.gx + l) DIV u; t := (f.gy + t) DIV u;
+		r := (f.gx + r) DIV u; b := (f.gy + b) DIV u;
+		s := s DIV u;
+		f.rider.DrawRect(l, t, r, b, s, col)
+	END DrawRect;
+
+	PROCEDURE (f: Frame) DrawOval* (l, t, r, b, s: INTEGER; col: Color), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		ASSERT((l <= r) & (t <= b), 20); ASSERT(s >= fill, 21);
+		u := f.unit;
+		l := (f.gx + l) DIV u; t := (f.gy + t) DIV u;
+		r := (f.gx + r) DIV u; b := (f.gy + b) DIV u;
+		s := s DIV u;
+		f.rider.DrawOval(l, t, r, b, s, col)
+	END DrawOval;
+
+	PROCEDURE (f: Frame) DrawLine* (x0, y0, x1, y1, s: INTEGER; col: Color), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		ASSERT(s >= fill, 20);
+		u := f.unit;
+		x0 := (f.gx + x0) DIV u; y0 := (f.gy + y0) DIV u;
+		x1 := (f.gx + x1) DIV u; y1 := (f.gy + y1) DIV u;
+		s := s DIV u;
+		f.rider.DrawLine(x0, y0, x1, y1, s, col)
+	END DrawLine;
+
+	PROCEDURE (f: Frame) DrawPath* (IN p: ARRAY OF Point; n, s: INTEGER; col: Color; path: INTEGER), NEW;
+
+		PROCEDURE Draw(p: ARRAY OF Point);
+			VAR i, u: INTEGER;
+		BEGIN
+			u := f.unit; s := s DIV u;
+			i := 0;
+			WHILE i # n DO
+				p[i].x := (f.gx + p[i].x) DIV u; p[i].y := (f.gy + p[i].y) DIV u;
+				INC(i)
+			END;
+			f.rider.DrawPath(p, n, s, col, path)
+		END Draw;
+
+	BEGIN
+		ASSERT(n >= 0, 20); ASSERT(n <= LEN(p), 21);
+		ASSERT((s # fill) OR (path = closedPoly) OR (path = closedBezier), 22);
+		ASSERT(s >= fill, 23);
+		Draw(p)
+	END DrawPath;
+
+	PROCEDURE (f: Frame) MarkRect* (l, t, r, b, s: INTEGER; mode: INTEGER; show: BOOLEAN), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		(* ASSERT((l <= r) & (t <= b), 20); *) ASSERT(s >= fill, 21);
+		u := f.unit;
+		l := (f.gx + l) DIV u; t := (f.gy + t) DIV u;
+		r := (f.gx + r) DIV u; b := (f.gy + b) DIV u;
+		s := s DIV u;
+		f.rider.MarkRect(l, t, r, b, s, mode, show)
+	END MarkRect;
+
+	PROCEDURE (f: Frame) Scroll* (dx, dy: INTEGER), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		u := f.unit;
+		ASSERT(dx MOD u = 0, 20); ASSERT(dy MOD u = 0, 20);
+		f.rider.Scroll(dx DIV u, dy DIV u)
+	END Scroll;
+
+	PROCEDURE (f: Frame) SetCursor* (cursor: INTEGER), NEW;
+	BEGIN
+		f.rider.SetCursor(cursor)
+	END SetCursor;
+
+	PROCEDURE (f: Frame) Input* (OUT x, y: INTEGER; OUT modifiers: SET; OUT isDown: BOOLEAN), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		f.rider.Input(x, y, modifiers, isDown);
+		u := f.unit;
+		x := x * u - f.gx; y := y * u - f.gy
+	END Input;
+
+	PROCEDURE (f: Frame) DrawString* (x, y: INTEGER; col: Color; IN s: ARRAY OF CHAR;
+															font: Fonts.Font), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		u := f.unit;
+		x := (f.gx + x) DIV u; y := (f.gy + y) DIV u;
+		f.rider.DrawString(x, y, col, s, font)
+	END DrawString;
+
+	PROCEDURE (f: Frame) CharIndex* (x, pos: INTEGER; IN s: ARRAY OF CHAR;
+															font: Fonts.Font): INTEGER, NEW;
+		VAR u: INTEGER;
+	BEGIN
+		u := f.unit;
+		x := (f.gx + x) DIV u; pos := (f.gx + pos) DIV u;
+		RETURN f.rider.CharIndex(x, pos, s, font)
+	END CharIndex;
+
+	PROCEDURE (f: Frame) CharPos* (x, index: INTEGER; IN s: ARRAY OF CHAR;
+															font: Fonts.Font): INTEGER, NEW;
+		VAR u: INTEGER;
+	BEGIN
+		u := f.unit;
+		x := (f.gx + x) DIV u;
+		RETURN f.rider.CharPos(x, index, s, font) * u - f.gx
+	END CharPos;
+
+	PROCEDURE (f: Frame) DrawSString* (x, y: INTEGER; col: Color; IN s: ARRAY OF SHORTCHAR;
+																font: Fonts.Font), NEW;
+		VAR u: INTEGER;
+	BEGIN
+		u := f.unit;
+		x := (f.gx + x) DIV u; y := (f.gy + y) DIV u;
+		f.rider.DrawSString(x, y, col, s, font)
+	END DrawSString;
+
+	PROCEDURE (f: Frame) SCharIndex* (x, pos: INTEGER; IN s: ARRAY OF SHORTCHAR;
+																font: Fonts.Font): INTEGER, NEW;
+		VAR u: INTEGER;
+	BEGIN
+		u := f.unit;
+		x := (f.gx + x) DIV u; pos := (f.gx + pos) DIV u;
+		RETURN f.rider.SCharIndex(x, pos, s, font)
+	END SCharIndex;
+
+	PROCEDURE (f: Frame) SCharPos* (x, index: INTEGER; IN s: ARRAY OF SHORTCHAR;
+															font: Fonts.Font): INTEGER, NEW;
+		VAR u: INTEGER;
+	BEGIN
+		u := f.unit;
+		x := (f.gx + x) DIV u;
+		RETURN f.rider.SCharPos(x, index, s, font) * u - f.gx
+	END SCharPos;
+
+	PROCEDURE RGBColor* (red, green, blue: INTEGER): Color;
+	BEGIN
+		ASSERT((red >= 0) & (red < 256), 20);
+		ASSERT((green >= 0) & (green < 256), 21);
+		ASSERT((blue >= 0) & (blue < 256), 22);
+		RETURN (blue * 65536) + (green * 256) + red
+	END RGBColor;
+
+	PROCEDURE IsPrinterPort*(p: Port): BOOLEAN;
+	BEGIN
+		RETURN p.printerMode
+	END IsPrinterPort;
+
+BEGIN
+	background := white; dialogBackground := white
+END Ports.

BlackBox/System/Mod/Printers.txt

@@ -0,0 +1,63 @@
+MODULE Printers;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Printers.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Ports;
+
+	TYPE
+		Printer* = POINTER TO ABSTRACT RECORD
+			l, t, r, b: INTEGER;	(** paper rect relative to port coords **)
+			res*: INTEGER;
+			port: Ports.Port
+		END;
+
+		Directory* = POINTER TO ABSTRACT RECORD END;
+
+	VAR dir-, stdDir-: Directory;
+
+
+	PROCEDURE (p: Printer) OpenJob* (VAR copies: INTEGER; name: ARRAY OF CHAR), NEW, ABSTRACT;
+	PROCEDURE (p: Printer) CloseJob* (), NEW, ABSTRACT;
+	PROCEDURE (p: Printer) OpenPage* (), NEW, ABSTRACT;
+	PROCEDURE (p: Printer) ClosePage* (), NEW, ABSTRACT;
+
+	PROCEDURE (p: Printer) SetOrientation* (landscape: BOOLEAN), NEW, EMPTY;
+
+	PROCEDURE (p: Printer) InitPort* (port: Ports.Port), NEW;
+	BEGIN
+		ASSERT((p.port = NIL) OR (p.port = port), 20);
+		p.port := port
+	END InitPort;
+
+	PROCEDURE (p: Printer) ThisPort* (): Ports.Port, NEW;
+	BEGIN
+		RETURN p.port
+	END ThisPort;
+
+	PROCEDURE (p: Printer) GetRect* (OUT l, t, r, b: INTEGER), NEW;
+	BEGIN
+		l := p.l; t := p.t; r:= p.r; b := p.b
+	END GetRect;
+
+	PROCEDURE (p: Printer) InitPrinter* (l, t, r, b: INTEGER), NEW;
+	BEGIN
+		ASSERT(l <= r, 20); ASSERT(t <= b, 21);
+		p.l := l; p.t := t; p.r := r; p.b := b;
+		p.res := 0
+	END InitPrinter;
+
+
+	PROCEDURE (d: Directory) Default* (): Printer, NEW, ABSTRACT;
+	PROCEDURE (d: Directory) Current* (): Printer, NEW, ABSTRACT;
+	PROCEDURE (d: Directory) Available* (): BOOLEAN, NEW, ABSTRACT;
+
+
+	PROCEDURE SetDir* (d: Directory);
+	BEGIN
+		ASSERT(d # NIL, 20);
+		dir := d;
+		IF stdDir = NIL THEN stdDir := d END
+	END SetDir;
+
+END Printers.

BlackBox/System/Mod/Printing.txt

@@ -0,0 +1,226 @@
+MODULE Printing;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Printing.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Kernel, Fonts, Ports, Dates, Printers, Views, Dialog, Strings;
+	
+	CONST maxNrOfSegments = 16;
+
+	TYPE
+		PageInfo* = RECORD
+			first*, from*, to*: INTEGER; (** current IN **)
+				(** first, from, to: OUT, preset to (0, 0, 9999) **)
+			alternate*: BOOLEAN;
+			title*: Views.Title
+		END;
+
+		Banner* = RECORD
+			font*: Fonts.Font;
+			gap*: INTEGER;	(** OUT, prest to (0,0) **)
+			left*, right*: ARRAY 128 OF CHAR	(** OUT, preset to "", "" **)
+				(** anywhere in header or footer:
+					&p - replaced by current page number as arabic numeral
+					&r - replaced by current page number as roman numeral
+					&R - replaced by current page number as capital roman numeral
+					&a - replaced by current page number as alphanumeric character
+					&A - replaced by current page number as capital alphanumeric character
+					&d - replaced by printing date 
+					&t - replaced by printing time
+					&&- replaced by & character
+					&; - specifies split point
+					&f - filename without path/title
+				**)
+		END;
+
+		Par* = POINTER TO LIMITED RECORD
+			page*: PageInfo;
+			header*, footer*: Banner;
+			copies-: INTEGER
+		END;
+
+		Line = RECORD
+			buf: ARRAY 256 OF CHAR;
+			beg: ARRAY maxNrOfSegments OF BYTE;
+			len: INTEGER
+		END;
+
+		Hook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
+
+	VAR
+		par*: Par;
+
+		month: ARRAY 12 * 3 + 1 OF CHAR;
+		printingHook: Hook;
+
+	PROCEDURE (h: Hook) Print* (v: Views.View; par: Par), NEW, ABSTRACT;
+	PROCEDURE (h: Hook) Current* (): INTEGER, NEW, ABSTRACT;
+
+	PROCEDURE SetHook* (p: Hook);
+	BEGIN
+		printingHook := p
+	END SetHook;
+
+	PROCEDURE NewPar* (IN page: PageInfo; IN header, footer: Banner; copies: INTEGER): Par;
+		VAR par: Par;
+	BEGIN
+		NEW(par);
+		par.page := page;
+		par.header := header;
+		par.footer := footer;
+		par.copies := copies;
+		IF par.header.font = NIL THEN par.header.font := Fonts.dir.Default() END;
+		IF par.footer.font = NIL THEN par.footer.font := Fonts.dir.Default() END;
+		RETURN par
+	END NewPar;
+
+	PROCEDURE NewDefaultPar* (title: Views.Title): Par;
+		VAR par: Par;
+	BEGIN
+		NEW(par);
+		par.page.first := 1;
+		par.page.from := 0;
+		par.page.to := 9999;
+		par.page.alternate := FALSE;
+		par.copies := 1;
+		par.header.gap := 0; par.header.left := ""; par.header.right := ""; par.header.font := Fonts.dir.Default();
+		par.footer.gap := 0; par.footer.left := ""; par.footer.right := ""; par.header.font := Fonts.dir.Default();
+		par.page.title := title;
+		RETURN par
+	END NewDefaultPar;
+
+	PROCEDURE PrintView* (view: Views.View; p: Par);
+	BEGIN
+		ASSERT(view # NIL, 20); ASSERT(p # NIL, 21);
+		ASSERT(par = NIL, 22); (* no recursive printing *)
+		IF Printers.dir.Available() THEN
+			ASSERT(p.page.first >= 0, 23);
+			ASSERT(p.page.from >= 0, 24);
+			ASSERT(p.page.to >= p.page.from, 25);
+			ASSERT(printingHook # NIL, 100);
+			printingHook.Print(view, p)
+		ELSE Dialog.ShowMsg("#System:NoPrinterFound")
+		END
+	END PrintView;
+
+	PROCEDURE GetDateAndTime (IN date: Dates.Date; IN time: Dates.Time; 
+										VAR d, t: ARRAY OF CHAR);
+		VAR i, j, k: INTEGER; s: ARRAY 8 OF CHAR;
+	BEGIN
+		Strings.IntToStringForm (date.day, Strings.decimal, 0, "0", FALSE, d);
+		
+		j := date.month * 3; i := j - 3; k := 0;
+		WHILE i < j DO s[k] := month[i]; INC(k); INC(i) END; s[k] := 0X;
+		d := d + "-" + s;
+		
+		Strings.IntToStringForm (date.year, Strings.decimal, 0, "0", FALSE, s);
+		d := d + "-" + s;
+		
+		Strings.IntToStringForm (time.hour, Strings.decimal, 0, "0", FALSE, t);
+		Strings.IntToStringForm (time.minute, Strings.decimal, 2, "0", FALSE, s);
+		t := t + ":" + s;
+	END GetDateAndTime;
+
+	PROCEDURE Expand (s: ARRAY OF CHAR; IN date: Dates.Date; IN time: Dates.Time;
+										IN title: Views.Title; pno: INTEGER; printing: BOOLEAN; VAR line: Line);
+		VAR i, l: INTEGER; ch: CHAR; j: BYTE;
+			p, d, t, r, rl: ARRAY 32 OF CHAR;
+	BEGIN
+		IF printing THEN 
+			Strings.IntToStringForm (pno, Strings.decimal, 0, "0", FALSE, p);
+			IF (0 < pno) & (pno < 4000) THEN 
+				Strings.IntToStringForm(pno, Strings.roman, 0, " ", FALSE, r)
+			ELSE
+				r := p
+			END;
+		ELSE p := "#"; r := "#"
+		END;
+		
+		GetDateAndTime(date, time, d, t);
+		
+		i := 0; ch := s[i]; line.len := 0; j := 0;
+		WHILE ch # 0X DO
+			IF ch = "&" THEN
+				INC(i); ch := s[i];
+				IF ch = "p" THEN
+					l := 0; WHILE p[l] # 0X DO line.buf[j] := p[l]; INC(j); INC(l) END
+				ELSIF ch = "r" THEN
+					Strings.ToLower(r, rl);
+					l := 0; WHILE rl[l] # 0X DO line.buf[j] := rl[l]; INC(j); INC(l) END
+				ELSIF ch = "R" THEN
+					l := 0; WHILE r[l] # 0X DO line.buf[j] := r[l]; INC(j); INC(l) END
+				ELSIF (ch = "a") OR (ch = "A") THEN
+					IF printing & (0 < pno) & (pno <= 26) THEN line.buf[j] := CHR(pno + ORD(ch) - 1); INC(j)
+					ELSE l := 0; WHILE p[l] # 0X DO line.buf[j] := p[l]; INC(j); INC(l) END
+					END
+				ELSIF ch = "d" THEN
+					l := 0; WHILE d[l] # 0X DO line.buf[j] := d[l]; INC(j); INC(l) END
+				ELSIF ch = "t" THEN
+					l := 0; WHILE t[l] # 0X DO line.buf[j] := t[l]; INC(j); INC(l) END
+				ELSIF ch = "f" THEN
+					l := 0; WHILE title[l] # 0X DO line.buf[j] := title[l]; INC(j); INC(l) END
+				ELSIF ch = ";" THEN
+					IF (line.len < maxNrOfSegments-1) THEN line.beg[line.len] := j; INC(line.len) 
+					ELSE line.buf[j] := " "; INC(j)
+					END
+				ELSIF ch = "&" THEN
+					line.buf[j] := "&"; INC(j)
+				END;
+				IF ch # 0X THEN INC(i); ch := s[i] END
+			ELSE line.buf[j] := ch; INC(j); INC(i); ch := s[i]
+			END
+		END;
+		line.buf[j] := 0X; line.beg[line.len] := j; INC(line.len)
+	END Expand;
+
+	PROCEDURE PrintLine (f: Views.Frame; font: Fonts.Font;
+												x0, x1, y: INTEGER; VAR line: Line);
+		VAR sp, dx, x: INTEGER; i, j, k: INTEGER; buf: ARRAY 128 OF CHAR;
+	BEGIN
+		sp := (x1 - x0 - font.StringWidth(line.buf));
+		IF line.len = 1 THEN (* center *)
+			f.DrawString(x0 + sp DIV 2, y, Ports.defaultColor, line.buf, font)
+		ELSE
+			IF sp > 0 THEN dx := sp DIV (line.len - 1) ELSE dx := 0 END;
+			k := 0; j := 0; x := x0;
+			WHILE k < line.len DO
+				i := 0;
+				WHILE j < line.beg[k] DO
+					buf[i] := line.buf[j]; INC(i); INC(j)
+				END;
+				buf[i] := 0X;
+				f.DrawString(x, y, Ports.defaultColor, buf, font);
+				x := x + font.StringWidth(buf) + dx;
+				INC(k)
+			END
+		END
+	END PrintLine;
+
+	PROCEDURE PrintBanner* (f: Views.Frame; IN p: PageInfo; IN b: Banner; 
+			IN date: Dates.Date; IN time: Dates.Time; x0, x1, y: INTEGER);
+		VAR line: Line; printing: BOOLEAN;
+	BEGIN
+		printing := par # NIL;
+		IF printing THEN
+			ASSERT(printingHook # NIL, 100);
+			IF p.alternate & ~ODD(p.first + printingHook.Current()) THEN
+				Expand(b.left, date, time, p.title, p.first + printingHook.Current(), printing, line)
+			ELSE
+				Expand(b.right, date, time, p.title, p.first + printingHook.Current(), printing, line)
+			END
+		ELSE
+			Expand(b.right, date, time, p.title, 0, printing, line)
+		END;
+		PrintLine(f, b.font, x0, x1, y, line)
+	END PrintBanner;
+
+	PROCEDURE Current*(): INTEGER;
+	BEGIN
+		ASSERT(par # NIL, 21);
+		ASSERT(printingHook # NIL, 100);
+		RETURN printingHook.Current()
+	END Current;
+
+BEGIN
+	month := "JanFebMarAprMayJunJulAugSepOctNovDec"
+END Printing.

BlackBox/System/Mod/Properties.txt

@@ -0,0 +1,425 @@
+MODULE Properties;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Properties.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM, Kernel, Math, Services, Fonts, Stores, Views, Controllers, Dialog;
+
+	CONST
+		(** StdProp.known/valid **)
+		color* = 0; typeface* = 1; size* = 2; style* = 3; weight* = 4;
+
+		(** SizeProp.known/valid **)
+		width* = 0; height* = 1;
+
+		(** PollVerbsMsg limitation **)
+		maxVerbs* = 16;
+
+		(** PollPickMsg.mark, PollPick mark **)
+		noMark* = FALSE; mark* = TRUE;
+		(** PollPickMsg.show, PollPick show **)
+		hide* = FALSE; show* = TRUE;
+
+
+	TYPE
+		Property* = POINTER TO ABSTRACT RECORD
+			next-: Property;	(** property lists are sorted **)	(* by TD address *)
+			known*, readOnly*: SET;	(** used for polling, ignored when setting properties **)
+			valid*: SET
+		END;
+
+		StdProp* = POINTER TO RECORD (Property)
+			color*: Dialog.Color;
+			typeface*: Fonts.Typeface;
+			size*: INTEGER;
+			style*: RECORD val*, mask*: SET END;
+			weight*: INTEGER
+		END;
+
+		SizeProp* = POINTER TO RECORD (Property)
+			width*, height*: INTEGER
+		END;
+
+
+		(** property messages **)
+
+		Message* = Views.PropMessage;
+
+		PollMsg* = RECORD (Message)
+			prop*: Property	(** preset to NIL **)
+		END;
+
+		SetMsg* = RECORD (Message)
+			old*, prop*: Property
+		END;
+
+
+		(** preferences **)
+
+		Preference* = ABSTRACT RECORD (Message) END;
+
+		ResizePref* = RECORD (Preference)
+			fixed*: BOOLEAN;	(** OUT, preset to FALSE **)
+			horFitToPage*: BOOLEAN;	(** OUT, preset to FALSE **)
+			verFitToPage*: BOOLEAN;	(** OUT, preset to FALSE **)
+			horFitToWin*: BOOLEAN;	(** OUT, preset to FALSE **)
+			verFitToWin*: BOOLEAN;	(** OUT, preset to FALSE **)
+		END;
+
+		SizePref* = RECORD (Preference)
+			w*, h*: INTEGER;	(** OUT, preset to caller's preference **)
+			fixedW*, fixedH*: BOOLEAN	(** IN **)
+		END;
+
+		BoundsPref* = RECORD (Preference)
+			w*, h*: INTEGER	(** OUT, preset to (Views.undefined, Views.undefined) **)
+		END;
+
+		FocusPref* = RECORD (Preference)
+			atLocation*: BOOLEAN;	(** IN **)
+			x*, y*: INTEGER;	(** IN, valid iff atLocation **)
+			hotFocus*, setFocus*: BOOLEAN	(** OUT, preset to (FALSE, FALSE) **)
+		END;
+
+		ControlPref* = RECORD (Preference)
+			char*: CHAR;	(** IN **)
+			focus*: Views.View;	(** IN **)
+			getFocus*: BOOLEAN;	(** OUT, valid if (v # focus), preset to ((char = [l]tab) & "FocusPref.setFocus") **)
+			accepts*: BOOLEAN	(** OUT, preset to ((v = focus) & (char # [l]tab)) **)
+		END;
+		
+		TypePref* = RECORD (Preference)
+			type*: Stores.TypeName;	(** IN **)
+			view*: Views.View	(** OUT, preset to NIL **)
+		END;
+		
+
+		(** verbs **)
+
+		PollVerbMsg* = RECORD (Message)
+			verb*: INTEGER;	(** IN **)
+			label*: ARRAY 64 OF CHAR;	(** OUT, preset to "" **)
+			disabled*, checked*: BOOLEAN	(** OUT, preset to FALSE, FALSE **)
+		END;
+		
+		DoVerbMsg* = RECORD (Message)
+			verb*: INTEGER;	(** IN **)
+			frame*: Views.Frame	(** IN **)
+		END;
+		
+		
+		(** controller messages **)
+
+		CollectMsg* = RECORD (Controllers.Message)
+			poll*: PollMsg	(** OUT, preset to NIL **)
+		END;
+
+		EmitMsg* = RECORD (Controllers.RequestMessage)
+			set*: SetMsg	(** IN **)
+		END;
+
+
+		PollPickMsg* = RECORD (Controllers.TransferMessage)
+			mark*: BOOLEAN;	(** IN, request to mark pick target **)
+			show*: BOOLEAN;	(** IN, if mark then show/hide target mark **)
+			dest*: Views.Frame	(** OUT, preset to NIL, set if PickMsg is acceptable **)
+		END;
+
+		PickMsg* = RECORD (Controllers.TransferMessage)
+			prop*: Property	(** set to picked properties by destination **)
+		END;
+
+
+	VAR era-: INTEGER;	(* estimator to cache standard properties of focus *)
+
+
+	PROCEDURE ^ IntersectSelections* (a, aMask, b, bMask: SET; OUT c, cMask: SET; OUT equal: BOOLEAN);
+
+
+	(** properties **)
+
+	PROCEDURE (p: Property) IntersectWith* (q: Property; OUT equal: BOOLEAN), NEW, ABSTRACT;
+
+	PROCEDURE (p: StdProp) IntersectWith* (q: Property; OUT equal: BOOLEAN);
+		VAR valid: SET; c, m: SET; eq: BOOLEAN;
+	BEGIN
+		WITH q: StdProp DO
+			valid := p.valid * q.valid; equal := TRUE;
+			IF p.color.val # q.color.val THEN EXCL(valid, color) END;
+			IF p.typeface # q.typeface THEN EXCL(valid, typeface) END;
+			IF p.size # q.size THEN EXCL(valid, size) END;
+			IntersectSelections(p.style.val, p.style.mask, q.style.val, q.style.mask, c, m, eq);
+			IF m = {} THEN EXCL(valid, style)
+			ELSIF (style IN valid) & ~eq THEN p.style.mask := m; equal := FALSE
+			END;
+			IF p.weight # q.weight THEN EXCL(valid, weight) END;
+			IF p.valid # valid THEN p.valid := valid; equal := FALSE END
+		END
+	END IntersectWith;
+
+	PROCEDURE (p: SizeProp) IntersectWith* (q: Property; OUT equal: BOOLEAN);
+		VAR valid: SET;
+	BEGIN
+		WITH q: SizeProp DO
+			valid := p.valid * q.valid; equal := TRUE;
+			IF p.width # q.width THEN EXCL(valid, width) END;
+			IF p.height # q.height THEN EXCL(valid, height) END;
+			IF p.valid # valid THEN p.valid := valid; equal := FALSE END
+		END
+	END IntersectWith;
+
+
+	(** property collection and emission **)
+
+	PROCEDURE IncEra*;
+	BEGIN
+		INC(era)
+	END IncEra;
+
+
+	PROCEDURE CollectProp* (OUT prop: Property);
+		VAR msg: CollectMsg;
+	BEGIN
+		msg.poll.prop := NIL;
+		Controllers.Forward(msg);
+		prop := msg.poll.prop
+	END CollectProp;
+
+	PROCEDURE CollectStdProp* (OUT prop: StdProp);
+	(** post: prop # NIL, prop.style.val = prop.style.val * prop.style.mask **)
+		VAR p: Property;
+	BEGIN
+		CollectProp(p);
+		WHILE (p # NIL) & ~(p IS StdProp) DO p := p.next END;
+		IF p # NIL THEN
+			prop := p(StdProp); prop.next := NIL
+		ELSE
+			NEW(prop); prop.known := {}
+		END;
+		prop.valid := prop.valid * prop.known;
+		prop.style.val := prop.style.val * prop.style.mask
+	END CollectStdProp;
+
+	PROCEDURE EmitProp* (old, prop: Property);
+		VAR msg: EmitMsg;
+	BEGIN
+		IF prop # NIL THEN
+			msg.set.old := old; msg.set.prop := prop;
+			Controllers.Forward(msg)
+		END
+	END EmitProp;
+
+
+	PROCEDURE PollPick* (x, y: INTEGER;
+							source: Views.Frame; sourceX, sourceY: INTEGER;
+							mark, show: BOOLEAN;
+							OUT dest: Views.Frame; OUT destX, destY: INTEGER);
+		VAR msg: PollPickMsg;
+	BEGIN
+		ASSERT(source # NIL, 20);
+		msg.mark := mark; msg.show := show; msg.dest := NIL;
+		Controllers.Transfer(x, y, source, sourceX, sourceY, msg);
+		dest := msg.dest; destX := msg.x; destY := msg.y
+	END PollPick;
+
+	PROCEDURE Pick* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER;
+							OUT prop: Property);
+		VAR msg: PickMsg;
+	BEGIN
+		ASSERT(source # NIL, 20);
+		msg.prop := NIL;
+		Controllers.Transfer(x, y, source, sourceX, sourceY, msg);
+		prop := msg.prop
+	END Pick;
+
+
+	(** property list construction **)
+
+	PROCEDURE Insert* (VAR list: Property; x: Property);
+		VAR p, q: Property; ta: INTEGER;
+	BEGIN
+		ASSERT(x # NIL, 20); ASSERT(x.next = NIL, 21); ASSERT(x # list, 22);
+		ASSERT(x.valid - x.known = {}, 23);
+		IF list # NIL THEN
+			ASSERT(list.valid - list.known = {}, 24);
+			ASSERT(Services.TypeLevel(list) = 1, 25)
+		END;
+		ta := SYSTEM.TYP(x^);
+		ASSERT(Services.TypeLevel(x) = 1, 26);
+		p := list; q := NIL;
+		WHILE (p # NIL) & (SYSTEM.TYP(p^) < ta) DO
+			q := p; p := p.next
+		END;
+		IF (p # NIL) & (SYSTEM.TYP(p^) = ta) THEN x.next := p.next ELSE x.next := p END;
+		IF q # NIL THEN q.next := x ELSE list := x END
+	END Insert;
+
+	PROCEDURE CopyOfList* (p: Property): Property;
+		VAR q, r, s: Property; t: Kernel.Type;
+	BEGIN
+		q := NIL; s := NIL;
+		WHILE p # NIL DO
+			ASSERT(Services.TypeLevel(p) = 1, 20);
+			t := Kernel.TypeOf(p); Kernel.NewObj(r, t); ASSERT(r # NIL, 23);
+			SYSTEM.MOVE(p, r, t.size);
+			r.next := NIL;
+			IF q # NIL THEN q.next := r ELSE s := r END;
+			q := r; p := p.next
+		END;
+		RETURN s
+	END CopyOfList;
+
+	PROCEDURE CopyOf* (p: Property): Property;
+		VAR r: Property; t: Kernel.Type;
+	BEGIN
+		IF p # NIL THEN
+			ASSERT(Services.TypeLevel(p) = 1, 20);
+			t := Kernel.TypeOf(p); Kernel.NewObj(r, t); ASSERT(r # NIL, 23);
+			SYSTEM.MOVE(p, r, t.size);
+			r.next := NIL;
+		END;
+		RETURN r
+	END CopyOf;
+
+	PROCEDURE Merge* (VAR base, override: Property);
+		VAR p, q, r, s: Property; tp, tr: INTEGER;
+	BEGIN
+		ASSERT((base # override) OR (base = NIL), 20);
+		p := base; q := NIL; r := override; override := NIL;
+		IF p # NIL THEN
+			tp := SYSTEM.TYP(p^);
+			ASSERT(Services.TypeLevel(p) = 1, 21)
+		END;
+		IF r # NIL THEN
+			tr := SYSTEM.TYP(r^);
+			ASSERT(Services.TypeLevel(r) = 1, 22)
+		END;
+		WHILE (p # NIL) & (r # NIL) DO
+			ASSERT(p # r, 23);
+			WHILE (p # NIL) & (tp < tr) DO
+				q := p; p := p.next;
+				IF p # NIL THEN tp := SYSTEM.TYP(p^) END
+			END;
+			IF p # NIL THEN
+				IF tp = tr THEN
+					s := p.next; p.next := NIL; p := s;
+					IF p # NIL THEN tp := SYSTEM.TYP(p^) END
+				ELSE 
+				END;
+				s := r.next;
+				IF q # NIL THEN q.next := r ELSE base := r END;
+				q := r; r.next := p; r := s;
+				IF r # NIL THEN tr := SYSTEM.TYP(r^) END
+			END
+		END;
+		IF r # NIL THEN
+			IF q # NIL THEN q.next := r ELSE base := r END
+		END
+	END Merge;
+
+	PROCEDURE Intersect* (VAR list: Property; x: Property; OUT equal: BOOLEAN);
+		VAR l, p, q, r, s: Property; plen, rlen, ta: INTEGER; filtered: BOOLEAN;
+	BEGIN
+		ASSERT((x # list) OR (list = NIL), 20);
+		IF list # NIL THEN ASSERT(Services.TypeLevel(list) = 1, 21) END;
+		IF x # NIL THEN ASSERT(Services.TypeLevel(x) = 1, 22) END;
+		p := list; s := NIL; list := NIL; l := NIL; plen := 0;
+		r := x; rlen := 0; filtered := FALSE;
+		WHILE (p # NIL) & (r # NIL) DO
+			q := p.next; p.next := NIL; INC(plen);
+			ta := SYSTEM.TYP(p^);
+			WHILE (r # NIL) & (SYSTEM.TYP(r^) < ta) DO
+				r := r.next; INC(rlen)
+			END;
+			IF (r # NIL) & (SYSTEM.TYP(r^) = ta) THEN
+				ASSERT(r # p, 23);
+				IF l # NIL THEN s.next := p ELSE l := p END;
+				s := p;
+				p.known := p.known + r.known;
+				p.IntersectWith(r, equal);
+				filtered := filtered OR ~equal OR (p.valid # r.valid);
+				r := r.next; INC(rlen)
+			END;
+			p := q
+		END;
+		list := l;
+		equal := (p = NIL) & (r = NIL) & (plen = rlen) & ~filtered
+	END Intersect;
+
+
+	(** support for IntersectWith methods **)
+
+	PROCEDURE IntersectSelections* (a, aMask, b, bMask: SET; OUT c, cMask: SET; OUT equal: BOOLEAN);
+	BEGIN
+		cMask := aMask * bMask - (a / b);
+		c := a * cMask;
+		equal := (aMask = bMask) & (bMask = cMask)
+	END IntersectSelections;
+
+
+	(** standard preferences protocols **)
+
+	PROCEDURE PreferredSize* (v: Views.View; minW, maxW, minH, maxH,  defW, defH: INTEGER;
+												VAR w, h: INTEGER);
+		VAR p: SizePref;
+	BEGIN
+		ASSERT(Views.undefined < minW, 20); ASSERT(minW < maxW, 21);
+		ASSERT(Views.undefined < minH, 23); ASSERT(minH < maxH, 24);
+		ASSERT(Views.undefined <= defW, 26);
+		ASSERT(Views.undefined <= defH, 28);
+		IF (w < Views.undefined) OR (w > maxW) THEN w := defW END;
+		IF (h < Views.undefined) OR (h > maxH) THEN h := defH END;
+		p.w := w; p.h := h; p.fixedW := FALSE; p.fixedH := FALSE;
+		Views.HandlePropMsg(v, p); w := p.w; h := p.h;
+		IF w = Views.undefined THEN w := defW END;
+		IF h = Views.undefined THEN h := defH END;
+		IF w < minW THEN w := minW ELSIF w > maxW THEN w := maxW END;
+		IF h < minH THEN h := minH ELSIF h > maxH THEN h := maxH END
+	END PreferredSize;
+
+
+	(** common resizing constraints **)
+
+	PROCEDURE ProportionalConstraint* (scaleW, scaleH: INTEGER; fixedW, fixedH: BOOLEAN; VAR w, h: INTEGER);
+	(** pre: w > Views.undefined, h > Views.undefined **)
+	(** post: (E s: s * scaleW = w, s * scaleH = h), |w * h - w' * h'| min! **)
+		VAR area: REAL;
+	BEGIN
+		ASSERT(scaleW > Views.undefined, 22); ASSERT(scaleH > Views.undefined, 23);
+		IF fixedH THEN
+			ASSERT(~fixedW, 24);
+			ASSERT(h > Views.undefined, 21);
+			area := h; area := area * scaleW;
+			w := SHORT(ENTIER(area / scaleH))
+		ELSIF fixedW THEN
+			ASSERT(w > Views.undefined, 20);
+			area := w; area := area * scaleH;
+			h := SHORT(ENTIER(area / scaleW))
+		ELSE
+			ASSERT(w > Views.undefined, 20); ASSERT(h > Views.undefined, 21);
+			area := w; area := area * h;
+			w := SHORT(ENTIER(Math.(*L*)Sqrt(area * scaleW / scaleH)));
+			h := SHORT(ENTIER(Math.(*L*)Sqrt(area * scaleH / scaleW)))
+		END
+	END ProportionalConstraint;
+
+	PROCEDURE GridConstraint* (gridX, gridY: INTEGER; VAR x, y: INTEGER);
+		VAR dx, dy: INTEGER;
+	BEGIN
+		ASSERT(gridX > Views.undefined, 20);
+		ASSERT(gridY > Views.undefined, 21);
+		dx := x MOD gridX;
+		IF dx < gridX DIV 2 THEN DEC(x, dx) ELSE INC(x, (-x) MOD gridX) END;
+		dy := y MOD gridY;
+		IF dy < gridY DIV 2 THEN DEC(y, dy) ELSE INC(y, (-y) MOD gridY) END
+	END GridConstraint;
+	
+	PROCEDURE ThisType* (view: Views.View; type: Stores.TypeName): Views.View;
+		VAR msg: TypePref;
+	BEGIN
+		msg.type := type; msg.view := NIL;
+		Views.HandlePropMsg(view, msg);
+		RETURN msg.view
+	END ThisType;
+	
+END Properties.

BlackBox/System/Mod/SMath.txt

@@ -0,0 +1,392 @@
+MODULE SMath; 
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/SMatch.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM;
+
+	VAR eps, e: SHORTREAL;
+
+
+	(* code procedures for 80387 math coprocessor *)
+
+	PROCEDURE [code] FLD (x: SHORTREAL);
+	PROCEDURE [code] TOP (): SHORTREAL;
+	PROCEDURE [code] FSW (): INTEGER 0DFH, 0E0H;
+	PROCEDURE [code] FSWs (): SET 0DFH, 0E0H;
+	PROCEDURE [code] ST0 (): SHORTREAL 0D9H, 0C0H;
+	PROCEDURE [code] ST1 (): SHORTREAL 0D9H, 0C1H;
+
+	PROCEDURE [code] FXCH 0D9H, 0C9H;
+	PROCEDURE [code] FLDst0 0D9H, 0C0H;	(* doublicate st[0] *)
+	PROCEDURE [code] FSTPst0 0DDH, 0D8H;	(* remove st[0] *)
+	PROCEDURE [code] FSTPst1 0DDH, 0D9H;	(* remove st[1] *)
+	PROCEDURE [code] FSTPDe 0DBH, 05DH, 0F4H;	(* FSTPD -12[FP] *)	(* COMPILER DEPENDENT *)
+	PROCEDURE [code] WAIT 09BH;
+	PROCEDURE [code] FNOP 0D9H, 0D0H;
+
+	PROCEDURE [code] FLD0 0D9H, 0EEH;
+	PROCEDURE [code] FLD1 0D9H, 0E8H;
+	PROCEDURE [code] FLDPI 0D9H, 0EBH;
+	PROCEDURE [code] FLDLN2 0D9H, 0EDH;
+	PROCEDURE [code] FLDLG2 0D9H, 0ECH;
+	PROCEDURE [code] FLDL2E 0D9H, 0EAH;
+
+	PROCEDURE [code] FADD 0DEH, 0C1H;
+	PROCEDURE [code] FADDst0 0D8H, 0C0H;
+	PROCEDURE [code] FSUB 0DEH, 0E9H;
+	PROCEDURE [code] FSUBn 0DCH, 0E9H;	(* no pop *)
+	PROCEDURE [code] FSUBR 0DEH, 0E1H;
+	PROCEDURE [code] FSUBst1 0D8H, 0E1H;
+	PROCEDURE [code] FMUL 0DEH, 0C9H;
+	PROCEDURE [code] FMULst0 0D8H, 0C8H;
+	PROCEDURE [code] FMULst1st0 0DCH, 0C9H;
+	PROCEDURE [code] FDIV 0DEH, 0F9H;
+	PROCEDURE [code] FDIVR 0DEH, 0F1H;
+	PROCEDURE [code] FDIVRst1 0D8H, 0F9H;
+	PROCEDURE [code] FCHS 0D9H, 0E0H;
+
+	PROCEDURE [code] FCOM 0D8H, 0D1H;
+	PROCEDURE [code] FSWax 0DFH, 0E0H;
+	PROCEDURE [code] SAHF 09EH;
+	PROCEDURE [code] JBE4 076H, 004H;
+	PROCEDURE [code] JAE4 073H, 004H;
+
+	PROCEDURE [code] FRNDINT 0D9H, 0FCH;
+	PROCEDURE [code] FSCALE 0D9H, 0FDH;	(* st[0] * 2^FLOOR(st[1]) *)
+	PROCEDURE [code] FXTRACT 0D9H, 0F4H;	(* exp -> st[1]; mant -> st[0] *)
+	PROCEDURE [code] FXAM 0D9H, 0E5H;
+	
+	PROCEDURE [code] FSQRT 0D9H, 0FAH;	(* st[0] >= 0 *)
+	PROCEDURE [code] FSIN 0D9H, 0FEH;	(* |st[0]| < 2^63 *)
+	PROCEDURE [code] FCOS 0D9H, 0FFH;	(* |st[0]| < 2^63 *)
+	PROCEDURE [code] FTAN 0D9H, 0F2H;	(* |st[0]| < 2^63 *)
+	PROCEDURE [code] FATAN 0D9H, 0F3H;	(* atan2(st[1], st[0]) *)
+	PROCEDURE [code] FYL2X 0D9H, 0F1H;	(* st[1] * log2(st[0]), st[0] > 0 *)
+	PROCEDURE [code] FYL2XP1 0D9H, 0F9H;	(* st[1] * log2(1 + st[0]), |st[0]| < 1-sqrt(2)/2 *)
+	PROCEDURE [code] F2XM1 0D9H, 0F0H;	(* 2^st[0] - 1, |st[0]| <= 1 *)
+
+
+	PROCEDURE IsNan (x: SHORTREAL): BOOLEAN;
+	BEGIN
+		FLD(x); FXAM; FSTPst0; WAIT; RETURN FSWs() * {8, 10} = {8}
+	END IsNan;
+
+
+	(* sin, cos, tan argument reduction *)
+	
+	PROCEDURE Reduce;
+	BEGIN
+		FXAM; WAIT;
+		IF ~(8 IN FSWs()) & (ABS(ST0()) > 1.0E18) THEN
+			(* to be completed *)
+			FSTPst0; FLD0
+		END;
+	END Reduce;
+
+
+	(** SHORTREAL precision **)
+
+	PROCEDURE Pi* (): SHORTREAL;
+	BEGIN
+		FLDPI; RETURN TOP()
+	END Pi;
+	
+	PROCEDURE Eps* (): SHORTREAL;
+	BEGIN
+		RETURN eps
+	END Eps;
+	
+	
+	PROCEDURE Sqrt* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, argument of Sqrt must not be negative *)
+		FLD(x); FSQRT; WAIT; RETURN TOP()
+	END Sqrt;
+	
+
+	PROCEDURE Exp* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 2 ^ (x * 1/ln(2)) *)
+		FLD(x); FLDL2E; FMUL;
+		IF ABS(ST0()) = INF THEN FLD1
+		ELSE FLDst0; FRNDINT; FXCH; FSUBst1; FNOP; F2XM1; FLD1; FADD
+		END;
+		FSCALE; FSTPst1; RETURN TOP()
+	END Exp;
+
+	PROCEDURE Ln* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, argument of Ln must not be negative *)
+		(* ln(2) * ld(x) *)
+		FLDLN2; FLD(x); FYL2X; WAIT; RETURN TOP()
+	END Ln;
+	
+	PROCEDURE Log* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, argument of Log must not be negative *)
+		(* log(2) * ld(x) *)
+		FLDLG2; FLD(x); FYL2X; WAIT; RETURN TOP()
+	END Log;
+
+	PROCEDURE Power* (x, y: SHORTREAL): SHORTREAL;
+	BEGIN
+		ASSERT(x >= 0, 20);
+		ASSERT((x # 0.0)  OR  (y # 0.0), 21);
+		ASSERT((x # INF)  OR  (y # 0.0), 22);
+		ASSERT((x # 1.0)  OR  (ABS(y) # INF), 23);
+		(* 2 ^ (y * ld(x)) *)
+		FLD(y); FLD(x); FYL2X;
+		IF ABS(ST0()) = INF THEN FLD1
+		ELSE FLDst0; FRNDINT; FXCH; FSUBst1; FNOP; F2XM1; FLD1; FADD
+		END;
+		FSCALE; FSTPst1; WAIT; RETURN TOP()
+	END Power;
+	
+	PROCEDURE IntPower* (x: SHORTREAL; n: INTEGER): SHORTREAL;
+	BEGIN 
+		FLD1; FLD(x);
+		IF n = MIN(INTEGER) THEN RETURN IntPower(x, n + 1) / x END;
+		IF n <= 0 THEN FDIVRst1; (* 1 / x *) n := -n END;
+		WHILE n > 0 DO
+			IF ODD(n) THEN FMULst1st0; (* y := y * x *) DEC(n)
+			ELSE FMULst0; (* x := x * x *) n := n DIV 2
+			END
+		END;
+		FSTPst0; RETURN TOP()
+	END IntPower;
+	
+
+	PROCEDURE Sin* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, ABS(x) # INF *)
+		FLD(x); Reduce; FSIN; WAIT; RETURN TOP()
+	END Sin;
+
+	PROCEDURE Cos* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, ABS(x) # INF *)
+		FLD(x); Reduce; FCOS; WAIT; RETURN TOP()
+	END Cos;
+
+	PROCEDURE Tan* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, ABS(x) # INF *)
+		FLD(x); Reduce; FTAN; FSTPst0; WAIT; RETURN TOP()
+	END Tan;
+	
+	PROCEDURE ArcSin* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, -1.0 <= x <= 1.0 *)
+		(* atan2(x, sqrt(1 - x*x)) *)
+		FLD(x); FLDst0; FMULst0; FLD1; FSUBR; FSQRT; FNOP; FATAN; WAIT; RETURN TOP()
+	END ArcSin;
+	
+	PROCEDURE ArcCos* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, -1.0 <= x <= 1.0 *)
+		(* atan2(sqrt(1 - x*x), x) *)
+		FLD(x); FMULst0; FLD1; FSUBR; FSQRT; FLD(x); FATAN; WAIT; RETURN TOP()
+	END ArcCos;
+
+	PROCEDURE ArcTan* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* atan2(x, 1) *)
+		FLD(x); FLD1; FATAN; RETURN TOP()
+	END ArcTan;
+	
+	PROCEDURE ArcTan2* (y, x: SHORTREAL): SHORTREAL;
+	BEGIN
+		ASSERT((y # 0)  OR (x # 0), 20);
+		ASSERT((ABS(y) # INF)  OR  (ABS(x)  # INF), 21);
+		FLD(y); FLD(x); FATAN; WAIT; RETURN TOP()
+	END ArcTan2;
+
+
+	PROCEDURE Sinh* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* IF IsNan(x) THEN RETURN x END; *)
+		(* abs(x) * 1/ln(2) *)
+		FLD(ABS(x)); FLDL2E; FMUL;
+		IF ST0() < 0.5 THEN
+			(* (2^z - 1) + (2^z - 1) / ((2^z - 1) + 1) *)
+			F2XM1; FLDst0; FLDst0; FLD1; FADD; FDIV; FADD
+		ELSIF ST0() # INF THEN
+			(* 2^z - 1 / 2^z *)
+			FLDst0; FRNDINT; FXCH; FSUBst1; FNOP; F2XM1; FLD1; FADD; FSCALE;
+			FSTPst1; FLDst0; FLD1; FDIVR; FSUB
+		END;
+		IF x < 0 THEN FCHS END;
+		RETURN TOP() * 0.5
+	END Sinh;
+	
+	PROCEDURE Cosh* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* IF IsNan(x) THEN RETURN x END; *)
+		(* 2^(abs(x) * 1/ln(2)) *)
+		FLD(ABS(x));
+		IF ST0() # INF THEN 
+			FLDL2E; FMUL; FLDst0; FRNDINT; FXCH; FSUBst1; FNOP; F2XM1; FLD1; FADD; FSCALE;
+			FSTPst1;
+			(* z + 1/z *)
+			FLDst0; FLD1; FDIVR; FADD
+		END;
+		RETURN TOP() * 0.5
+	END Cosh;
+	
+	PROCEDURE Tanh* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* IF IsNan(x) THEN RETURN x END; *)
+		(* abs(x) * 1/ln(2) * 2 *)
+		FLD(ABS(x)); FLDL2E; FMUL; FADDst0;
+		IF ST0() < 0.5 THEN
+			(* (2^z - 1) / (2^z + 1) *)
+			F2XM1; FLDst0; FLD(2); FADD; FDIV
+		ELSIF ST0() < 65 THEN
+			(* 1 - 2 / (2^z + 1) *)
+			FLDst0; FRNDINT; FXCH; FSUBst1; FNOP; F2XM1; FLD1; FADD; FSCALE; FSTPst1; FLD1; FADD; FLD(2); FDIVR; FLD1; FSUBR
+		ELSE
+			FSTPst0; FLD1
+		END;
+		IF x < 0 THEN FCHS END;
+		RETURN TOP()
+	END Tanh;
+	
+	PROCEDURE ArcSinh* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* IF IsNan(x) THEN RETURN x END; *)
+		(* x*x *)
+		FLDLN2; FLD(ABS(x)); FLDst0; FMULst0;
+		IF ST0() < 0.067 THEN
+			(* ln(2) * ld(1 + x*x / (sqrt(x*x + 1) + 1) + x) *)
+			FLDst0; FLD1; FADD; FSQRT; FLD1; FADD; FDIV; FADD; FYL2XP1
+		ELSE
+			(* ln(2) * ld(x + sqrt(x*x + 1)) *)
+			FLD1; FADD; FSQRT; FADD; FYL2X
+		END;
+		IF x < 0 THEN FCHS END;
+		RETURN TOP()
+	END ArcSinh;
+	
+	PROCEDURE ArcCosh* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, x >= 1.0 *)
+		(* IF IsNan(x) THEN RETURN x END; *)
+		(* ln(2) * ld(x + sqrt(x*x - 1)) *)
+		FLDLN2; FLD(x); FLDst0; FMULst0; FLD1; FSUB; FSQRT; FADD; FYL2X; WAIT; RETURN TOP()
+	END ArcCosh;
+	
+	PROCEDURE ArcTanh* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, -1.0 <= x <= 1.0 *)
+		(* IF IsNan(x) THEN RETURN x END; *)
+		(* |x| *)
+		FLDLN2; FLD(ABS(x)); 
+		IF ST0() < 0.12 THEN
+			(* ln(2) * ld(1 + 2*x / (1 - x)) *)
+			FLDst0; FLD1; FSUBR; FDIV; FADDst0; FYL2XP1
+		ELSE
+			(* ln(2) * ld((1 + x) / (1 - x)) *)
+			FLDst0; FLD1; FADD; FXCH; FLD1; FSUBR; FDIV; FNOP; FYL2X
+		END;
+		IF x < 0 THEN FCHS END;
+		WAIT;
+		RETURN TOP() * 0.5
+	END ArcTanh;
+	
+	
+	PROCEDURE Floor* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		FLD(x); FLDst0; FRNDINT; FCOM; FSWax; FSTPst1; SAHF; JBE4; FLD1; FSUB; RETURN TOP()
+	END Floor;
+	
+	PROCEDURE Ceiling* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		FLD(x); FLDst0; FRNDINT; FCOM; FSWax; FSTPst1; SAHF; JAE4; FLD1; FADD; RETURN TOP()
+	END Ceiling;
+	
+	PROCEDURE Round* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		FLD(x); 
+		IF ABS(ST0()) = INF THEN RETURN TOP() END;
+		FLDst0; FRNDINT; FSUBn; FXCH;
+		IF TOP() = 0.5 THEN FLD1; FADD END;
+		RETURN TOP()
+	END Round;
+
+	PROCEDURE Trunc* (x: SHORTREAL): SHORTREAL;
+	BEGIN 
+		FLD(x); FLDst0; FRNDINT;
+		IF ST1() >= 0 THEN
+			FCOM; FSWax; FSTPst1; SAHF; JBE4; FLD1; FSUB
+		ELSE
+			FCOM; FSWax; FSTPst1; SAHF; JAE4; FLD1; FADD
+		END;
+		RETURN TOP()
+	END Trunc;
+
+	PROCEDURE Frac* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		(* 20, x # INF  &  x # -INF *)
+		FLD(x); FLDst0; FRNDINT;
+		IF ST1() >= 0 THEN
+			FCOM; FSWax; SAHF; JBE4; FLD1; FSUB
+		ELSE
+			FCOM; FSWax; SAHF; JAE4; FLD1; FADD
+		END;
+		FSUB; WAIT; RETURN TOP()
+	END Frac;
+	
+	
+	PROCEDURE Sign* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		FLD(x); FXAM; WAIT;
+		CASE FSW() DIV 256 MOD 8 OF
+		| 0, 2: FSTPst0; RETURN 0.0
+		| 1, 4, 5: FSTPst0; RETURN 1.0
+		| 3, 6, 7: FSTPst0; RETURN -1.0
+		END
+	END Sign;
+
+	PROCEDURE Mantissa* (x: SHORTREAL): SHORTREAL;
+	BEGIN
+		FLD(x); FXAM; WAIT;
+		CASE FSW() DIV 256 MOD 8 OF
+		| 4, 6: FXTRACT; FSTPst1; RETURN TOP()
+		| 0, 2: FSTPst0; RETURN 0.0	(* zero *)
+		| 5: FSTPst0; RETURN 1.0	(* inf *)
+		| 7: FSTPst0; RETURN -1.0	(* -inf *)
+		| 1: FSTPst0; RETURN 1.5	(* nan *)
+		| 3: FSTPst0; RETURN -1.5	(* -nan *)
+		END
+	END Mantissa;
+	
+	PROCEDURE Exponent* (x: SHORTREAL): INTEGER;	(* COMPILER DEPENDENT *)
+		VAR e: INTEGER;	(* e is set by FSTPDe! *)
+	BEGIN
+		FLD(x); FXAM; WAIT;
+		CASE FSW() DIV 256 MOD 8 OF
+		| 4, 6: FXTRACT; FSTPst0; FSTPDe; WAIT; RETURN e
+		| 0, 2: FSTPst0; RETURN 0	(* zero *)
+		| 1, 3, 5, 7: FSTPst0; RETURN MAX(INTEGER)	(* inf or nan*)
+		END
+	END Exponent;
+	
+	PROCEDURE Real* (m: SHORTREAL; e: INTEGER): SHORTREAL;
+		VAR s: SET;
+	BEGIN
+		IF (m = 0) THEN RETURN 0.0 END;
+		ASSERT(~IsNan(m) & (1 <= ABS(m)) & (ABS(m) < 2), 20);
+		IF e = MAX(INTEGER) THEN
+			SYSTEM.GET(SYSTEM.ADR(m) + 4, s);
+			SYSTEM.PUT(SYSTEM.ADR(m) + 4, s + {20..30});
+			RETURN m
+		ELSE
+			FLD(e); FLD(m); FSCALE; FSTPst1; RETURN TOP()
+		END
+	END Real;
+
+BEGIN
+	eps := 1.0E+0; e := 2.0E+0;
+	WHILE e > 1.0E+0 DO eps := eps/2.0E+0; e := 1.0E+0 + eps END; eps := 2.0E+0 * eps;
+END SMath.

BlackBox/System/Mod/Sequencers.txt

@@ -0,0 +1,86 @@
+MODULE Sequencers;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Sequencers.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Stores;
+
+	CONST
+		clean* = 0; 
+		notUndoable* = 1; 
+		invisible* = 2;
+
+	TYPE
+		Message* = ABSTRACT RECORD END;
+		
+		Notifier* = POINTER TO ABSTRACT RECORD
+			next: Notifier
+		END;
+
+		Sequencer* = POINTER TO ABSTRACT RECORD
+			notifiers: Notifier
+		END;
+
+		CloseMsg* = RECORD (Message)
+			sticky*: BOOLEAN	(** OUT, preset to FALSE **)
+		END;
+
+		RemoveMsg* = RECORD (Message) END;
+
+		Directory* = POINTER TO ABSTRACT RECORD END;
+
+	VAR dir*: Directory;
+
+	(** Directory **)
+	PROCEDURE (dir: Directory) New* (): Sequencer, NEW, ABSTRACT;
+
+	PROCEDURE SetDir* (d: Directory);
+	BEGIN
+		ASSERT(d # NIL, 20); dir := d
+	END SetDir;
+
+
+	(** Notifier **)
+
+	PROCEDURE (f: Notifier) Notify* (VAR msg: Message), NEW, EMPTY;
+
+
+	(** Sequencer **)
+
+	PROCEDURE (s: Sequencer) Dirty* (): BOOLEAN, NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) SetDirty* (dirty: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) BeginScript* (IN name: Stores.OpName;
+																VAR script: Stores.Operation), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) Do* (st: Stores.Store; IN name: Stores.OpName;
+														op: Stores.Operation), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) LastOp* (st: Stores.Store): Stores.Operation, NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) Bunch* (st: Stores.Store), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) EndScript* (script: Stores.Operation), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) StopBunching* (), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) BeginModification* (type: INTEGER; st: Stores.Store), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) EndModification* (type: INTEGER; st: Stores.Store), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) CanUndo* (): BOOLEAN, NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) CanRedo* (): BOOLEAN, NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) GetUndoName* (VAR name: Stores.OpName), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) GetRedoName* (VAR name: Stores.OpName), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) Undo* (), NEW, ABSTRACT;
+	PROCEDURE (s: Sequencer) Redo* (), NEW, ABSTRACT;
+
+	PROCEDURE (s: Sequencer) Handle* (VAR msg: ANYREC), NEW, EMPTY;
+
+	PROCEDURE (s: Sequencer) Notify* (VAR msg: Message), NEW;
+		VAR n: Notifier;
+	BEGIN
+		n := s.notifiers;
+		WHILE n # NIL DO
+			n.Notify(msg);
+			n := n.next
+		END
+	END Notify;
+
+	PROCEDURE (s: Sequencer) InstallNotifier* (n: Notifier), NEW;
+	BEGIN
+		n.next := s.notifiers; s.notifiers := n
+	END InstallNotifier;
+
+END Sequencers.

BlackBox/System/Mod/Services.txt

@@ -0,0 +1,256 @@
+MODULE Services;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Services.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM, Kernel;
+
+	CONST
+		now* = 0; immediately* = -1;	(** DoLater notBefore **)
+		resolution* = 1000;
+		scale = resolution DIV Kernel.timeResolution;
+		corr = resolution MOD Kernel.timeResolution;
+
+
+	TYPE
+		Action* = POINTER TO ABSTRACT RECORD
+			notBefore: LONGINT;
+			next: Action	(* next element in linear list *)
+		END;
+
+		ActionHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
+		StdHook = POINTER TO RECORD (ActionHook) END;
+
+
+	VAR
+		actionHook-: ActionHook;
+		actions: Action;			(* list of actions *)
+		candidates: Action;		(* list of action candidates in IterateOverActions,
+												NIL during normal execution of commands *)
+		hasImmediates: BOOLEAN;	(* this is a hint: one or more actions in some ring may be immediate actions *)
+		trapCnt: INTEGER;
+
+
+	PROCEDURE Ticks* (): LONGINT;
+		VAR t: LONGINT;
+	BEGIN
+		t := Kernel.Time();
+		RETURN t * scale + t * corr DIV Kernel.timeResolution
+	END Ticks;
+
+
+	(** Action **)
+
+	PROCEDURE (a: Action) Do- (), NEW, ABSTRACT;
+
+	PROCEDURE In (l, a: Action): BOOLEAN;
+	BEGIN
+		WHILE (l # NIL) & (l # a) DO l := l.next END;
+		RETURN l # NIL
+	END In;
+
+	PROCEDURE Incl (VAR l: Action; a: Action);
+	BEGIN
+		IF l # NIL THEN a.next := l END;
+		l := a
+	END Incl;
+
+	PROCEDURE Excl (VAR l: Action; a: Action);
+		VAR p0, p1: Action;
+	BEGIN
+		IF l = a THEN
+			l := a.next; a.next := NIL
+		ELSIF l # NIL THEN
+			p0 := l; p1 := p0.next;
+			(* (p0 # NIL) & (p0 # a) *)
+			WHILE (p1 # NIL) & (p1 # a) DO p0 := p1; p1 := p0.next END;
+			IF p1 = a THEN p0.next := a.next; a.next := NIL END
+		END
+	END Excl;
+
+	PROCEDURE Exec (a: Action);
+		VAR t: Kernel.Type;
+	BEGIN
+		t := Kernel.TypeOf(a);
+		IF t.mod.refcnt >= 0 THEN	(* execute action if its module is not unloaded *)
+			a.Do	(* warning: here the actions and candidates lists may be modified, or a trap may occur! *)
+		END
+	END Exec;
+
+	PROCEDURE Cleanup;
+		VAR p: Action;
+	BEGIN
+		IF candidates # NIL THEN	(* trap handling *)
+			p := candidates; WHILE p.next # NIL DO p := p.next END;	(* find last element of candidates list *)
+			p.next := actions; actions := candidates; candidates := NIL	(* prepend candidates list to actions list *)
+		END;
+		trapCnt := Kernel.trapCount	(* all traps are handled now *)
+	END Cleanup;
+
+	PROCEDURE DoLater* (a: Action; notBefore: LONGINT);
+	(** Register action a. If a is already registered, its notBefore value is updated instead. **)
+	BEGIN
+		ASSERT(a # NIL, 20);
+		IF ~In(actions, a) & ~In(candidates, a) THEN
+			Incl(actions, a)
+		END;
+		a.notBefore := notBefore;	(* if a was already in a list, this statement updates the notBefore value *)
+		IF notBefore = immediately THEN hasImmediates := TRUE END
+	END DoLater;
+
+	PROCEDURE RemoveAction* (a: Action);
+	(** Unregister action a. If a is not registered, nothing happens **)
+	BEGIN
+		IF a # NIL THEN
+			Excl(actions, a);
+			Excl(candidates, a)
+		END
+	END RemoveAction;
+
+	PROCEDURE IterateOverActions (time: LONGINT);
+		VAR p: Action;
+	BEGIN
+		Cleanup;	(* trap handling, if necessary *)
+		(* candidates = NIL *)
+		candidates := actions; actions := NIL;		(* move action list to candidates list *)
+		WHILE candidates # NIL DO					(* for every candidate: execute it or put it back into actions list *)
+			p := candidates; candidates := p.next;	(* remove head element from candidates list *)
+			IF (0 <= p.notBefore) & (p.notBefore <= time) OR (p.notBefore <= time) & (time < 0) THEN
+				p.next := NIL; Exec(p)					(* warning: p may call DoLater or RemoveAction,
+																		which change the lists! *)
+			ELSE
+				p.next := actions; actions := p		(* move to actions list for later processing *)
+			END
+		END
+	END IterateOverActions;
+
+
+	PROCEDURE (h: ActionHook) Step*, NEW, ABSTRACT;
+
+	PROCEDURE (h: ActionHook) Loop*, NEW, ABSTRACT;
+
+
+	PROCEDURE (h: StdHook) Step;	
+	BEGIN
+		IF (candidates = NIL) OR (trapCnt < Kernel.trapCount) THEN
+			IterateOverActions(Ticks())
+		END
+	END Step;
+
+	PROCEDURE (h: StdHook) Loop;
+	BEGIN
+		IF hasImmediates THEN
+			ASSERT((candidates = NIL) OR (trapCnt < Kernel.trapCount), 100);
+			IterateOverActions(immediately);
+			hasImmediates := FALSE
+		END
+	END Loop;
+
+
+	(* type handling functions *)
+
+	PROCEDURE ThisDesc (IN type: ARRAY OF CHAR; load: BOOLEAN): Kernel.Type;
+		CONST record = 1; pointer = 3;
+		VAR m: Kernel.Module; t: Kernel.Type; i, j: INTEGER; ch: CHAR;
+			typ: Kernel.Name; mod: ARRAY 256 OF CHAR;
+	BEGIN
+		ASSERT(type # "", 20);
+		i := 0; ch := type[0];
+		WHILE (ch # ".") & (ch # 0X) DO mod[i] := ch; INC(i); ch := type[i] END;
+		ASSERT(ch = ".", 21);
+		mod[i] := 0X; INC(i); t := NIL;
+		IF load THEN
+			m := Kernel.ThisMod(mod)
+		ELSE typ := SHORT(mod$); m := Kernel.ThisLoadedMod(typ)
+		END;
+		
+		IF m # NIL THEN
+			j := 0; REPEAT ch := type[i]; typ[j] := SHORT(ch); INC(i); INC(j) UNTIL ch = 0X;
+			t := Kernel.ThisType(m, typ);
+			IF t = NIL THEN typ[j - 1] := "^"; typ[j] := 0X; t := Kernel.ThisType(m, typ) END
+		END;
+		IF t # NIL THEN
+			IF t.id MOD 4 = pointer THEN t := t.base[0] END;
+			IF t.id MOD 4 # record THEN t := NIL END
+		END;
+		RETURN t
+	END ThisDesc;
+
+	PROCEDURE GetTypeName* (IN rec: ANYREC; OUT type: ARRAY OF CHAR);
+		VAR i, j: INTEGER; ch: CHAR; t: Kernel.Type; name: Kernel.Name;
+	BEGIN
+		t := Kernel.TypeOf(rec);
+		Kernel.GetTypeName(t, name); type := t.mod.name$;
+		i := 0; ch := type[0]; WHILE ch # 0X DO INC(i); ch := type[i] END;
+		type[i] := "."; INC(i);
+		j := 0; REPEAT ch := name[j]; type[i] := ch; INC(i); INC(j) UNTIL ch = 0X;
+		IF type[i - 2] = "^" THEN type[i - 2] := 0X END
+	END GetTypeName;
+
+	PROCEDURE SameType* (IN ra, rb: ANYREC): BOOLEAN;
+	BEGIN
+		RETURN Kernel.TypeOf(ra) = Kernel.TypeOf(rb)
+	END SameType;
+
+	PROCEDURE IsExtensionOf* (IN ra, rb: ANYREC): BOOLEAN;
+		VAR ta, tb: Kernel.Type;
+	BEGIN
+		ta := Kernel.TypeOf(ra); tb := Kernel.TypeOf(rb);
+		RETURN ta.base[tb.id DIV 16 MOD 16] = tb
+	END IsExtensionOf;
+
+	PROCEDURE Is* (IN rec: ANYREC; IN type: ARRAY OF CHAR): BOOLEAN;
+		VAR ta, tb: Kernel.Type;
+	BEGIN
+		ta := Kernel.TypeOf(rec); tb := ThisDesc(type, FALSE);
+		IF tb # NIL THEN RETURN ta.base[tb.id DIV 16 MOD 16] = tb
+		ELSE RETURN FALSE
+		END
+	END Is;
+
+	PROCEDURE Extends* (IN type, base: ARRAY OF CHAR): BOOLEAN;
+		VAR ta, tb: Kernel.Type;
+	BEGIN
+		ASSERT((type # "") & (base # ""), 20);
+		ta := ThisDesc(type, TRUE); tb := ThisDesc(base, FALSE);
+		IF (ta # NIL) & (tb # NIL) THEN RETURN ta.base[tb.id DIV 16 MOD 16] = tb
+		ELSE RETURN FALSE
+		END
+	END Extends;
+
+	PROCEDURE Level* (IN type: ARRAY OF CHAR): INTEGER;
+		VAR t: Kernel.Type;
+	BEGIN
+		t := ThisDesc(type, TRUE);
+		RETURN t.id DIV 16 MOD 16
+	END Level;
+
+	PROCEDURE TypeLevel* (IN rec: ANYREC): INTEGER;
+		VAR t: Kernel.Type;
+	BEGIN
+		t := Kernel.TypeOf(rec);
+		IF t = NIL THEN RETURN -1
+		ELSE RETURN t.id DIV 16 MOD 16
+		END
+	END TypeLevel;
+
+	PROCEDURE AdrOf* (IN rec: ANYREC): INTEGER;
+	BEGIN
+		RETURN SYSTEM.ADR(rec)
+	END AdrOf;
+
+	PROCEDURE Collect*;
+	BEGIN
+		Kernel.FastCollect
+	END Collect;
+
+
+	PROCEDURE Init;
+		VAR h: StdHook;
+	BEGIN
+		NEW(h); actionHook := h
+	END Init;
+
+BEGIN	
+	Init
+END Services.

BlackBox/System/Mod/Stores.txt

@@ -0,0 +1,1313 @@
+MODULE Stores;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Stores.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM, Kernel, Dialog, Strings, Files;
+
+	CONST
+		(** Alien.cause, Reader.TurnIntoAlien cause - flagged by internalization procs **)
+		alienVersion* = 1; alienComponent* = 2;
+		(** Alien.cause - internally detected **)
+		inconsistentVersion* = -1; inconsistentType* = -2;
+		moduleFileNotFound* = -3; invalidModuleFile* = -4;
+		inconsModuleVersion* = -5; typeNotFound* = -6;
+
+		dictLineLen = 32;	(* length of type & elem dict lines *)
+
+		newBase = 0F0X;	(* new base type (level = 0), i.e. not yet in dict *)
+		newExt = 0F1X;	(* new extension type (level = 1), i.e. not yet in dict *)
+		oldType = 0F2X;	(* old type, i.e. already in dict *)
+
+		nil = 080X;	(* nil store *)
+		link = 081X;	(* link to another elem in same file *)
+		store = 082X;	(* general store *)
+		elem = 083X;	(* elem store *)
+		newlink = 084X;	(* link to another non-elem store in same file *)
+
+		minVersion = 0; maxStoreVersion = 0;
+
+		elemTName = "Stores.ElemDesc";		(* type of pre-1.3 elems *)
+		modelTName = "Models.ModelDesc";	(* the only known family of pre-1.3 elems *)
+		
+		inited = TRUE; anonymousDomain = FALSE;	(* values to be used when calling NewDomain *)
+		
+		compatible = TRUE;
+
+
+	TYPE
+		TypeName* = ARRAY 64 OF CHAR;
+		TypePath* = ARRAY 16 OF TypeName;
+		OpName* = ARRAY 32 OF CHAR;
+
+		Domain* = POINTER TO LIMITED RECORD 
+			sequencer: ANYPTR;
+			dlink: Domain;
+			initialized, copyDomain: BOOLEAN;
+			level, copyera, nextElemId:  INTEGER;
+			sDict: StoreDict;
+			cleaner: TrapCleaner;
+			s: Store	(* used for CopyOf *)
+		END;
+
+		Operation* = POINTER TO ABSTRACT RECORD END;
+
+		Store* = POINTER TO ABSTRACT RECORD
+			dlink: Domain;
+			era, id: INTEGER;	(* externalization era and id *)
+			isElem: BOOLEAN	(* to preserve file format: is this an elem in the old sense? *)
+		END;
+
+
+		AlienComp* = POINTER TO LIMITED RECORD
+			next-: AlienComp
+		END;
+
+		AlienPiece* = POINTER TO LIMITED RECORD (AlienComp)
+			pos-, len-: INTEGER
+		END;
+
+		AlienPart* = POINTER TO LIMITED RECORD (AlienComp)
+			store-: Store
+		END;
+
+		Alien* = POINTER TO LIMITED RECORD (Store)
+			path-: TypePath;	(** the type this store would have if it were not an alien **)
+			cause-: INTEGER;	(** # 0, the cause that turned this store into an alien **)
+			file-: Files.File;	(** base file holding alien pieces **)
+			comps-: AlienComp	(** the constituent components of this alien store **)
+		END;
+
+		ReaderState = RECORD
+			next: INTEGER;	(* position of next store in current level *)
+			end: INTEGER	(* position just after last read store *)
+		END;
+
+		WriterState = RECORD
+			linkpos: INTEGER	(* address of threading link *)
+		END;
+
+		TypeDict = POINTER TO RECORD
+			next: TypeDict;
+			org: INTEGER;	(* origin id of this dict line *)
+			type: ARRAY dictLineLen OF TypeName;	(* type[org] .. type[org + dictLineLen - 1] *)
+			baseId: ARRAY dictLineLen OF INTEGER
+		END;
+
+		StoreDict = POINTER TO RECORD
+			next: StoreDict;
+			org: INTEGER;	(* origin id of this dict line *)
+			elem: ARRAY dictLineLen OF Store	(* elem[org] .. elem[org + dictLineLen - 1] *)
+		END;
+
+		Reader* = RECORD
+			rider-: Files.Reader;
+			cancelled-: BOOLEAN;	(** current Internalize has been cancelled **)
+			readAlien-: BOOLEAN;	(** at least one alien read since ConnectTo **)
+			cause: INTEGER;
+			nextTypeId, nextElemId, nextStoreId: INTEGER;	(* next id of non-dict type, "elem", store *)
+			tDict, tHead: TypeDict;	(* mapping (id <-> type) - self-organizing list *)
+			eDict, eHead: StoreDict;	(* mapping (id -> elem) - self-organizing list *)
+			sDict, sHead: StoreDict;	(* mapping (id -> store) - self-organizing list *)
+			st: ReaderState;
+			noDomain: BOOLEAN;
+			store: Store
+		END;
+
+		Writer* = RECORD
+			rider-: Files.Writer;
+			writtenStore-: Store;
+			era: INTEGER;	(* current externalization era *)
+			noDomain: BOOLEAN;	(* no domain encountered yet *)
+			modelType: Kernel.Type;
+			domain: Domain;	(* domain of current era *)
+			nextTypeId, nextElemId, nextStoreId: INTEGER;	(* next id of non-dict type or elem *)
+			tDict, tHead: TypeDict;	(* mapping (id -> type) - self-organizing list *)
+			st: WriterState
+		END;
+
+		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) 
+			d: Domain
+		END;
+
+	VAR
+		nextEra: INTEGER;	(* next externalization era *)
+		thisTypeRes: INTEGER;	(* side-effect res code of ThisType *)
+		logReports: BOOLEAN;
+
+
+	(** Cleaner **)
+
+	PROCEDURE (c: TrapCleaner) Cleanup;
+	BEGIN
+		c.d.level := 0;
+		c.d.sDict := NIL;
+		c.d.s := NIL
+	END Cleanup;
+
+	PROCEDURE (d: Domain) SetSequencer* (sequencer: ANYPTR), NEW;
+	BEGIN
+		ASSERT(d.sequencer = NIL);
+		d.sequencer := sequencer
+	END SetSequencer;
+	
+	PROCEDURE (d: Domain) GetSequencer*(): ANYPTR, NEW;
+	BEGIN
+		RETURN d.sequencer
+	END GetSequencer;
+
+
+	PROCEDURE^ Report* (IN msg, p0, p1, p2: ARRAY OF CHAR);
+	
+	PROCEDURE^ (VAR rd: Reader) SetPos* (pos: INTEGER), NEW;
+	PROCEDURE^ (VAR rd: Reader) ReadVersion* (min, max: INTEGER; OUT version: INTEGER), NEW;
+	PROCEDURE^ (VAR rd: Reader) ReadSChar* (OUT x: SHORTCHAR), NEW;
+	PROCEDURE^ (VAR rd: Reader) ReadInt* (OUT x: INTEGER), NEW;
+	PROCEDURE^ (VAR rd: Reader) ReadXString* (OUT x: ARRAY OF CHAR), NEW;
+	PROCEDURE^ (VAR rd: Reader) ReadStore* (OUT x: Store), NEW;
+	
+	PROCEDURE^ (VAR wr: Writer) SetPos* (pos: INTEGER), NEW;
+	PROCEDURE^ (VAR wr: Writer) WriteVersion* (version: INTEGER), NEW;
+	PROCEDURE^ (VAR wr: Writer) WriteSChar* (x: SHORTCHAR), NEW;
+	PROCEDURE^ (VAR wr: Writer) WriteInt* (x: INTEGER), NEW;
+	PROCEDURE^ (VAR wr: Writer) WriteXString* (IN x: ARRAY OF CHAR), NEW;
+	PROCEDURE^ (VAR wr: Writer) WriteStore* (x: Store), NEW;
+	
+	PROCEDURE^ Join* (s0, s1: Store);
+
+
+	(** Operation **)
+
+	PROCEDURE (op: Operation) Do* (), NEW, ABSTRACT;
+
+
+	(** Store **)
+
+	PROCEDURE NewDomain (initialized: BOOLEAN): Domain;
+		VAR d: Domain;
+	BEGIN
+		NEW(d); d.level := 0; d.sDict := NIL; d.cleaner := NIL;
+		d.initialized := initialized; d.copyDomain := FALSE;
+		RETURN d
+	END NewDomain;
+
+	PROCEDURE DomainOf (s: Store): Domain;
+		VAR d, p, q, r: Domain;
+	BEGIN
+		d := s.dlink;
+		IF (d # NIL) & (d.dlink # NIL) THEN
+			p := NIL; q := d; r := q.dlink;
+			WHILE r # NIL DO q.dlink := p; p := q; q := r; r := q.dlink END;
+			d := q;
+			WHILE p # NIL DO q := p; p := q.dlink; q.dlink := d END;
+			s.dlink := d
+		END;
+		RETURN d
+	END DomainOf;
+
+	PROCEDURE (s: Store) Domain*(): Domain, NEW;
+		VAR d: Domain;
+	BEGIN
+		d := DomainOf(s);
+		IF (d # NIL) & ~d.initialized THEN d := NIL END;
+		RETURN d
+	END Domain;
+	
+	PROCEDURE (s: Store) CopyFrom- (source: Store), NEW, EMPTY;
+
+	PROCEDURE (s: Store) Internalize- (VAR rd: Reader), NEW, EXTENSIBLE;
+		VAR thisVersion: INTEGER;
+	BEGIN
+		rd.ReadVersion(minVersion, maxStoreVersion, thisVersion);
+		IF ~rd.cancelled & s.isElem THEN
+			rd.ReadVersion(minVersion, maxStoreVersion, thisVersion)
+			(* works since maxStoreVersion = maxElemVersion = 0 in pre-1.3 *)
+		END	
+	END Internalize;
+
+	PROCEDURE (s: Store) ExternalizeAs- (VAR s1: Store), NEW, EMPTY;
+
+	PROCEDURE (s: Store) Externalize- (VAR wr: Writer), NEW, EXTENSIBLE;
+	BEGIN
+		wr.WriteVersion(maxStoreVersion);
+		IF s.isElem THEN wr.WriteVersion(maxStoreVersion) END
+	END Externalize;
+
+
+	(** Alien **)
+
+	PROCEDURE^ CopyOf* (s: Store): Store;
+
+	PROCEDURE (a: Alien) CopyFrom- (source: Store);
+		VAR s, c, cp: AlienComp; piece: AlienPiece; part: AlienPart;
+	BEGIN
+		WITH source: Alien DO
+			a.path := source.path;
+			a.cause := source.cause;
+			a.file := source.file;
+			a.comps := NIL;
+			s := source.comps; cp := NIL;
+			WHILE s # NIL DO
+				WITH s: AlienPiece DO
+					NEW(piece); c := piece;
+					piece.pos := s.pos; piece.len := s.len
+				| s: AlienPart DO
+					NEW(part); c := part;
+					IF s.store # NIL THEN part.store := CopyOf(s.store); Join(part.store, a) END
+				END;
+				IF cp # NIL THEN cp.next := c ELSE a.comps := c END;
+				cp := c;
+				s := s.next
+			END
+		END
+	END CopyFrom;
+
+	PROCEDURE (a: Alien) Internalize- (VAR rd: Reader);
+	BEGIN
+		HALT(100)
+	END Internalize;
+
+	PROCEDURE (a: Alien) Externalize- (VAR w: Writer);
+	BEGIN
+		HALT(100)
+	END Externalize;
+
+
+	(* types *)
+
+	PROCEDURE GetThisTypeName (t: Kernel.Type; VAR type: TypeName);
+		VAR i, j: INTEGER; ch: CHAR; name: Kernel.Name;
+	BEGIN
+		Kernel.GetTypeName(t, name); type := t.mod.name$;
+		i := 0; ch := type[0]; WHILE ch # 0X DO INC(i); ch := type[i] END;
+		type[i] := "."; INC(i);
+		j := 0; REPEAT ch := name[j]; type[i] := ch; INC(i); INC(j) UNTIL ch = 0X;
+		IF compatible THEN
+			IF type[i-2] = "^" THEN	(* for backward compatibility *)
+				type[i-2] := "D"; type[i-1] := "e"; type[i] := "s"; type[i+1] := "c"; type[i+2] := 0X 
+			END
+		END
+	END GetThisTypeName;
+
+	PROCEDURE ThisType (type: TypeName): Kernel.Type;
+		VAR m: Kernel.Module; t: Kernel.Type; i, j: INTEGER; ch: CHAR;
+			typ: Kernel.Name; mod: ARRAY 256 OF CHAR; res: INTEGER; str: ARRAY 256 OF CHAR;
+	BEGIN
+		ASSERT(type # "", 20);
+		i := 0; ch := type[0];
+		WHILE (ch # ".") & (ch # 0X) DO mod[i] := SHORT(ch); INC(i); ch := type[i] END;
+		ASSERT(ch = ".", 21);
+		mod[i] := 0X; INC(i);
+		m := Kernel.ThisMod(mod);
+		IF m # NIL THEN
+			j := 0; REPEAT ch := type[i]; typ[j] := SHORT(ch); INC(i); INC(j) UNTIL ch = 0X;
+			t := Kernel.ThisType(m, typ);
+			IF (t = NIL) & (j >= 5) THEN	(* try pointer type *)
+				IF (typ[j-5] = "D") & (typ[j-4] = "e") & (typ[j-3] = "s") & (typ[j-2] = "c") THEN
+					typ[j-5] := "^"; typ[j-4] := 0X;
+					t := Kernel.ThisType(m, typ)
+				END
+			END;
+			IF t = NIL THEN thisTypeRes := typeNotFound END
+		ELSE
+			t := NIL;
+			Kernel.GetLoaderResult(res, str, str, str);
+			CASE res OF
+			| Kernel.fileNotFound: thisTypeRes := moduleFileNotFound
+			| Kernel.syntaxError: thisTypeRes := invalidModuleFile
+			| Kernel.objNotFound: thisTypeRes := inconsModuleVersion
+			| Kernel.illegalFPrint: thisTypeRes := inconsModuleVersion
+			| Kernel.cyclicImport: thisTypeRes := invalidModuleFile	(* cyclic import ... *)
+			ELSE thisTypeRes := invalidModuleFile
+			END
+		END;
+		RETURN t
+	END ThisType;
+	
+	PROCEDURE SameType (IN x, y: TypeName): BOOLEAN;
+		VAR i: INTEGER;
+	BEGIN
+		IF x = y THEN RETURN TRUE
+		ELSE
+			i := 0; WHILE x[i] = y[i] DO INC(i) END;
+			RETURN
+				(x[i] = "^") & (x[i+1] = 0X) & (y[i] = "D") & (y[i+1] = "e") & (y[i+2] = "s") & (y[i+3] = "c") & (y[i+4] = 0X)
+				OR (y[i] = "^") & (y[i+1] = 0X) & (x[i] = "D") & (x[i+1] = "e") & (x[i+2] = "s") & (x[i+3] = "c") & (x[i+4] = 0X)
+		END
+	END SameType;
+
+	PROCEDURE SamePath (t: Kernel.Type; VAR path: TypePath): BOOLEAN;
+	(* check whether t coincides with path *)
+		VAR tn: TypeName; i, n: INTEGER;
+	BEGIN
+		i := -1; n := Kernel.LevelOf(t);
+		REPEAT
+			GetThisTypeName(t.base[n], tn);
+			DEC(n); INC(i)
+		UNTIL (n < 0) OR ~SameType(tn, path[i]);
+		RETURN SameType(tn, path[i])
+	END SamePath;
+
+	PROCEDURE NewStore (t: Kernel.Type): Store;
+		VAR p: ANYPTR;
+	BEGIN
+		ASSERT(t # NIL, 20);
+		Kernel.NewObj(p, t); ASSERT(p # NIL, 100);
+		ASSERT(p IS Store, 21);
+		RETURN p(Store)
+	END NewStore;
+
+
+	(* type dictionary *)
+
+	PROCEDURE GetThisType (VAR d: TypeDict; id: INTEGER; VAR type: TypeName);
+	(* pre: (id, t) IN dict *)
+		VAR h, p: TypeDict; org, k: INTEGER;
+	BEGIN
+		k := id MOD dictLineLen; org := id - k;
+		h := NIL; p := d; WHILE p.org # org DO h := p; p := p.next END;
+		IF h # NIL THEN h.next := p.next; p.next := d; d := p END;
+		type := p.type[k];
+		ASSERT(type # "", 100)
+	END GetThisType;
+
+	PROCEDURE ThisId (VAR d: TypeDict; t: TypeName): INTEGER;
+	(* pre: t # "" *)
+	(* post: res = id if (t, id) in dict, res = -1 else *)
+		VAR h, p: TypeDict; k, id: INTEGER;
+	BEGIN
+		h := NIL; p := d; id := -1;
+		WHILE (p # NIL) & (id < 0) DO
+			k := 0; WHILE (k < dictLineLen) & (p.type[k, 0] # 0X) & (p.type[k] # t) DO INC(k) END;
+			IF (k < dictLineLen) & (p.type[k, 0] # 0X) THEN id := p.org + k
+			ELSE h := p; p := p.next
+			END
+		END;
+		IF (id >= 0) & (h # NIL) THEN h.next := p.next; p.next := d; d := p END;
+		RETURN id
+	END ThisId;
+
+	PROCEDURE ThisBaseId (VAR d: TypeDict; id: INTEGER): INTEGER;
+	(* post: res = id if base(t) # NIL, res = -1 if base(t) = NIL; res >= 0 => T(res) = base(t) *)
+		VAR h, p: TypeDict; k, org, baseId: INTEGER;
+	BEGIN
+		k := id MOD dictLineLen; org := id - k;
+		h := NIL; p := d; WHILE p.org # org DO h := p; p := p.next END;
+		IF h # NIL THEN h.next := p.next; p.next := d; d := p END;
+		baseId := p.baseId[k];
+		RETURN baseId
+	END ThisBaseId;
+
+	PROCEDURE AddType (VAR d, h: TypeDict; id: INTEGER; type: TypeName);
+		VAR k: INTEGER;
+	BEGIN
+		k := id MOD dictLineLen;
+		IF (h = NIL) OR ((k = 0) & (h.org # id)) THEN
+			NEW(h); h.org := id - k; h.next := d; d := h
+		END;
+		h.type[k] := type; h.baseId[k] := -1
+	END AddType;
+
+	PROCEDURE AddBaseId (h: TypeDict; id, baseId: INTEGER);
+		VAR k: INTEGER;
+	BEGIN
+		k := id MOD dictLineLen;
+		h.baseId[k] := baseId
+	END AddBaseId;
+
+	PROCEDURE InitTypeDict (VAR d, h: TypeDict; VAR nextID: INTEGER);
+	BEGIN
+		d := NIL; h := NIL; nextID := 0
+	END InitTypeDict;
+
+
+	(* store dictionary - used to maintain referential sharing *)
+
+	PROCEDURE ThisStore (VAR d: StoreDict; id: INTEGER): Store;
+	(* pre: (id, s) IN dict *)
+		VAR h, p: StoreDict; s: Store; k, org: INTEGER;
+	BEGIN
+		k := id MOD dictLineLen; org := id - k;
+		h := NIL; p := d; WHILE p.org # org DO h := p; p := p.next END;
+		IF h # NIL THEN h.next := p.next; p.next := d; d := p END;
+		s := p.elem[k];
+		ASSERT(s # NIL, 100);
+		RETURN s
+	END ThisStore;
+
+	PROCEDURE AddStore (VAR d, h: StoreDict; s: Store);
+		VAR k: INTEGER;
+	BEGIN
+		k := s.id MOD dictLineLen;
+		IF (h = NIL) OR ((k = 0) & (h.org # s.id)) THEN
+			NEW(h); h.org := s.id - k; h.next := d; d := h
+		END;
+		h.elem[k] := s
+	END AddStore;
+
+	PROCEDURE InitStoreDict (VAR d, h: StoreDict; VAR nextID: INTEGER);
+	BEGIN
+		d := NIL; h := NIL; nextID := 0
+	END InitStoreDict;
+
+
+	(* support for type mapping *)
+
+	PROCEDURE ReadPath (VAR rd: Reader; VAR path: TypePath);
+		VAR h: TypeDict; id, extId: INTEGER; i: INTEGER; kind: SHORTCHAR;
+
+		PROCEDURE AddPathComp (VAR rd: Reader);
+		BEGIN
+			IF h # NIL THEN AddBaseId(h, extId, rd.nextTypeId) END;
+			AddType(rd.tDict, rd.tHead, rd.nextTypeId, path[i]);
+			h := rd.tHead; extId := rd.nextTypeId
+		END AddPathComp;
+
+	BEGIN
+		h := NIL; i := 0; rd.ReadSChar(kind);
+		WHILE kind = newExt DO
+			rd.ReadXString(path[i]);
+			AddPathComp(rd); INC(rd.nextTypeId);
+			IF path[i] # elemTName THEN INC(i) END;
+			rd.ReadSChar(kind)
+		END;
+		IF kind = newBase THEN
+			rd.ReadXString(path[i]);
+			AddPathComp(rd); INC(rd.nextTypeId); INC(i)
+		ELSE
+			ASSERT(kind = oldType, 100);
+			rd.ReadInt(id);
+			IF h # NIL THEN AddBaseId(h, extId, id) END;
+			REPEAT
+				GetThisType(rd.tDict, id, path[i]); id := ThisBaseId(rd.tDict, id);
+				IF path[i] # elemTName THEN INC(i) END
+			UNTIL id = -1
+		END;
+		path[i] := ""
+	END ReadPath;
+
+	PROCEDURE WritePath (VAR wr: Writer; VAR path: TypePath);
+		VAR h: TypeDict; id, extId: INTEGER; i, n: INTEGER;
+	BEGIN
+		h := NIL;
+		n := 0; WHILE path[n] # "" DO INC(n) END;
+		i := 0;
+		WHILE i < n DO
+			id := ThisId(wr.tDict, path[i]);
+			IF id >= 0 THEN
+				IF h # NIL THEN AddBaseId(h, extId, id) END;
+				wr.WriteSChar(oldType); wr.WriteInt(id); n := i
+			ELSE
+				IF i + 1 < n THEN wr.WriteSChar(newExt) ELSE wr.WriteSChar(newBase) END;
+				wr.WriteXString(path[i]);
+				IF h # NIL THEN AddBaseId(h, extId, wr.nextTypeId) END;
+				AddType(wr.tDict, wr.tHead, wr.nextTypeId, path[i]);
+				h := wr.tHead; extId := wr.nextTypeId;
+				INC(wr.nextTypeId);
+				IF path[i] = modelTName THEN	
+					id := ThisId(wr.tDict, elemTName); ASSERT(id < 0, 100); ASSERT(i + 2 = n, 101);
+					wr.WriteSChar(newExt); wr.WriteXString(elemTName);
+					IF h # NIL THEN AddBaseId(h, extId, wr.nextTypeId) END;
+					AddType(wr.tDict, wr.tHead, wr.nextTypeId, elemTName);
+					h := wr.tHead; extId := wr.nextTypeId;
+					INC(wr.nextTypeId)
+				END
+			END;
+			INC(i)
+		END
+	END WritePath;
+
+	PROCEDURE WriteType (VAR wr: Writer; t: Kernel.Type);
+		VAR path: TypePath; n, i: INTEGER;
+	BEGIN
+		i := 0; n := Kernel.LevelOf(t);
+		WHILE n >= 0 DO
+			GetThisTypeName(t.base[n], path[i]);
+			DEC(n); INC(i)
+		END;
+		path[i] := "";
+		WritePath(wr, path)
+	END WriteType;
+
+
+	(* support for alien mapping *)
+
+	PROCEDURE InternalizeAlien (VAR rd: Reader; VAR comps: AlienComp; down, pos, len: INTEGER);
+		VAR h, p: AlienComp; piece: AlienPiece; part: AlienPart; file: Files.File;
+			next, end, max: INTEGER;
+	BEGIN
+		file := rd.rider.Base(); max := file.Length();
+		end := pos + len; h := NIL;
+		IF down # 0 THEN next := down ELSE next := end END;
+		WHILE pos < end DO
+			ASSERT(end <= max, 100);
+			IF pos < next THEN
+				NEW(piece); piece.pos := pos; piece.len := next - pos;
+				p := piece; pos := next
+			ELSE
+				ASSERT(pos = next, 101);
+				rd.SetPos(next);
+				NEW(part); rd.ReadStore(part.store);
+				ASSERT(rd.st.end > next, 102);
+				p := part; pos := rd.st.end;
+				IF rd.st.next > 0 THEN
+					ASSERT(rd.st.next > next, 103); next := rd.st.next
+				ELSE next := end
+				END
+			END;
+			IF h = NIL THEN comps := p ELSE h.next := p END;
+			h := p
+		END;
+		ASSERT(pos = end, 104);
+		rd.SetPos(end)
+	END InternalizeAlien;
+
+	PROCEDURE ExternalizePiece (VAR wr: Writer; file: Files.File; p: AlienPiece);
+		VAR r: Files.Reader; w: Files.Writer; b: BYTE; l, len: INTEGER;
+	BEGIN
+		l := file.Length(); len := p.len;
+		ASSERT(0 <= p.pos, 100); ASSERT(p.pos <= l, 101);
+		ASSERT(0 <= len, 102); ASSERT(len <= l - p.pos, 103);
+		r := file.NewReader(NIL); r.SetPos(p.pos);
+		w := wr.rider;
+		WHILE len # 0 DO r.ReadByte(b); w.WriteByte(b); DEC(len) END
+	END ExternalizePiece;
+
+	PROCEDURE ExternalizeAlien (VAR wr: Writer; file: Files.File; comps: AlienComp);
+		VAR p: AlienComp;
+	BEGIN
+		p := comps;
+		WHILE p # NIL DO
+			WITH p: AlienPiece DO
+				ExternalizePiece(wr, file, p)
+			| p: AlienPart DO
+				wr.WriteStore(p.store)
+			END;
+			p := p.next
+		END
+	END ExternalizeAlien;
+
+
+	(** Reader **)
+
+	PROCEDURE (VAR rd: Reader) ConnectTo* (f: Files.File), NEW;
+	(** pre: rd.rider = NIL  OR  f = NIL **)
+	BEGIN
+		IF f = NIL THEN
+			rd.rider := NIL
+		ELSE
+			ASSERT(rd.rider = NIL, 20);
+			rd.rider := f.NewReader(rd.rider); rd.SetPos(0);
+			InitTypeDict(rd.tDict, rd.tHead, rd.nextTypeId);
+			InitStoreDict(rd.eDict, rd.eHead, rd.nextElemId);
+			InitStoreDict(rd.sDict, rd.sHead, rd.nextStoreId);
+			rd.noDomain := TRUE
+		END;
+		rd.readAlien := FALSE
+	END ConnectTo;
+
+	PROCEDURE (VAR rd: Reader) SetPos* (pos: INTEGER), NEW;
+	BEGIN
+		rd.rider.SetPos(pos)
+	END SetPos;
+
+	PROCEDURE (VAR rd: Reader) Pos* (): INTEGER, NEW;
+	BEGIN
+		RETURN rd.rider.Pos()
+	END Pos;
+
+	PROCEDURE (VAR rd: Reader) ReadBool* (OUT x: BOOLEAN), NEW;
+		VAR b: BYTE;
+	BEGIN
+		rd.rider.ReadByte(b); x := b # 0
+	END ReadBool;
+
+	PROCEDURE (VAR rd: Reader) ReadSChar* (OUT x: SHORTCHAR), NEW;
+	BEGIN
+		rd.rider.ReadByte(SYSTEM.VAL(BYTE, x))
+	END ReadSChar;
+
+	PROCEDURE (VAR rd: Reader) ReadXChar* (OUT x: CHAR), NEW;
+		VAR c: SHORTCHAR;
+	BEGIN
+		rd.rider.ReadByte(SYSTEM.VAL(BYTE,c)); x := c
+	END ReadXChar;
+
+	PROCEDURE (VAR rd: Reader) ReadChar* (OUT x: CHAR), NEW;
+		VAR le: ARRAY 2 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 2);
+		x := CHR(le[0] MOD 256 + (le[1] MOD 256) * 256)
+	END ReadChar;
+
+	PROCEDURE (VAR rd: Reader) ReadByte* (OUT x: BYTE), NEW;
+	BEGIN
+		rd.rider.ReadByte(x)
+	END ReadByte;
+
+	PROCEDURE (VAR rd: Reader) ReadSInt* (OUT x: SHORTINT), NEW;
+		VAR le, be: ARRAY 2 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 2);
+		IF Kernel.littleEndian THEN
+			x := SYSTEM.VAL(SHORTINT, le)
+		ELSE
+			be[0] := le[1]; be[1] := le[0];
+			x := SYSTEM.VAL(SHORTINT, be)
+		END
+	END ReadSInt;
+
+	PROCEDURE (VAR rd: Reader) ReadXInt* (OUT x: INTEGER), NEW;
+		VAR le, be: ARRAY 2 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 2);
+		IF Kernel.littleEndian THEN
+			x := SYSTEM.VAL(SHORTINT, le)
+		ELSE
+			be[0] := le[1]; be[1] := le[0];
+			x := SYSTEM.VAL(SHORTINT, be)
+		END
+	END ReadXInt;
+
+	PROCEDURE (VAR rd: Reader) ReadInt* (OUT x: INTEGER), NEW;
+		VAR le, be: ARRAY 4 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 4);
+		IF Kernel.littleEndian THEN
+			x := SYSTEM.VAL(INTEGER, le)
+		ELSE
+			be[0] := le[3]; be[1] := le[2]; be[2] := le[1]; be[3] := le[0];
+			x := SYSTEM.VAL(INTEGER, be)
+		END
+	END ReadInt;
+
+	PROCEDURE (VAR rd: Reader) ReadLong* (OUT x: LONGINT), NEW;
+		VAR le, be: ARRAY 8 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 8);
+		IF Kernel.littleEndian THEN
+			x := SYSTEM.VAL(LONGINT, le)
+		ELSE
+			be[0] := le[7]; be[1] := le[6]; be[2] := le[5]; be[3] := le[4];
+			be[4] := le[3]; be[5] := le[2]; be[6] := le[1]; be[7] := le[0];
+			x := SYSTEM.VAL(LONGINT, be)
+		END
+	END ReadLong;
+
+	PROCEDURE (VAR rd: Reader) ReadSReal* (OUT x: SHORTREAL), NEW;
+		VAR le, be: ARRAY 4 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 4);
+		IF Kernel.littleEndian THEN
+			x := SYSTEM.VAL(SHORTREAL, le)
+		ELSE
+			be[0] := le[3]; be[1] := le[2]; be[2] := le[1]; be[3] := le[0];
+			x := SYSTEM.VAL(SHORTREAL, be)
+		END
+	END ReadSReal;
+
+	PROCEDURE (VAR rd: Reader) ReadXReal* (OUT x: REAL), NEW;
+		VAR le, be: ARRAY 4 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 4);
+		IF Kernel.littleEndian THEN
+			x := SYSTEM.VAL(SHORTREAL, le)
+		ELSE
+			be[0] := le[3]; be[1] := le[2]; be[2] := le[1]; be[3] := le[0];
+			x := SYSTEM.VAL(SHORTREAL, be)
+		END
+	END ReadXReal;
+
+	PROCEDURE (VAR rd: Reader) ReadReal* (OUT x: REAL), NEW;
+		VAR le, be: ARRAY 8 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 8);
+		IF Kernel.littleEndian THEN
+			x := SYSTEM.VAL(REAL, le)
+		ELSE
+			be[0] := le[7]; be[1] := le[6]; be[2] := le[5]; be[3] := le[4];
+			be[4] := le[3]; be[5] := le[2]; be[6] := le[1]; be[7] := le[0];
+			x := SYSTEM.VAL(REAL, be)
+		END
+	END ReadReal;
+
+	PROCEDURE (VAR rd: Reader) ReadSet* (OUT x: SET), NEW;
+		VAR le, be: ARRAY 4 OF BYTE;	(* little endian, big endian *)
+	BEGIN
+		rd.rider.ReadBytes(le, 0, 4);
+		IF Kernel.littleEndian THEN
+			x := SYSTEM.VAL(SET, le)
+		ELSE
+			be[0] := le[3]; be[1] := le[2]; be[2] := le[1]; be[3] := le[0];
+			x := SYSTEM.VAL(SET, be)
+		END
+	END ReadSet;
+
+	PROCEDURE (VAR rd: Reader) ReadSString* (OUT x: ARRAY OF SHORTCHAR), NEW;
+		VAR i: INTEGER; ch: SHORTCHAR;
+	BEGIN
+		i := 0; REPEAT rd.ReadSChar(ch); x[i] := ch; INC(i) UNTIL ch = 0X
+	END ReadSString;
+
+	PROCEDURE (VAR rd: Reader) ReadXString* (OUT x: ARRAY OF CHAR), NEW;
+		VAR i: INTEGER; ch: CHAR;
+	BEGIN
+		i := 0; REPEAT rd.ReadXChar(ch); x[i] := ch; INC(i) UNTIL ch = 0X
+	END ReadXString;
+
+	PROCEDURE (VAR rd: Reader) ReadString* (OUT x: ARRAY OF CHAR), NEW;
+		VAR i: INTEGER; ch: CHAR;
+	BEGIN
+		i := 0; REPEAT rd.ReadChar(ch); x[i] := ch; INC(i) UNTIL ch = 0X
+	END ReadString;
+
+	PROCEDURE AlienReport (cause: INTEGER);
+		VAR s, e: ARRAY 32 OF CHAR;
+	BEGIN
+		CASE cause OF
+		| alienVersion: s := "#System:AlienVersion"
+		| alienComponent: s := "#System:AlienComponent"
+		| inconsistentVersion: s := "#System:InconsistentVersion"
+		ELSE s := "#System:UnknownCause"
+		END;
+		Strings.IntToString(cause, e);
+		Report("#System:AlienCause ^0 ^1 ^2", s, e, "")
+	END AlienReport;
+
+	PROCEDURE AlienTypeReport (cause: INTEGER; t: ARRAY OF CHAR);
+		VAR s: ARRAY 64 OF CHAR; 
+	BEGIN
+		CASE cause OF
+		| inconsistentType: s := "#System:InconsistentType ^0"
+		| moduleFileNotFound: s := "#System:CodeFileNotFound ^0"
+		| invalidModuleFile: s := "#System:InvalidCodeFile ^0"
+		| inconsModuleVersion: s := "#System:InconsistentModuleVersion ^0"
+		| typeNotFound: s := "#System:TypeNotFound ^0"
+		END;
+		Report(s, t, "", "")
+	END AlienTypeReport;
+
+	PROCEDURE (VAR rd: Reader) TurnIntoAlien* (cause: INTEGER), NEW;
+	BEGIN
+		ASSERT(cause > 0, 20);
+		rd.cancelled := TRUE; rd.readAlien := TRUE; rd.cause := cause;
+		AlienReport(cause)
+	END TurnIntoAlien;
+
+	PROCEDURE (VAR rd: Reader) ReadVersion* (min, max: INTEGER; OUT version: INTEGER), NEW;
+		VAR v: BYTE;
+	BEGIN
+		rd.ReadByte(v); version := v;
+		IF (version < min) OR (version > max) THEN
+			rd.TurnIntoAlien(alienVersion)
+		END
+	END ReadVersion;
+
+	PROCEDURE (VAR rd: Reader) ReadStore* (OUT x: Store), NEW;
+		VAR a: Alien; t: Kernel.Type;
+			len, pos, pos1, id, comment, next, down, downPos, nextTypeId, nextElemId, nextStoreId: INTEGER;
+			kind: SHORTCHAR; path: TypePath; type: TypeName;
+			save: ReaderState;
+	BEGIN
+		rd.ReadSChar(kind);
+		IF kind = nil THEN
+			rd.ReadInt(comment); rd.ReadInt(next);
+			rd.st.end := rd.Pos();
+			IF (next > 0) OR ((next = 0) & ODD(comment)) THEN rd.st.next := rd.st.end + next ELSE rd.st.next := 0 END;
+			x := NIL
+		ELSIF kind = link THEN
+			rd.ReadInt(id); rd.ReadInt(comment); rd.ReadInt(next);
+			rd.st.end := rd.Pos();
+			IF (next > 0) OR ((next = 0) & ODD(comment)) THEN rd.st.next := rd.st.end + next ELSE rd.st.next := 0 END;
+			x := ThisStore(rd.eDict, id)
+		ELSIF kind = newlink THEN
+			rd.ReadInt(id); rd.ReadInt(comment); rd.ReadInt(next);
+			rd.st.end := rd.Pos();
+			IF (next > 0) OR ((next = 0) & ODD(comment)) THEN rd.st.next := rd.st.end + next ELSE rd.st.next := 0 END;
+			x := ThisStore(rd.sDict, id)
+		ELSIF (kind = store) OR (kind = elem) THEN
+			IF kind = elem THEN
+				id := rd.nextElemId; INC(rd.nextElemId)
+			ELSE
+				id := rd.nextStoreId; INC(rd.nextStoreId)
+			END;
+			ReadPath(rd, path); type := path[0];
+			nextTypeId := rd.nextTypeId; nextElemId := rd.nextElemId; nextStoreId := rd.nextStoreId;
+			rd.ReadInt(comment);
+			pos1 := rd.Pos();
+			rd.ReadInt(next); rd.ReadInt(down); rd.ReadInt(len);
+			pos := rd.Pos();
+			IF next > 0 THEN rd.st.next := pos1 + next + 4 ELSE rd.st.next := 0 END;
+			IF down > 0 THEN downPos := pos1 + down + 8 ELSE downPos := 0 END;
+			rd.st.end := pos + len;
+			rd.cause := 0;
+			ASSERT(len >= 0, 101);
+			IF next # 0 THEN
+				ASSERT(rd.st.next > pos1, 102);
+				IF down # 0 THEN
+					ASSERT(downPos < rd.st.next, 103)
+				END
+			END;
+			IF down # 0 THEN
+				ASSERT(downPos > pos1, 104);
+				ASSERT(downPos < rd.st.end, 105)
+			END;
+			t := ThisType(type);
+			IF t # NIL THEN
+				x := NewStore(t); x.isElem := kind = elem
+			ELSE
+				rd.cause := thisTypeRes; AlienTypeReport(rd.cause, type);
+				x := NIL
+			END;
+			IF x # NIL THEN
+				IF SamePath(t, path) THEN
+					IF kind = elem THEN
+						x.id := id; AddStore(rd.eDict, rd.eHead, x)
+					ELSE
+						x.id := id; AddStore(rd.sDict, rd.sHead, x)
+					END;
+					save := rd.st; rd.cause := 0; rd.cancelled :=  FALSE;
+					x.Internalize(rd);
+					rd.st := save;
+					IF rd.cause # 0 THEN x := NIL
+					ELSIF (rd.Pos() # rd.st.end) OR rd.rider.eof THEN
+						rd.cause := inconsistentVersion; AlienReport(rd.cause);
+						x := NIL
+					END
+				ELSE
+					rd.cause := inconsistentType; AlienTypeReport(rd.cause, type);
+					x := NIL
+				END
+			END;
+			
+			IF x # NIL THEN
+				IF rd.noDomain THEN
+					rd.store := x;
+					rd.noDomain := FALSE
+				ELSE
+					Join(rd.store, x)
+				END
+			ELSE	(* x is an alien *)
+				rd.SetPos(pos);
+				ASSERT(rd.cause # 0, 107);
+				NEW(a); a.path := path; a.cause := rd.cause; a.file := rd.rider.Base();
+				IF rd.noDomain THEN
+					rd.store := a;
+					rd.noDomain := FALSE
+				ELSE
+					Join(rd.store, a)
+				END;
+				IF kind = elem THEN
+					a.id := id; AddStore(rd.eDict, rd.eHead, a)
+				ELSE
+					a.id := id; AddStore(rd.sDict, rd.sHead, a)
+				END;
+				save := rd.st;
+				rd.nextTypeId := nextTypeId; rd.nextElemId := nextElemId; rd.nextStoreId := nextStoreId;
+				InternalizeAlien(rd, a.comps, downPos, pos, len);
+				rd.st := save;
+				x := a;
+				ASSERT(rd.Pos() = rd.st.end, 108);
+				rd.cause := 0; rd.cancelled :=  FALSE; rd.readAlien := TRUE
+			END
+		ELSE
+			pos := rd.Pos();
+			HALT(20)
+		END
+	END ReadStore;
+
+
+	(** Writer **)
+
+	PROCEDURE (VAR wr: Writer) ConnectTo* (f: Files.File), NEW;
+	(** pre: wr.rider = NIL  OR  f = NIL **)
+	BEGIN
+		IF f = NIL THEN
+			wr.rider := NIL
+		ELSE
+			ASSERT(wr.rider = NIL, 20);
+			wr.rider := f.NewWriter(wr.rider); wr.SetPos(f.Length());
+			wr.era := nextEra; INC(nextEra);
+			wr.noDomain := TRUE;
+			wr.modelType := ThisType(modelTName);
+			InitTypeDict(wr.tDict, wr.tHead, wr.nextTypeId);
+			wr.nextElemId := 0; wr.nextStoreId := 0;
+			wr.st.linkpos := -1
+		END;
+		wr.writtenStore := NIL
+	END ConnectTo;
+
+	PROCEDURE (VAR wr: Writer) SetPos* (pos: INTEGER), NEW;
+	BEGIN
+		wr.rider.SetPos(pos)
+	END SetPos;
+
+	PROCEDURE (VAR wr: Writer) Pos* (): INTEGER, NEW;
+	BEGIN
+		RETURN wr.rider.Pos()
+	END Pos;
+
+	PROCEDURE (VAR wr: Writer) WriteBool* (x: BOOLEAN), NEW;
+	BEGIN
+		IF x THEN wr.rider.WriteByte(1) ELSE wr.rider.WriteByte(0) END
+	END WriteBool;
+
+	PROCEDURE (VAR wr: Writer) WriteSChar* (x: SHORTCHAR), NEW;
+	BEGIN
+		wr.rider.WriteByte(SYSTEM.VAL(BYTE, x))
+	END WriteSChar;
+
+	PROCEDURE (VAR wr: Writer) WriteXChar* (x: CHAR), NEW;
+		VAR c: SHORTCHAR;
+	BEGIN
+		c := SHORT(x); wr.rider.WriteByte(SYSTEM.VAL(BYTE, c))
+	END WriteXChar;
+
+	PROCEDURE (VAR wr: Writer) WriteChar* (x: CHAR), NEW;
+		TYPE a = ARRAY 2 OF BYTE;
+		VAR le, be: a;	(* little endian, big endian *)
+	BEGIN
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, x)
+		ELSE
+			be := SYSTEM.VAL(a, x);
+			le[0] := be[1]; le[1] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 2)
+	END WriteChar;
+
+	PROCEDURE (VAR wr: Writer) WriteByte* (x: BYTE), NEW;
+	BEGIN
+		wr.rider.WriteByte(x)
+	END WriteByte;
+
+	PROCEDURE (VAR wr: Writer) WriteSInt* (x: SHORTINT), NEW;
+		TYPE a = ARRAY 2 OF BYTE;
+		VAR le, be: a;	(* little endian, big endian *)
+	BEGIN
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, x)
+		ELSE
+			be := SYSTEM.VAL(a, x);
+			le[0] := be[1]; le[1] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 2)
+	END WriteSInt;
+
+	PROCEDURE (VAR wr: Writer) WriteXInt* (x: INTEGER), NEW;
+		TYPE a = ARRAY 2 OF BYTE;
+		VAR y: SHORTINT; le, be: a;	(* little endian, big endian *)
+	BEGIN
+		y := SHORT(x);
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, y)
+		ELSE
+			be := SYSTEM.VAL(a, y);
+			le[0] := be[1]; le[1] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 2)
+	END WriteXInt;
+
+	PROCEDURE (VAR wr: Writer) WriteInt* (x: INTEGER), NEW;
+		TYPE a = ARRAY 4 OF BYTE;
+		VAR le, be: a;	(* little endian, big endian *)
+	BEGIN
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, x)
+		ELSE
+			be := SYSTEM.VAL(a, x);
+			le[0] := be[3]; le[1] := be[2]; le[2] := be[1]; le[3] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 4)
+	END WriteInt;
+
+	PROCEDURE (VAR wr: Writer) WriteLong* (x: LONGINT), NEW;
+		TYPE a = ARRAY 8 OF BYTE;
+		VAR le, be: a;	(* little endian, big endian *)
+	BEGIN
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, x)
+		ELSE
+			be := SYSTEM.VAL(a, x);
+			le[0] := be[7]; le[1] := be[6]; le[2] := be[5]; le[3] := be[4];
+			le[4] := be[3]; le[5] := be[2]; le[6] := be[1]; le[7] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 8)
+	END WriteLong;
+
+	PROCEDURE (VAR wr: Writer) WriteSReal* (x: SHORTREAL), NEW;
+		TYPE a = ARRAY 4 OF BYTE;
+		VAR le, be: a;	(* little endian, big endian *)
+	BEGIN
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, x)
+		ELSE
+			be := SYSTEM.VAL(a, x);
+			le[0] := be[3]; le[1] := be[2]; le[2] := be[1]; le[3] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 4)
+	END WriteSReal;
+
+	PROCEDURE (VAR wr: Writer) WriteXReal* (x: REAL), NEW;
+		TYPE a = ARRAY 4 OF BYTE;
+		VAR y: SHORTREAL; le, be: a;	(* little endian, big endian *)
+	BEGIN
+		y := SHORT(x);
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, y)
+		ELSE
+			be := SYSTEM.VAL(a, y);
+			le[0] := be[3]; le[1] := be[2]; le[2] := be[1]; le[3] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 4)
+	END WriteXReal;
+
+	PROCEDURE (VAR wr: Writer) WriteReal* (x: REAL), NEW;
+		TYPE a = ARRAY 8 OF BYTE;
+		VAR le, be: a;	(* little endian, big endian *)
+	BEGIN
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, x)
+		ELSE
+			be := SYSTEM.VAL(a, x);
+			le[0] := be[7]; le[1] := be[6]; le[2] := be[5]; le[3] := be[4];
+			le[4] := be[3]; le[5] := be[2]; le[6] := be[1]; le[7] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 8)
+	END WriteReal;
+
+	PROCEDURE (VAR wr: Writer) WriteSet* (x: SET), NEW;
+		(* SIZE(SET) = 4 *)
+		TYPE a = ARRAY 4 OF BYTE;
+		VAR le, be: a;	(* little endian, big endian *)
+	BEGIN
+		IF Kernel.littleEndian THEN
+			le := SYSTEM.VAL(a, x)
+		ELSE
+			be := SYSTEM.VAL(a, x);
+			le[0] := be[3]; le[1] := be[2]; le[2] := be[1]; le[3] := be[0]
+		END;
+		wr.rider.WriteBytes(le, 0, 4)
+	END WriteSet;
+
+	PROCEDURE (VAR wr: Writer) WriteSString* (IN x: ARRAY OF SHORTCHAR), NEW;
+		VAR i: INTEGER; ch: SHORTCHAR;
+	BEGIN
+		i := 0; ch := x[0]; WHILE ch # 0X DO wr.WriteSChar(ch); INC(i); ch := x[i] END;
+		wr.WriteSChar(0X)
+	END WriteSString;
+
+	PROCEDURE (VAR wr: Writer) WriteXString* (IN x: ARRAY OF CHAR), NEW;
+		VAR i: INTEGER; ch: CHAR;
+	BEGIN
+		i := 0; ch := x[0]; WHILE ch # 0X DO wr.WriteXChar(ch); INC(i); ch := x[i] END;
+		wr.WriteSChar(0X)
+	END WriteXString;
+
+	PROCEDURE (VAR wr: Writer) WriteString* (IN x: ARRAY OF CHAR), NEW;
+		VAR i: INTEGER; ch: CHAR;
+	BEGIN
+		i := 0; ch := x[0]; WHILE ch # 0X DO wr.WriteChar(ch); INC(i); ch := x[i] END;
+		wr.WriteChar(0X)
+	END WriteString;
+
+	PROCEDURE (VAR wr: Writer) WriteVersion* (version: INTEGER), NEW;
+	BEGIN
+		wr.WriteByte(SHORT(SHORT(version)))
+	END WriteVersion;
+
+	PROCEDURE (VAR wr: Writer) WriteStore* (x: Store), NEW;
+		VAR t: Kernel.Type; pos1, pos2, pos: INTEGER;
+			save: WriterState;
+	BEGIN
+		ASSERT(wr.rider # NIL, 20);
+		IF x # NIL THEN
+			IF wr.noDomain THEN
+				wr.domain := x.Domain(); wr.noDomain := FALSE
+			ELSE ASSERT(x.Domain() = wr.domain, 21)
+			END;
+			x.ExternalizeAs(x); IF x = NIL THEN wr.writtenStore := NIL; RETURN END
+		END;
+		IF wr.st.linkpos > 0 THEN	(* link to previous block's <next> or up block's <down> *)
+			pos := wr.Pos();
+			IF pos - wr.st.linkpos = 4 THEN
+				(* hack to resolve ambiguity between next = 0 because of end-of-chain, or because of offset = 0.
+					above guard holds only if for the latter case.
+					ASSUMPTION:
+						this can happen only if linkpos points to a next (not a down)
+						and there is a comment byte just before
+				*)
+				wr.SetPos(wr.st.linkpos - 4); wr.WriteInt(1); wr.WriteInt(pos - wr.st.linkpos - 4)
+			ELSE
+				wr.SetPos(wr.st.linkpos); wr.WriteInt(pos - wr.st.linkpos - 4)
+			END;
+			wr.SetPos(pos)
+		END;
+		IF x = NIL THEN
+			wr.WriteSChar(nil);
+			wr.WriteInt(0);	(* <comment> *)
+			wr.st.linkpos := wr.Pos();
+			wr.WriteInt(0)	(* <next> *)
+		ELSIF x.era >= wr.era THEN
+			ASSERT(x.era = wr.era, 23);
+			IF x.isElem THEN wr.WriteSChar(link) ELSE wr.WriteSChar(newlink) END;
+			wr.WriteInt(x.id);
+			wr.WriteInt(0);	(* <comment> *)
+			wr.st.linkpos := wr.Pos();
+			wr.WriteInt(0)	(* <next> *)
+		ELSE
+			x.era := wr.era;
+			WITH x: Alien DO
+				IF x.isElem THEN
+					wr.WriteSChar(elem); x.id := wr.nextElemId; INC(wr.nextElemId)
+				ELSE
+					wr.WriteSChar(store); x.id := wr.nextStoreId; INC(wr.nextStoreId)
+				END;
+				WritePath(wr, x.path)
+			ELSE
+				t := Kernel.TypeOf(x);
+				x.isElem := t.base[1] = wr.modelType;
+				IF x.isElem THEN
+					wr.WriteSChar(elem); x.id := wr.nextElemId; INC(wr.nextElemId)
+				ELSE
+					wr.WriteSChar(store); x.id := wr.nextStoreId; INC(wr.nextStoreId)
+				END;
+				WriteType(wr, t)
+			END;
+			wr.WriteInt(0);	(* <comment> *)
+			pos1 := wr.Pos(); wr.WriteInt(0); wr.WriteInt(0);	(* <next>, <down> *)
+			pos2 := wr.Pos(); wr.WriteInt(0);	(* <len> *)
+			save := wr.st;	(* push current writer state; switch to structured *)
+			wr.st.linkpos := pos1 + 4;
+			WITH x: Alien DO ExternalizeAlien(wr, x.file, x.comps)
+			ELSE 
+				x.Externalize(wr)
+			END;
+			wr.st := save;	(* pop writer state *)
+			wr.st.linkpos := pos1;
+			pos := wr.Pos();
+			wr.SetPos(pos2); wr.WriteInt(pos - pos2 - 4);	(* patch <len> *)
+			wr.SetPos(pos)
+		END;
+		wr.writtenStore := x
+	END WriteStore;
+
+
+	(** miscellaneous **)
+
+	PROCEDURE Report* (IN msg, p0, p1, p2: ARRAY OF CHAR);
+	BEGIN
+		IF logReports THEN
+			Dialog.ShowParamMsg(msg, p0, p1, p2)
+		END
+	END Report;
+
+	PROCEDURE BeginCloning (d: Domain);
+	BEGIN
+		ASSERT(d # NIL, 20);
+		INC(d.level);
+		IF d.level = 1 THEN
+			d.copyera := nextEra; INC(nextEra); d.nextElemId := 0;
+			IF d.cleaner = NIL THEN NEW(d.cleaner); d.cleaner.d := d END;
+			Kernel.PushTrapCleaner(d.cleaner)
+		END
+	END BeginCloning;
+	
+	PROCEDURE EndCloning (d: Domain);
+	BEGIN
+		ASSERT(d # NIL, 20);
+		DEC(d.level);
+		IF d.level = 0 THEN 
+			d.sDict := NIL;
+			Kernel.PopTrapCleaner(d.cleaner);
+			d.s := NIL
+		END
+	END EndCloning;
+
+	PROCEDURE CopyOf* (s: Store): Store;
+		VAR h: Store; c: StoreDict; d: Domain; k, org: INTEGER;
+	BEGIN
+		ASSERT(s # NIL, 20);
+		
+		d := DomainOf(s);
+		IF d = NIL THEN d := NewDomain(anonymousDomain); s.dlink := d; d.copyDomain := TRUE END;
+
+		BeginCloning(d);
+		IF s.era >= d.copyera THEN	(* s has already been copied *)
+			ASSERT(s.era = d.copyera, 21);
+			k := s.id MOD dictLineLen; org := s.id - k;
+			c := d.sDict;
+			WHILE (c # NIL) & (c.org # org) DO c := c.next END;
+			ASSERT((c # NIL) & (c.elem[k] # NIL), 100);
+			h := c.elem[k]
+		ELSE
+			s.era := d.copyera;
+			s.id := d.nextElemId; INC(d.nextElemId);
+			Kernel.NewObj(h, Kernel.TypeOf(s));
+			k := s.id MOD dictLineLen;
+			IF k = 0 THEN NEW(c); c.org := s.id; c.next := d.sDict; d.sDict := c 
+			ELSE c := d.sDict
+			END;
+			ASSERT((c # NIL) & (c.org = s.id - k) & (c.elem[k] = NIL), 101);
+			c.elem[k] := h;
+			IF d.s = NIL THEN d.s := h ELSE Join(h, d.s) END;
+			h.CopyFrom(s)
+		END;
+		EndCloning(d);
+		RETURN h
+	END CopyOf;
+	
+	PROCEDURE ExternalizeProxy* (s: Store): Store;
+	BEGIN
+		IF s # NIL THEN s.ExternalizeAs(s) END;
+		RETURN s
+	END ExternalizeProxy;
+	
+	PROCEDURE InitDomain* (s: Store);
+		VAR d: Domain;
+	BEGIN
+		ASSERT(s # NIL, 20);
+		d := DomainOf(s);
+		IF d = NIL THEN d := NewDomain(inited); s.dlink := d
+		ELSE d.initialized := TRUE
+		END			
+	END InitDomain;
+	
+	PROCEDURE Join* (s0, s1: Store);
+		VAR d0, d1: Domain;
+	BEGIN
+		ASSERT(s0 # NIL, 20); ASSERT(s1 # NIL, 21);
+		d0 := DomainOf(s0); d1 := DomainOf(s1);
+		IF (d0 = NIL) & (d1 = NIL) THEN
+			s0.dlink := NewDomain(anonymousDomain); s1.dlink := s0.dlink
+		ELSIF d0 = NIL THEN
+			s0.dlink := d1; d1.copyDomain := FALSE
+		ELSIF d1 = NIL THEN
+			s1.dlink := d0; d0.copyDomain := FALSE
+		ELSIF d0 # d1 THEN
+			ASSERT(~d0.initialized OR ~d1.initialized, 22);
+				(* PRE 22	s0.Domain() = NIL OR s1.Domain() = NIL OR s0.Domain() = s1.Domain() *)
+			IF ~d0.initialized & (d0.level = 0) THEN d0.dlink := d1; d1.copyDomain := FALSE
+			ELSIF ~d1.initialized & (d1.level = 0) THEN d1.dlink := d0; d0.copyDomain := FALSE
+			ELSE HALT(100)
+			END
+		END
+	END Join;
+	
+	PROCEDURE Joined* (s0, s1: Store): BOOLEAN;
+		VAR d0, d1: Domain;
+	BEGIN
+		ASSERT(s0 # NIL, 20); ASSERT(s1 # NIL, 21);
+		d0 := DomainOf(s0); d1 := DomainOf(s1);
+		RETURN (s0 = s1) OR ((d0 = d1) & (d0 # NIL))
+	END Joined;
+
+	PROCEDURE Unattached* (s: Store): BOOLEAN;
+	BEGIN
+		ASSERT(s # NIL, 20);
+		RETURN  (s.dlink = NIL) OR s.dlink.copyDomain
+	END Unattached;
+
+BEGIN
+	nextEra := 1; logReports := FALSE
+END Stores.

BlackBox/System/Mod/Views.txt

@@ -0,0 +1,1347 @@
+MODULE Views;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Views.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM,
+		Kernel, Log, Dialog, Files, Services, Fonts, Stores, Converters, Ports, Sequencers, Models;
+
+	CONST
+		(** View.Background color **)
+		transparent* = 0FF000000H;
+
+		(** Views.CopyModel / Views.CopyOf shallow **)
+		deep* = FALSE; shallow* = TRUE;
+
+		(** Update, UpdateIn rebuild **)
+		keepFrames* = FALSE; rebuildFrames* = TRUE;
+
+		(** Deposit, QualifiedDeposit, Fetch w, h **)
+		undefined* = 0;
+		
+		(** OldView, RegisterView ask **)
+		dontAsk* = FALSE; ask* = TRUE;
+
+		(* method numbers (UNSAFE!) *)
+		(* copyFrom = 1; *)
+		copyFromModelView = 7; copyFromSimpleView = 8;
+
+		(* Frame.state *)
+		new = 0; open = 1; closed = 2;
+		
+		maxN = 30;	(* max number of rects used to approximate a region *)
+
+		minVersion = 0; maxVersion = 0;
+		
+		(* actOp *)
+		handler = 1; restore = 2; externalize = 3;
+
+		markBorderSize = 2;
+
+		clean* = Sequencers.clean; 
+		notUndoable* = Sequencers.notUndoable;
+		invisible* = Sequencers.invisible; 
+
+
+	TYPE
+
+		(** views **)
+
+		View* = POINTER TO ABSTRACT RECORD (Stores.Store)
+			context-: Models.Context;	(** stable context # NIL **)
+			era: INTEGER;
+			guard: INTEGER;	(* = TrapCount()+1 if view is addressee of ongoing broadcast *)
+			bad: SET
+		END;
+
+		Alien* = POINTER TO LIMITED RECORD (View)
+			store-: Stores.Alien
+		END;
+
+		Title* = ARRAY 64 OF CHAR;
+
+		TrapAlien = POINTER TO RECORD (Stores.Store) END;
+
+
+		(** frames **)
+
+		Frame* = POINTER TO ABSTRACT RECORD (Ports.Frame)
+			l-, t-, r-, b-: INTEGER;	(** l < r, t < b **)
+			view-: View;	(** opened => view # NIL, view.context # NIL, view.seq # NIL **)
+			front-, mark-: BOOLEAN;
+			state: BYTE;
+			x, y: INTEGER;	(* origin in coordinates of environment *)
+			gx0, gy0: INTEGER;	(* global origin w/o local scrolling compensation *)
+			sx, sy: INTEGER;	(* cumulated local sub-pixel scrolling compensation *)
+			next, down, up, focus: Frame;
+			level: INTEGER	(* used for partial z-ordering *)
+		END;
+		
+
+		Message* = ABSTRACT RECORD
+			view-: View	(** view # NIL **)
+		END;
+
+		NotifyMsg* = EXTENSIBLE RECORD (Message)
+			id0*, id1*: INTEGER;
+			opts*: SET
+		END;
+		
+		NotifyHook = POINTER TO RECORD (Dialog.NotifyHook) END;
+		
+		UpdateCachesMsg* = EXTENSIBLE RECORD (Message) END;
+		
+		ScrollClassMsg* = RECORD (Message)
+			allowBitmapScrolling*: BOOLEAN (** OUT, preset to FALSE **)
+		END;
+
+
+		(** property messages **)
+
+		PropMessage* = ABSTRACT RECORD END;
+
+
+		(** controller messages **)
+
+		CtrlMessage* = ABSTRACT RECORD END;
+
+		CtrlMsgHandler* = PROCEDURE (op: INTEGER; f, g: Frame; VAR msg: CtrlMessage; VAR mark, front, req: BOOLEAN);
+
+		UpdateMsg = RECORD (Message)
+			scroll, rebuild, all: BOOLEAN;
+			l, t, r, b, dx, dy: INTEGER
+		END;
+
+
+		Rect = RECORD
+			v: View;
+			rebuild: BOOLEAN;
+			l, t, r, b: INTEGER
+		END;
+
+		Region = POINTER TO RECORD
+			n: INTEGER;
+			r: ARRAY maxN OF Rect
+		END;
+
+		RootFrame* = POINTER TO RECORD (Frame)
+			flags-: SET;
+			update: Region	(* allocated lazily by SetRoot *)
+		END;
+		
+		StdFrame = POINTER TO RECORD (Frame) END;
+
+
+		(* view producer/consumer decoupling *)
+
+		QueueElem = POINTER TO RECORD
+			next: QueueElem;
+			view: View
+		END;
+		
+		GetSpecHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
+		ViewHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
+		MsgHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
+		
+
+
+	VAR
+		HandleCtrlMsg-: CtrlMsgHandler;
+
+		domainGuard: INTEGER;	(* = TrapCount()+1 if domain is addressee of ongoing domaincast *)
+		
+		actView: View;
+		actFrame: RootFrame;
+		actOp: INTEGER;
+
+		copyModel: Models.Model;	(* context for (View)CopyFrom; reset by TrapCleanup *)
+
+		queue: RECORD
+			len: INTEGER;
+			head, tail: QueueElem
+		END;
+		
+		getSpecHook: GetSpecHook;
+		viewHook: ViewHook;
+		msgHook: MsgHook;
+	
+	
+	PROCEDURE Overwritten (v: View; mno: INTEGER): BOOLEAN;
+		VAR base, actual: PROCEDURE;
+	BEGIN
+		SYSTEM.GET(SYSTEM.TYP(View) - 4 * (mno + 1), base);
+		SYSTEM.GET(SYSTEM.TYP(v) - 4 * (mno + 1), actual);
+		RETURN actual # base
+	END Overwritten;
+
+	(** Hooks **)
+	
+	PROCEDURE (h: GetSpecHook) GetExtSpec* (s: Stores.Store; VAR loc: Files.Locator; 
+											VAR name: Files.Name; VAR conv: Converters.Converter), NEW, ABSTRACT;
+	PROCEDURE (h: GetSpecHook) GetIntSpec* (VAR loc: Files.Locator; VAR name: Files.Name; 
+											VAR conv: Converters.Converter), NEW, ABSTRACT;
+
+	PROCEDURE SetGetSpecHook*(h: GetSpecHook);
+	BEGIN
+		getSpecHook := h
+	END SetGetSpecHook;
+	
+	PROCEDURE (h: ViewHook) OldView* (loc: Files.Locator; name: Files.Name; 
+				VAR conv: Converters.Converter): View, NEW, ABSTRACT;
+	PROCEDURE (h: ViewHook) Open* (s: View; title: ARRAY OF CHAR;
+				loc: Files.Locator; name: Files.Name; conv: Converters.Converter; 
+				asTool, asAux, noResize, allowDuplicates, neverDirty: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (h: ViewHook) RegisterView* (s: View; loc: Files.Locator; 
+				name: Files.Name; conv: Converters.Converter), NEW, ABSTRACT;
+
+	PROCEDURE SetViewHook*(h: ViewHook);
+	BEGIN
+		viewHook := h
+	END SetViewHook;
+	
+	PROCEDURE (h: MsgHook) Omnicast* (VAR msg: ANYREC), NEW, ABSTRACT;
+	PROCEDURE (h: MsgHook) RestoreDomain* (domain: Stores.Domain), NEW, ABSTRACT;
+
+	PROCEDURE SetMsgHook*(h: MsgHook);
+	BEGIN
+		msgHook := h
+	END SetMsgHook;
+
+	
+	(** Model protocol **)
+
+	PROCEDURE (v: View) CopyFromSimpleView- (source: View), NEW, EMPTY;
+	PROCEDURE (v: View) CopyFromModelView- (source: View; model: Models.Model), NEW, EMPTY;
+
+	PROCEDURE (v: View) ThisModel* (): Models.Model, NEW, EXTENSIBLE;
+	BEGIN
+		RETURN NIL
+	END ThisModel;
+
+
+	(** Store protocol **)
+
+	PROCEDURE (v: View) CopyFrom- (source: Stores.Store);
+		VAR tm, fm: Models.Model; c: Models.Context;
+	BEGIN
+		tm := copyModel; copyModel := NIL;
+		WITH source: View DO
+			v.era := source.era;
+			actView := NIL;
+			IF tm = NIL THEN	(* if copyModel wasn't preset then use deep copy as default *)
+				fm := source.ThisModel();
+				IF fm # NIL THEN tm := Stores.CopyOf(fm)(Models.Model) END
+			END;
+			actView := v;
+			IF Overwritten(v, copyFromModelView) THEN	(* new View *)
+				ASSERT(~Overwritten(v, copyFromSimpleView), 20);
+				c := v.context;
+				v.CopyFromModelView(source, tm);
+				ASSERT(v.context = c, 60)
+			ELSE	(* old or simple View *)
+				(* IF tm # NIL THEN v.InitModel(tm) END *)
+				c := v.context;
+				v.CopyFromSimpleView(source);
+				ASSERT(v.context = c, 60)
+			END
+		END
+	END CopyFrom;
+
+	PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
+		VAR thisVersion: INTEGER;
+	BEGIN
+		v.Internalize^(rd);
+		IF rd.cancelled THEN RETURN END;
+		rd.ReadVersion(minVersion, maxVersion, thisVersion)
+	END Internalize;
+
+	PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
+	BEGIN
+		v.Externalize^(wr);
+		wr.WriteVersion(maxVersion)
+	END Externalize;
+
+
+	(** embedding protocol **)
+
+	PROCEDURE (v: View) InitContext* (context: Models.Context), NEW, EXTENSIBLE;
+	BEGIN
+		ASSERT(context # NIL, 21);
+		ASSERT((v.context = NIL) OR (v.context = context), 22);
+		v.context := context
+	END InitContext;
+
+	PROCEDURE (v: View) GetBackground* (VAR color: Ports.Color), NEW, EMPTY;
+	PROCEDURE (v: View) ConsiderFocusRequestBy- (view: View), NEW, EMPTY;
+	PROCEDURE (v: View) Neutralize*, NEW, EMPTY;
+
+
+	(** Frame protocol **)
+
+	PROCEDURE (v: View) GetNewFrame* (VAR frame: Frame), NEW, EMPTY;
+	PROCEDURE (v: View) Restore* (f: Frame; l, t, r, b: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (v: View) RestoreMarks* (f: Frame; l, t, r, b: INTEGER), NEW, EMPTY;
+
+
+	(** handlers **)
+
+	PROCEDURE (v: View) HandleModelMsg- (VAR msg: Models.Message), NEW, EMPTY;
+	PROCEDURE (v: View) HandleViewMsg- (f: Frame; VAR msg: Message), NEW, EMPTY;
+	PROCEDURE (v: View) HandleCtrlMsg* (f: Frame; VAR msg: CtrlMessage; VAR focus: View), NEW, EMPTY;
+	PROCEDURE (v: View) HandlePropMsg- (VAR msg: PropMessage), NEW, EMPTY;
+
+
+	(** Alien **)
+
+	PROCEDURE (a: Alien) Externalize- (VAR wr: Stores.Writer);
+	BEGIN
+		HALT(100)
+	END Externalize;
+
+	PROCEDURE (a: Alien) Internalize- (VAR rd: Stores.Reader);
+	BEGIN
+		HALT(100)
+	END Internalize;
+
+	PROCEDURE (a: Alien) CopyFromSimpleView- (source: View);
+	BEGIN
+		a.store := Stores.CopyOf(source(Alien).store)(Stores.Alien); Stores.Join(a, a.store)
+	END CopyFromSimpleView;
+
+	PROCEDURE (a: Alien) Restore* (f: Frame; l, t, r, b: INTEGER);
+		VAR u, w, h: INTEGER;
+	BEGIN
+		u := f.dot; a.context.GetSize(w, h);
+		f.DrawRect(0, 0, w, h, Ports.fill, Ports.grey25);
+		f.DrawRect(0, 0, w, h, 2 * u, Ports.grey75);
+		f.DrawLine(0, 0, w - u, h - u, u, Ports.grey75);
+		f.DrawLine(w - u, 0, 0, h - u, u, Ports.grey75)
+	END Restore;
+	
+
+	(** TrapAlien **)
+
+	PROCEDURE (v: TrapAlien) Internalize (VAR rd: Stores.Reader);
+	BEGIN
+		v.Internalize^(rd);
+		rd.TurnIntoAlien(3)
+	END Internalize;
+	
+	PROCEDURE (v: TrapAlien) Externalize (VAR rd: Stores.Writer);
+	END Externalize;
+	
+	PROCEDURE (v: TrapAlien) CopyFrom (source: Stores.Store), EMPTY;
+
+
+	(** Frame **)
+
+	PROCEDURE (f: Frame) Close* (), NEW, EMPTY;
+
+
+	(* Rect, Region *)
+
+	PROCEDURE Union (VAR u: Rect; r: Rect);
+	BEGIN
+		IF r.v # u.v THEN u.v := NIL END;
+		IF r.rebuild THEN u.rebuild := TRUE END;
+		IF r.l < u.l THEN u.l := r.l END;
+		IF r.t < u.t THEN u.t := r.t END;
+		IF r.r > u.r THEN u.r := r.r END;
+		IF r.b > u.b THEN u.b := r.b END
+	END Union;
+
+	PROCEDURE Add (rgn: Region; v: View; rebuild: BOOLEAN; gl, gt, gr, gb: INTEGER);
+		(* does not perfectly maintain invariant of non-overlapping approx rects ... *)
+		VAR q: Rect; i, j, n: INTEGER; x: ARRAY maxN OF BOOLEAN;
+	BEGIN
+		q.v := v; q.rebuild := rebuild; q.l := gl; q.t := gt; q.r := gr; q.b := gb;
+		n := rgn.n + 1;
+		i := 0;
+		WHILE i < rgn.n DO
+			x[i] := (gl < rgn.r[i].r) & (rgn.r[i].l < gr) & (gt < rgn.r[i].b) & (rgn.r[i].t < gb);
+			IF x[i] THEN Union(q, rgn.r[i]); DEC(n) END;
+			INC(i)
+		END;
+		IF n > maxN THEN
+			(* n = maxN + 1 -> merge q with arbitrarily picked rect and Add *)
+			Union(q, rgn.r[maxN - 1]); Add(rgn, v, q.rebuild, q.l, q.t, q.r, q.b)
+		ELSE
+			i := 0; WHILE (i < rgn.n) & ~x[i] DO INC(i) END;
+			rgn.r[i] := q; INC(i); WHILE (i < rgn.n) & ~x[i] DO INC(i) END;
+			j := i; WHILE (i < rgn.n) & x[i] DO INC(i) END;
+			WHILE i < rgn.n DO	(* ~x[i] *)
+				rgn.r[j] := rgn.r[i]; INC(j); INC(i);
+				WHILE (i < rgn.n) & x[i] DO INC(i) END
+			END;
+			rgn.n := n
+		END
+	END Add;
+
+	PROCEDURE AddRect (root: RootFrame; f: Frame; l, t, r, b: INTEGER; rebuild: BOOLEAN);
+		VAR rl, rt, rr, rb: INTEGER; i: INTEGER;
+	BEGIN
+		INC(l, f.gx); INC(t, f.gy); INC(r, f.gx); INC(b, f.gy);
+		rl := root.l + root.gx; rt := root.t + root.gy; rr := root.r + root.gx; rb := root.b + root.gy;
+		IF l < rl THEN l := rl END;
+		IF t < rt THEN t := rt END;
+		IF r > rr THEN r := rr END;
+		IF b > rb THEN b := rb END;
+		IF (l < r) & (t < b) THEN
+			Add(root.update, f.view, rebuild, l, t, r, b);
+			i := 0;
+			WHILE (i < root.update.n)
+				& (~root.update.r[i].rebuild OR (root.update.r[i].v # NIL)) DO INC(i) END;
+			IF i < root.update.n THEN Add(root.update, root.view, TRUE, rl, rt, rr, rb) END
+		END
+	END AddRect;
+
+
+	(** miscellaneous **)
+
+	PROCEDURE RestoreDomain* (domain: Stores.Domain);
+	BEGIN
+		ASSERT(msgHook # NIL, 100);
+		msgHook.RestoreDomain(domain)
+	END RestoreDomain;
+
+	PROCEDURE MarkBorder* (host: Ports.Frame; view: View; l, t, r, b: INTEGER);
+		VAR s: INTEGER;
+	BEGIN
+		IF view # NIL THEN 
+			s := markBorderSize * host.dot;
+			host.MarkRect(l - s, t - s, r + s, b + s, s, Ports.dim50, Ports.show)
+		END
+	END MarkBorder;
+	
+
+
+	(** views **)
+
+	PROCEDURE SeqOf (v: View): Sequencers.Sequencer;
+		VAR (*c: Models.Context;*) d: Stores.Domain; seq: Sequencers.Sequencer; any: ANYPTR;
+	BEGIN
+		d := v.Domain(); seq := NIL;
+		IF d # NIL THEN
+			any := d.GetSequencer();
+			IF (any # NIL) & (any IS Sequencers.Sequencer) THEN
+				seq := any(Sequencers.Sequencer)
+			END
+		END;
+		RETURN seq
+	END SeqOf;
+
+
+	PROCEDURE Era* (v: View): INTEGER;
+	(** pre: v # NIL *)
+	(** post:
+		v.ThisModel() # NIL
+			in-synch(v) iff Era(v) = Models.Era(v.ThisModel())
+	**)
+	BEGIN
+		ASSERT(v # NIL, 20);
+		RETURN v.era
+	END Era;
+
+	PROCEDURE BeginScript* (v: View; name: Stores.OpName; OUT script: Stores.Operation);
+	(** pre: v # NIL *)
+	(** post: (script # NIL) iff (v.seq # NIL) **)
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		seq := SeqOf(v);
+		IF seq # NIL THEN seq.BeginScript(name, script)
+		ELSE script := NIL
+		END
+	END BeginScript;
+
+	PROCEDURE Do* (v: View; name: Stores.OpName; op: Stores.Operation);
+	(** pre: v # NIL, op # NIL, ~op.inUse **)
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20); ASSERT(op # NIL, 21); (* ASSERT(~op.inUse, 22); *)
+		seq := SeqOf(v);
+		IF seq # NIL THEN seq.Do(v, name, op) ELSE op.Do END
+	END Do;
+
+	PROCEDURE LastOp* (v: View): Stores.Operation;
+	(** pre: v # NIL **)
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		seq := SeqOf(v);
+		IF seq # NIL THEN RETURN seq.LastOp(v) ELSE RETURN NIL END
+	END LastOp;
+
+	PROCEDURE Bunch* (v: View);
+	(** pre: v # NIL **)
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		seq := SeqOf(v); ASSERT(seq # NIL, 21);
+		seq.Bunch(v)
+	END Bunch;
+
+	PROCEDURE StopBunching* (v: View);
+	(** pre: v # NIL **)
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		seq := SeqOf(v);
+		IF seq # NIL THEN seq.StopBunching END
+	END StopBunching;
+
+	PROCEDURE EndScript* (v: View; script: Stores.Operation);
+	(** pre: (script # NIL) iff (v.seq # NIL) **)
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		seq := SeqOf(v);
+		IF seq # NIL THEN ASSERT(script # NIL, 21); seq.EndScript(script)
+		ELSE ASSERT(script = NIL, 22)
+		END
+	END EndScript;
+
+
+	PROCEDURE BeginModification* (type: INTEGER; v: View);
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		seq := SeqOf(v);
+		IF seq # NIL THEN seq.BeginModification(type, v) END
+	END BeginModification;
+
+	PROCEDURE EndModification* (type: INTEGER; v: View);
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		seq := SeqOf(v);
+		IF seq # NIL THEN seq.EndModification(type, v) END
+	END EndModification;
+
+	PROCEDURE SetDirty* (v: View);
+		VAR seq: Sequencers.Sequencer;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		seq := SeqOf(v);
+		IF seq # NIL THEN seq.SetDirty(TRUE) END
+	END SetDirty;
+
+
+	PROCEDURE Domaincast* (domain: Stores.Domain; VAR msg: Message);
+		VAR g: INTEGER; seq: ANYPTR;
+	BEGIN
+		IF domain # NIL THEN
+			seq := domain.GetSequencer();
+			IF seq # NIL THEN
+				msg.view := NIL;
+				g := Kernel.trapCount + 1;
+				IF domainGuard > 0 THEN ASSERT(domainGuard # g, 20) END;
+				domainGuard := g;
+				seq(Sequencers.Sequencer).Handle(msg);
+				domainGuard := 0
+			END
+		END
+	END Domaincast;
+
+	PROCEDURE Broadcast* (v: View; VAR msg: Message);
+		VAR seq: Sequencers.Sequencer; g: INTEGER;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		msg.view := v;
+		seq := SeqOf(v);
+		IF seq # NIL THEN
+			g := Kernel.trapCount + 1;
+			IF v.guard > 0 THEN ASSERT(v.guard # g, 21) END;
+			v.guard := g;
+			seq.Handle(msg);
+			v.guard := 0
+		END
+	END Broadcast;
+
+
+	PROCEDURE Update* (v: View; rebuild: BOOLEAN);
+		VAR upd: UpdateMsg;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		upd.scroll := FALSE; upd.rebuild := rebuild; upd.all := TRUE;
+		Broadcast(v, upd)
+	END Update;
+
+	PROCEDURE UpdateIn* (v: View; l, t, r, b: INTEGER; rebuild: BOOLEAN);
+		VAR upd: UpdateMsg;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		upd.scroll := FALSE; upd.rebuild := rebuild; upd.all := FALSE;
+		upd.l := l; upd.t := t; upd.r := r; upd.b := b;
+		Broadcast(v, upd)
+	END UpdateIn;
+
+	PROCEDURE Scroll* (v: View; dx, dy: INTEGER);
+		VAR scroll: UpdateMsg;
+	BEGIN
+		ASSERT(v # NIL, 20); ASSERT(v.Domain() # NIL, 21);
+		RestoreDomain(v.Domain());
+		scroll.scroll := TRUE; scroll.dx := dx; scroll.dy := dy;
+		Broadcast(v, scroll)
+	END Scroll;
+
+	PROCEDURE CopyOf* (v: View; shallow: BOOLEAN): View;
+		VAR w, a: View; op: INTEGER; b: Alien;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		IF ~(handler IN v.bad) THEN
+			a := actView; op := actOp; actView := NIL; actOp := handler;
+			IF shallow THEN copyModel := v.ThisModel() END;
+			actView := v;
+			w := Stores.CopyOf(v)(View);
+			actView := a; actOp := op
+		ELSE
+			NEW(b); w := b; w.bad := {handler..externalize}
+		END;
+		IF shallow THEN Stores.Join(w, v) END;
+		RETURN w
+	END CopyOf;
+
+	PROCEDURE CopyWithNewModel* (v: View; m: Models.Model): View;
+		VAR w, a: View; op: INTEGER; b: Alien; fm: Models.Model;
+	BEGIN
+		ASSERT(v # NIL, 20);
+		fm := v.ThisModel(); ASSERT(fm # NIL, 21);
+		ASSERT(m # NIL, 22);
+		ASSERT(Services.SameType(m, fm), 23);
+		IF ~(handler IN v.bad) THEN
+			a := actView; op := actOp; actView := v; actOp := handler;
+			copyModel := m;
+			w := Stores.CopyOf(v)(View);
+			actView := a; actOp := op
+		ELSE
+			NEW(b); w := b; w.bad := {handler..externalize}
+		END;
+		RETURN w
+	END CopyWithNewModel;
+
+	PROCEDURE ReadView* (VAR rd: Stores.Reader; OUT v: View);
+		VAR st: Stores.Store; a: Alien;
+	BEGIN
+		rd.ReadStore(st);
+		IF st = NIL THEN
+			v := NIL
+		ELSIF st IS Stores.Alien THEN
+			NEW(a);
+			a.store := st(Stores.Alien); Stores.Join(a, a.store);
+			v := a
+		ELSE
+			v := st(View)
+		END
+	END ReadView;
+
+	PROCEDURE WriteView* (VAR wr: Stores.Writer; v: View);
+		VAR a: TrapAlien; av: View; op: INTEGER;
+	BEGIN
+		IF v = NIL THEN wr.WriteStore(v)
+		ELSIF externalize IN v.bad THEN NEW(a); wr.WriteStore(a)
+		ELSIF v IS Alien THEN wr.WriteStore(v(Alien).store)
+		ELSE
+			av := actView; op := actOp; actView := v; actOp := externalize;
+			wr.WriteStore(v);
+			actView := av; actOp := op
+		END
+	END WriteView;
+
+
+	(* frames *)
+
+	PROCEDURE SetClip (f: Frame; l, t, r, b: INTEGER);
+		VAR u: INTEGER;
+	BEGIN
+		ASSERT(f.rider # NIL, 20); ASSERT(l <= r, 21); ASSERT(t <= b, 22);
+		u := f.unit;
+		f.rider.SetRect((l + f.gx) DIV u, (t + f.gy) DIV u, (r + f.gx) DIV u, (b + f.gy) DIV u);
+		f.l := l; f.t := t; f.r := r; f.b := b
+	END SetClip;
+
+	PROCEDURE Close (f: Frame);
+	BEGIN
+		f.Close;
+		f.state := closed;
+		f.up := NIL; f.down := NIL; f.next := NIL; f.view := NIL;
+		f.ConnectTo(NIL)
+	END Close;
+
+	PROCEDURE AdaptFrameTo (f: Frame; orgX, orgY: INTEGER);
+		VAR g, p, q: Frame; port: Ports.Port;
+			w, h,  pl, pt, pr, pb,  gl, gt, gr, gb,  gx, gy: INTEGER;
+	BEGIN
+		(* pre: environment (i.e. parent frame / port) has already been set up *)
+		ASSERT(f.view # NIL, 20); ASSERT(f.view.context # NIL, 21);
+		f.x := orgX; f.y := orgY;	(* set new origin *)
+		g := f.up;
+		IF g # NIL THEN	(* parent frame is environment *)
+			f.gx0 := g.gx + orgX; f.gy0 := g.gy + orgY;
+			f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy);
+			pl := g.gx + g.l; pt := g.gy + g.t; pr := g.gx + g.r; pb := g.gy + g.b
+		ELSE	(* port is environment *)
+			f.gx0 := orgX; f.gy0 := orgY;
+			f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy);
+			port := f.rider.Base();
+			port.GetSize(w, h);
+			pl := 0; pt := 0; pr := w * f.unit; pb := h * f.unit
+		END;
+		(* (pl, pt, pr, pb) is parent clipping rectangle, in global coordinates, and in units *)
+		gx := f.gx; gy := f.gy; f.view.context.GetSize(w, h);
+		gl := gx; gt := gy; gr := gx + w; gb := gy + h;
+		(* (gl, gt, gr, gb) is desired clipping rectangle, in global coordinates, and in units *)
+		IF gl < pl THEN gl := pl END;
+		IF gt < pt THEN gt := pt END;
+		IF gr > pr THEN gr := pr END;
+		IF gb > pb THEN gb := pb END;
+		IF (gl >= gr) OR (gt >= gb) THEN gr := gl; gb := gt END;
+		SetClip(f, gl - gx + f.sx, gt - gy + f.sy, gr - gx + f.sx, gb - gy + f.sy);
+		(* (f.l, f.t, f.r, f.b) is final clipping rectangle, in local coordinates, and in units *)
+		g := f.down; f.down := NIL; p := NIL;
+		WHILE g # NIL DO	(* adapt child frames *)
+			q := g.next; g.next := NIL;
+			AdaptFrameTo(g, g.x, g.y);
+			IF g.l = g.r THEN	(* empty child frame: remove *)
+				Close(g)
+			ELSE	(* insert in new frame list *)
+				IF p = NIL THEN f.down := g ELSE p.next := g END;
+				p := g
+			END;
+			g := q
+		END
+		(* post: frame is set; child frames are set, nonempty, and clipped to frame *)
+	END AdaptFrameTo;
+
+	PROCEDURE SetRoot* (root: RootFrame; view: View; front: BOOLEAN; flags: SET);
+	BEGIN
+		ASSERT(root # NIL, 20); ASSERT(root.rider # NIL, 21);
+		ASSERT(view # NIL, 22); ASSERT(view.context # NIL, 23);
+		ASSERT(view.Domain() # NIL, 24);
+		ASSERT(root.state IN {new, open}, 25);
+		root.view := view;
+		root.front := front; root.mark := TRUE; root.flags := flags;
+		root.state := open;
+		IF root.update = NIL THEN NEW(root.update); root.update.n := 0 END
+	END SetRoot;
+
+	PROCEDURE AdaptRoot* (root: RootFrame);
+	BEGIN
+		ASSERT(root # NIL, 20); ASSERT(root.state = open, 21);
+		AdaptFrameTo(root, root.x, root.y)
+	END AdaptRoot;
+
+	PROCEDURE UpdateRoot* (root: RootFrame; l, t, r, b: INTEGER; rebuild: BOOLEAN);
+	BEGIN
+		ASSERT(root # NIL, 20); ASSERT(root.state = open, 21);
+		AddRect(root, root, l, t, r, b, rebuild)
+	END UpdateRoot;
+
+	PROCEDURE RootOf* (f: Frame): RootFrame;
+	BEGIN
+		ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
+		WHILE f.up # NIL DO f := f.up END;
+		RETURN f(RootFrame)
+	END RootOf;
+	
+	PROCEDURE HostOf* (f: Frame): Frame;
+	BEGIN
+		ASSERT(f # NIL, 20);
+		RETURN f.up
+	END HostOf;
+
+	PROCEDURE IsPrinterFrame* (f: Frame): BOOLEAN;
+		VAR p: Ports.Port;
+	BEGIN
+		ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
+		p := f.rider.Base();
+		RETURN Ports.IsPrinterPort(p)
+	END IsPrinterFrame;
+
+	PROCEDURE InstallFrame* (host: Frame; view: View; x, y, level: INTEGER; focus: BOOLEAN);
+		VAR e, f, g: Frame; w, h,  l, t, r, b: INTEGER; m: Models.Model; std: StdFrame;
+			msg: UpdateCachesMsg; a: View; op: INTEGER;
+	BEGIN
+		ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
+		ASSERT(view # NIL, 22); ASSERT(view.context # NIL, 23);
+		ASSERT(view.Domain() # NIL, 24);
+		e := NIL; g := host.down; WHILE (g # NIL) & (g.view # view) DO e := g; g := g.next END;
+		IF g = NIL THEN	(* frame for view not yet in child frame list *)
+			view.context.GetSize(w, h);
+			IF w > MAX(INTEGER) DIV 2 THEN w := MAX(INTEGER) DIV 2 END;
+			IF h > MAX(INTEGER) DIV 2 THEN h := MAX(INTEGER) DIV 2 END;
+			l := x; t := y; r := x + w; b := y + h;
+			(* (l, t, r, b) is child frame rectangle, in local coordinates, and in units *)
+			IF (l < host.r) & (t < host.b) & (r > host.l) & (b > host.t) THEN	(* visible *)
+				g := NIL; view.GetNewFrame(g);
+				IF g = NIL THEN NEW(std); g := std END;
+				ASSERT(~(g IS RootFrame), 100);
+				e := NIL; f := host.down; WHILE (f # NIL) & (f.level <= level) DO e := f; f := f.next END;
+				IF e = NIL THEN g.next := host.down; host.down := g ELSE g.next := e.next; e.next := g END;
+				g.down := NIL; g.up := host; g.level := level;
+				g.view := view;
+				g.ConnectTo(host.rider.Base());
+				g.state := open;
+				AdaptFrameTo(g, x, y);
+				IF ~(handler IN view.bad) THEN
+					a := actView; op := actOp; actView := view; actOp := handler;
+					view.HandleViewMsg(g, msg);
+					actView := a; actOp := op
+				END;
+				m := view.ThisModel();
+				IF m # NIL THEN view.era := Models.Era(m) END;
+			END
+		ELSE
+			IF g.level # level THEN	(* adapt to modified z-order *)
+				IF e = NIL THEN host.down := g.next ELSE e.next := g.next END;
+				e := NIL; f := host.down; WHILE (f # NIL) & (f.level <= level) DO e := f; f := f.next END;
+				IF e = NIL THEN g.next := host.down; host.down := g ELSE g.next := e.next; e.next := g END;
+				g.level := level
+			END;
+			AdaptFrameTo(g, x, y)	(* may close g, leaving g.state = closed *)
+			(* possibly optimize: don't call Adapt if x=g.x, y=g.y, "host.era=g.era" *)
+		END;
+		IF (g # NIL) & (g.state = open) THEN
+			IF focus THEN
+				g.front := host.front; g.mark := host.mark
+			ELSE
+				g.front := FALSE; g.mark := FALSE
+			END
+		END
+	END InstallFrame;
+
+	PROCEDURE RemoveAll (f: Frame);
+		VAR g, p: Frame;
+	BEGIN
+		g := f.down; WHILE g # NIL DO p := g.next; RemoveAll(g); Close(g); g := p END;
+		f.down := NIL
+	END RemoveAll;
+
+	PROCEDURE RemoveFrame* (host, f: Frame);
+		VAR g, h: Frame;
+	BEGIN
+		ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
+		ASSERT(f # NIL, 22); ASSERT(f.up = host, 23);
+		g := host.down; h := NIL;
+		WHILE (g # NIL) & (g # f) DO h := g; g := g.next END;
+		ASSERT(g = f, 24);
+		IF h = NIL THEN host.down := f.next ELSE h.next := f.next END;
+		RemoveAll(f); Close(f)
+	END RemoveFrame;
+
+	PROCEDURE RemoveFrames* (host: Frame; l, t, r, b: INTEGER);
+		VAR f, g: Frame; gl, gt, gr, gb: INTEGER;
+	BEGIN
+		ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
+		IF l < host.l THEN l := host.l END;
+		IF t < host.t THEN t := host.t END;
+		IF r > host.r THEN r := host.r END;
+		IF b > host.b THEN b := host.b END;
+		IF (l < r) & (t < b) THEN
+			gl := l + host.gx; gt := t + host.gy; gr := r + host.gx; gb := b + host.gy;
+			f := host.down;
+			WHILE f # NIL DO
+				g := f; f := f.next;
+				IF (gl < g.r + g.gx) & (g.l + g.gx < gr) & (gt < g.b + g.gy) & (g.t + g.gy < gb) THEN
+					RemoveFrame(host, g)
+				END
+			END
+		END
+	END RemoveFrames;
+
+	PROCEDURE ThisFrame* (host: Frame; view: View): Frame;
+		VAR g: Frame;
+	BEGIN
+		ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
+		g := host.down; WHILE (g # NIL) & (g.view # view) DO g := g.next END;
+		RETURN g
+	END ThisFrame;
+
+	PROCEDURE FrameAt* (host: Frame; x, y: INTEGER): Frame;
+	(** return frontmost sub-frame of host that contains (x, y) **)
+		VAR g, h: Frame;
+	BEGIN
+		ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
+		g := host.down; h := NIL; INC(x, host.gx); INC(y, host.gy);
+		WHILE g # NIL DO
+			IF (g.gx + g.l <= x) & (x < g.gx + g.r) & (g.gy + g.t <= y) & (y < g.gy + g.b) THEN
+				h := g
+			END;
+			g := g.next
+		END;
+		RETURN h
+	END FrameAt;
+
+	PROCEDURE ShiftFrames (f: Frame; dx, dy: INTEGER);
+		VAR g, h: Frame;
+	BEGIN
+		g := f.down;
+		WHILE g # NIL DO
+			h := g; g := g.next;
+			AdaptFrameTo(h, h.x + dx, h.y + dy);
+			IF h.l = h.r THEN RemoveFrame(f, h) END
+		END
+	END ShiftFrames;
+
+	PROCEDURE UpdateExposedArea (f: Frame; dx, dy: INTEGER);
+		VAR root: RootFrame;
+	BEGIN
+		root := RootOf(f);
+		IF dy > 0 THEN
+			AddRect(root, f, f.l, f.t, f.r, f.t + dy, keepFrames);
+			IF dx > 0 THEN
+				AddRect(root, f, f.l, f.t + dy, f.l + dx, f.b, keepFrames)
+			ELSE
+				AddRect(root, f, f.r + dx, f.t + dy, f.r, f.b, keepFrames)
+			END
+		ELSE
+			AddRect(root, f, f.l, f.b + dy, f.r, f.b, keepFrames);
+			IF dx > 0 THEN
+				AddRect(root, f, f.l, f.t, f.l + dx, f.b + dy, keepFrames)
+			ELSE
+				AddRect(root, f, f.r + dx, f.t, f.r, f.b + dy, keepFrames)
+			END
+		END
+	END UpdateExposedArea;
+
+	PROCEDURE ScrollFrame (f: Frame; dx, dy: INTEGER);
+		VAR g: Frame; u, dx0, dy0: INTEGER; bitmapScrolling: BOOLEAN; msg: ScrollClassMsg;
+	BEGIN
+		g := f.up;
+		bitmapScrolling := TRUE;
+		IF (g # NIL) THEN
+			WHILE bitmapScrolling & (g.up # NIL) DO
+				msg.allowBitmapScrolling := FALSE; g.view.HandleViewMsg(g, msg);
+				bitmapScrolling := bitmapScrolling & msg.allowBitmapScrolling;
+				g  := g.up
+			END
+		END;
+		IF bitmapScrolling THEN
+			u := f.unit; dx0 := dx; dy0 := dy;
+			INC(dx, f.sx); INC(dy, f.sy); DEC(f.l, f.sx); DEC(f.t, f.sy); DEC(f.r, f.sx); DEC(f.b, f.sy);
+			f.sx := dx MOD u; f.sy := dy MOD u;
+			DEC(dx, f.sx); DEC(dy, f.sy); INC(f.l, f.sx); INC(f.t, f.sy); INC(f.r, f.sx); INC(f.b, f.sy);
+			f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy);
+			ShiftFrames(f, dx0, dy0);
+			f.Scroll(dx, dy);
+			UpdateExposedArea(f, dx, dy)
+		ELSE AddRect(RootOf(f), f, f.l, f.t, f.r, f.b, rebuildFrames)
+		END
+	END ScrollFrame;
+
+	PROCEDURE BroadcastModelMsg* (f: Frame; VAR msg: Models.Message);
+		VAR v, a: View; send: BOOLEAN; op: INTEGER;
+	BEGIN
+		ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
+		v := f.view;
+		IF ~(handler IN v.bad) THEN
+			a := actView; op := actOp; actView := v; actOp := handler;
+			IF msg.model # NIL THEN
+				IF (msg.model = v.ThisModel()) & (msg.era > v.era) THEN
+					send := (msg.era - v.era = 1);
+					v.era := msg.era;
+					IF ~send THEN
+						Log.synch := FALSE;
+						HALT(100)
+					END
+				ELSE send := FALSE
+				END
+			ELSE send := TRUE
+			END;
+			IF send THEN
+				WITH msg: Models.NeutralizeMsg DO
+					v.Neutralize
+				ELSE
+					 v.HandleModelMsg(msg)
+				END
+			END;
+			actView := a; actOp := op
+		END;
+		f := f.down; WHILE f # NIL DO BroadcastModelMsg(f, msg); f := f.next END
+	END BroadcastModelMsg;
+
+	PROCEDURE HandleUpdateMsg (f: Frame; VAR msg: UpdateMsg);
+		VAR root: RootFrame; g: Frame; l, t, r, b,  dx, dy: INTEGER;
+	BEGIN
+		root := RootOf(f);
+		IF msg.scroll THEN
+			IF root.update.n = 0 THEN
+				ScrollFrame(f, msg.dx, msg.dy)
+			ELSE
+				AddRect(root, f, f.l, f.t, f.r, f.b, msg.rebuild)
+			END
+		ELSE
+			IF msg.all THEN
+				IF f # root THEN g := f.up ELSE g := root END;
+				dx := f.gx - g.gx; dy := f.gy - g.gy;
+				AddRect(root, g, f.l + dx, f.t + dy, f.r + dx, f.b + dy, msg.rebuild)
+			ELSE
+				l := msg.l; t := msg.t; r := msg.r; b := msg.b;
+				IF l < f.l THEN l := f.l END;
+				IF t < f.t THEN t := f.t END;
+				IF r > f.r THEN r := f.r END;
+				IF b > f.b THEN b := f.b END;
+				AddRect(root, f, l, t, r, b, msg.rebuild)
+			END
+		END
+	END HandleUpdateMsg;
+
+	PROCEDURE BroadcastViewMsg* (f: Frame; VAR msg: Message);
+		VAR v, a: View; op: INTEGER;
+	BEGIN
+		ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
+		v := f.view;
+		IF (msg.view = v) OR (msg.view = NIL) THEN
+			WITH msg: UpdateMsg DO
+				HandleUpdateMsg(f, msg)
+			ELSE
+				IF ~(handler IN v.bad) THEN
+					a := actView; op := actOp; actView := v; actOp := handler;
+					v.HandleViewMsg(f, msg);
+					actView := a; actOp := op
+				END
+			END
+		END;
+		IF msg.view # v THEN
+			f := f.down; WHILE f # NIL DO BroadcastViewMsg(f, msg); f := f.next END
+		END
+	END BroadcastViewMsg;
+
+	PROCEDURE ForwardCtrlMsg* (f: Frame; VAR msg: CtrlMessage);
+		CONST pre = 0; translate = 1; backoff = 2; final = 3;
+		VAR v, focus, a: View; g, h: Frame; op: INTEGER; req: BOOLEAN;
+	BEGIN
+		ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
+		v := f.view;
+		focus := NIL; g := f.up; req := FALSE;
+		HandleCtrlMsg(pre, f, g, msg, f.mark, f.front, req);
+		IF ~(handler IN v.bad) THEN
+			a := actView; op := actOp; actView := v; actOp := handler;
+			v.HandleCtrlMsg(f, msg, focus);
+			actView := a; actOp := op
+		END;
+		IF focus # NIL THEN	(* propagate msg to another view *)
+			IF (f.focus # NIL) & (f.focus.view = focus) THEN	(* cache hit *)
+				h := f.focus
+			ELSE	(* cache miss *)
+				h := f.down; WHILE (h # NIL) & (h.view # focus) DO h := h.next END
+			END;
+			IF h # NIL THEN
+				HandleCtrlMsg(translate, f, h, msg, f.mark, f.front, req);
+				f.focus := h; ForwardCtrlMsg(h, msg);
+				HandleCtrlMsg(backoff, f, g, msg, f.mark, f.front, req)
+			END
+		ELSE
+			HandleCtrlMsg(final, f, g, msg, f.mark, f.front, req)
+		END;
+		IF req & (g # NIL) THEN g.view.ConsiderFocusRequestBy(f.view) END
+	END ForwardCtrlMsg;
+
+
+	PROCEDURE RestoreFrame (f: Frame; l, t, r, b: INTEGER);
+		VAR rd: Ports.Rider; g: Frame; v, a: View; op: INTEGER;
+			u, w, h,  cl, ct, cr, cb,  dx, dy: INTEGER; col: Ports.Color;
+	BEGIN
+		IF l < f.l THEN l := f.l END;
+		IF t < f.t THEN t := f.t END;
+		IF r > f.r THEN r := f.r END;
+		IF b > f.b THEN b := f.b END;
+		IF (l < r) & (t < b) THEN	(* non-empty rectangle to be restored *)
+			v := f.view; rd := f.rider; u := f.unit;
+			rd.GetRect(cl, ct, cr, cb);	(* save clip rectangle *)
+			rd.SetRect((f.gx + l) DIV u, (f.gy + t) DIV u, (f.gx + r) DIV u, (f.gy + b) DIV u);
+			IF ~(restore IN v.bad) THEN
+				a := actView; op := actOp; actView := v; actOp := restore;
+				col := transparent; v.GetBackground(col);
+				IF col # transparent THEN f.DrawRect(l, t, r, b, Ports.fill, col) END;
+				v.Restore(f, l, t, r, b);
+				g := f.down;
+				WHILE g # NIL DO	(* loop over all subframes to handle overlaps *)
+					dx := f.gx - g.gx; dy := f.gy - g.gy;
+					RestoreFrame(g, l + dx, t + dy, r + dx, b + dy);
+					g := g.next
+				END;
+				v.RestoreMarks(f, l, t, r, b);
+				actView := a; actOp := op
+			END;
+			IF v.bad # {} THEN
+				IF externalize IN v.bad THEN
+					u := f.dot; v.context.GetSize(w, h);
+					f.DrawLine(0, 0, w - u, h - u, u, Ports.grey75);
+					f.DrawLine(w - u, 0, 0, h - u, u, Ports.grey75)
+				END;
+				f.MarkRect(l, t, r, b, Ports.fill, Ports.dim25, Ports.show)
+			END;
+			rd.SetRect(cl, ct, cr, cb)	(* restore current clip rectangle *)
+		END
+	END RestoreFrame;
+
+	PROCEDURE RestoreRoot* (root: RootFrame; l, t, r, b: INTEGER);
+		VAR port: Ports.Port; rd: Ports.Rider;
+			u,  gl, gt, gr, gb: INTEGER; col: Ports.Color;
+	BEGIN
+		ASSERT(root # NIL, 20); ASSERT(root.state = open, 21);
+		ASSERT(root.update.n = 0, 22);
+		IF l < root.l THEN l := root.l END;
+		IF t < root.t THEN t := root.t END;
+		IF r > root.r THEN r := root.r END;
+		IF b > root.b THEN b := root.b END;
+		IF (l < r) & (t < b) THEN
+			u := root.unit;
+			gl := l + root.gx; gt := t + root.gy; gr := r + root.gx; gb := b + root.gy;
+			rd := root.rider; port := rd.Base();
+			actFrame := root;
+			IF ~IsPrinterFrame(root) THEN port.OpenBuffer(gl DIV u, gt DIV u, gr DIV u, gb DIV u) END;
+			col := transparent; root.view.GetBackground(col);
+			ASSERT(col # transparent, 100);
+			RestoreFrame(root, l, t, r, b);
+			IF ~IsPrinterFrame(root) THEN port.CloseBuffer END;
+			actFrame := NIL
+		END
+	END RestoreRoot;
+
+	PROCEDURE ThisCand (f: Frame; v: View): Frame;
+	(* find frame g with g.view = v *)
+		VAR g: Frame;
+	BEGIN
+		WHILE (f # NIL) & (f.view # v) DO
+			g := ThisCand(f.down, v);
+			IF g # NIL THEN f := g ELSE f := f.next END
+		END;
+		RETURN f
+	END ThisCand;
+
+	PROCEDURE ValidateRoot* (root: RootFrame);
+		VAR rgn: Region; f: Frame; v: View; i, n: INTEGER;
+	BEGIN
+		ASSERT(root # NIL, 20); ASSERT(root.state = open, 21);
+		rgn := root.update; n := rgn.n; rgn.n := 0; i := 0;
+		WHILE i < n DO
+			IF rgn.r[i].rebuild THEN
+				v := rgn.r[i].v;
+				IF v # NIL THEN f := ThisCand(root, v) ELSE f := NIL END;
+				IF f = NIL THEN f := root END;
+				RemoveFrames(f, rgn.r[i].l - f.gx, rgn.r[i].t - f.gy, rgn.r[i].r - f.gx, rgn.r[i].b - f.gy)
+			END;
+			INC(i)
+		END;
+		i := 0;
+		WHILE i < n DO
+			RestoreRoot(root, rgn.r[i].l - root.gx, rgn.r[i].t - root.gy, rgn.r[i].r - root.gx, rgn.r[i].b - root.gy);
+			INC(i)
+		END
+	END ValidateRoot;
+
+	PROCEDURE MarkBordersIn (f: Frame);
+		VAR g: Frame; w, h: INTEGER;
+	BEGIN
+		g := f.down;
+		WHILE g # NIL DO
+			g.view.context.GetSize(w, h);
+			MarkBorder(f, g.view, g.x, g.y, g.x + w, g.y + h);
+			MarkBordersIn(g);
+			g := g.next
+		END
+	END MarkBordersIn;
+
+	PROCEDURE MarkBorders* (root: RootFrame);
+	BEGIN
+		MarkBordersIn(root)
+	END MarkBorders;
+
+	PROCEDURE ReadFont* (VAR rd: Stores.Reader; OUT f: Fonts.Font);
+		VAR version: INTEGER;
+			fingerprint, size: INTEGER; typeface: Fonts.Typeface; style: SET; weight: INTEGER;
+	BEGIN
+		rd.ReadVersion(0, 0, version);
+		rd.ReadInt(fingerprint);
+		rd.ReadXString(typeface); rd.ReadInt(size); rd.ReadSet(style); rd.ReadXInt(weight);
+		f := Fonts.dir.This(typeface, size, style, weight); ASSERT(f # NIL, 60);
+		IF f.IsAlien() THEN
+			Stores.Report("#System:AlienFont", typeface, "", "")
+		END
+	END ReadFont;
+
+	PROCEDURE WriteFont* (VAR wr: Stores.Writer; f: Fonts.Font);
+	BEGIN
+		ASSERT(f # NIL, 20);
+		wr.WriteVersion(0);
+		wr.WriteInt(0);
+		wr.WriteXString(f.typeface); wr.WriteInt(f.size); wr.WriteSet(f.style); wr.WriteXInt(f.weight)
+	END WriteFont;
+
+
+	(** view/file interaction **)
+
+	PROCEDURE Old* (ask: BOOLEAN;
+						VAR loc: Files.Locator; VAR name: Files.Name; VAR conv: Converters.Converter): View;
+		VAR v: View;
+	BEGIN
+		ASSERT(ask OR (loc # NIL), 20);
+		ASSERT(ask OR (name # ""), 21);
+		IF ask THEN
+			ASSERT(getSpecHook # NIL, 101);
+			getSpecHook.GetIntSpec(loc, name, conv)
+		END;
+		IF (loc # NIL) & (name # "") THEN
+			ASSERT(viewHook # NIL, 100);
+			v := viewHook.OldView(loc, name, conv)
+		ELSE v := NIL
+		END;
+		RETURN v
+	END Old;
+	
+	PROCEDURE OldView* (loc: Files.Locator; name: Files.Name): View;
+		VAR conv: Converters.Converter;
+	BEGIN
+		conv := NIL;
+		RETURN Old(dontAsk, loc, name, conv)
+	END OldView;
+
+	PROCEDURE Register* (view: View; ask: BOOLEAN;
+				VAR loc: Files.Locator; VAR name: Files.Name; VAR conv: Converters.Converter; OUT res: INTEGER);
+	BEGIN
+		ASSERT(viewHook # NIL, 100);
+		ASSERT(getSpecHook # NIL, 101);
+		ASSERT(view # NIL, 20);
+		ASSERT(ask OR (loc # NIL), 22); ASSERT(ask OR (name # ""), 23);
+		IF ask OR (loc = NIL) OR (name = "") OR (loc.res = 77) THEN
+			getSpecHook.GetExtSpec(view, loc, name, conv)
+		END;
+		IF (loc # NIL) & (name # "") THEN
+			viewHook.RegisterView(view, loc, name, conv); res := loc.res
+		ELSE res := 7
+		END
+	END Register;
+
+	PROCEDURE RegisterView* (view: View; loc: Files.Locator; name: Files.Name);
+		VAR res: INTEGER; conv: Converters.Converter;
+	BEGIN
+		conv := NIL;
+		Register(view, dontAsk, loc, name, conv, res)
+	END RegisterView;
+
+	(** direct view opening **)
+
+	PROCEDURE Open* (view: View; loc: Files.Locator; name: Files.Name; conv: Converters.Converter);
+	BEGIN
+		ASSERT(view # NIL, 20); ASSERT((loc = NIL) = (name = ""), 21);
+		ASSERT(viewHook # NIL, 100);
+		viewHook.Open(view, name, loc, name, conv, FALSE, FALSE, FALSE, FALSE, FALSE)
+	END Open;
+
+	PROCEDURE OpenView* (view: View);
+	BEGIN
+		ASSERT(view # NIL, 20);
+		Open(view, NIL, "", NIL)
+	END OpenView;
+
+	PROCEDURE OpenAux* (view: View; title: Title);
+	BEGIN
+		ASSERT(view # NIL, 20); ASSERT(viewHook # NIL, 100);
+		IF title = "" THEN title := "#System:untitled" END;
+		viewHook.Open(view, title, NIL, "", NIL, FALSE, TRUE, FALSE, TRUE, TRUE)
+	END OpenAux;
+
+
+	(** view producer/consumer decoupling **)
+
+	PROCEDURE Deposit* (view: View);
+		VAR q: QueueElem;
+	BEGIN
+		ASSERT(view # NIL, 20);
+		NEW(q); q.view := view;
+		IF queue.head = NIL THEN queue.head := q ELSE queue.tail.next := q END;
+		queue.tail := q; INC(queue.len)
+	END Deposit;
+
+	PROCEDURE Fetch* (OUT view: View);
+		VAR q: QueueElem;
+	BEGIN
+		q := queue.head; ASSERT(q # NIL, 20);
+		DEC(queue.len); queue.head := q.next;
+		IF queue.head = NIL THEN queue.tail := NIL END;
+		view := q.view
+	END Fetch;
+
+	PROCEDURE Available* (): INTEGER;
+	BEGIN
+		RETURN queue.len
+	END Available;
+
+	PROCEDURE ClearQueue*;
+	BEGIN
+		queue.len := 0; queue.head := NIL; queue.tail := NIL;
+		actView := NIL	(* HACK! prevents invalidation of view due to trap in Dialog.Call *)
+	END ClearQueue;
+
+
+	(** attach controller framework **)
+
+	PROCEDURE InitCtrl* (p: CtrlMsgHandler);
+	BEGIN
+		ASSERT(HandleCtrlMsg = NIL, 20); HandleCtrlMsg := p
+	END InitCtrl;
+
+	PROCEDURE (h: NotifyHook) Notify (id0, id1: INTEGER; opts: SET);
+		VAR msg: NotifyMsg;
+	BEGIN
+		ASSERT(msgHook # NIL, 100);
+		msg.id0 := id0; msg.id1 := id1; msg.opts := opts;
+		msgHook.Omnicast(msg)
+	END Notify;
+	
+	PROCEDURE Omnicast* (VAR msg: ANYREC);
+	BEGIN
+		msgHook.Omnicast(msg)
+	END Omnicast;
+
+	PROCEDURE HandlePropMsg* (v: View; VAR msg: PropMessage);
+		VAR a: View; op: INTEGER;
+	BEGIN
+		IF ~(handler IN v.bad) THEN
+			a := actView; op := actOp; actView := v; actOp := handler;
+			v.HandlePropMsg(msg);
+			actView := a; actOp := op
+		END
+	END HandlePropMsg;
+	
+	
+	(* view invalidation *)
+	
+	PROCEDURE IsInvalid* (v: View): BOOLEAN;
+	BEGIN
+		RETURN v.bad # {}
+	END IsInvalid;
+	
+	PROCEDURE RevalidateView* (v: View);
+	BEGIN
+		v.bad := {};
+		Update(v, keepFrames)
+	END RevalidateView;
+	
+	PROCEDURE TrapCleanup;
+	BEGIN
+		copyModel := NIL;
+		IF actView # NIL THEN
+			INCL(actView.bad, actOp);
+			IF actFrame # NIL THEN
+				UpdateRoot(actFrame, actFrame.l, actFrame.t, actFrame.r, actFrame.b, keepFrames);
+				actFrame := NIL
+			END;
+			Update(actView, keepFrames);
+			actView := NIL
+		END
+	END TrapCleanup;
+	
+	PROCEDURE Init;
+		VAR h: NotifyHook;
+	BEGIN
+		NEW(h); Dialog.SetNotifyHook(h);
+		domainGuard := 0; ClearQueue;
+		Kernel.InstallTrapChecker(TrapCleanup)
+	END Init;
+
+BEGIN
+	Init
+END Views.

BlackBox/System/Mod/Windows.txt

@@ -0,0 +1,855 @@
+MODULE Windows;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Windows.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT
+		Kernel, Ports, Files, Services,
+		Stores, Sequencers, Models, Views, Controllers, Properties,
+		Dialog, Converters, Containers, Documents;
+
+	CONST
+		(** Window.flags **)
+		isTool* = 0; isAux* = 1;
+		noHScroll* = 2; noVScroll* = 3; noResize* = 4;
+		allowDuplicates* = 5; neverDirty* = 6;
+
+		(** Directory.Select lazy **)
+		eager* = FALSE; lazy* = TRUE;
+
+		notRecorded = 3;
+
+	TYPE
+		Window* = POINTER TO ABSTRACT RECORD
+			port-: Ports.Port;
+			frame-: Views.RootFrame;
+			doc-: Documents.Document;
+			seq-: Sequencers.Sequencer;
+			link-: Window;	(* ring of windows with same sequencer *)
+			sub-: BOOLEAN;
+			flags-: SET;
+			loc-: Files.Locator;
+			name-: Files.Name;
+			conv-: Converters.Converter
+		END;
+
+		Directory* = POINTER TO ABSTRACT RECORD
+			l*, t*, r*, b*: INTEGER;
+			minimized*, maximized*: BOOLEAN
+		END;
+
+
+		OpElem = POINTER TO RECORD
+			next: OpElem;
+			st: Stores.Store;
+			op: Stores.Operation;
+			name: Stores.OpName;
+			invisible, transparent: BOOLEAN
+		END;
+
+		Script = POINTER TO RECORD (Stores.Operation)
+			up: Script;
+			list: OpElem;
+			level: INTEGER;	(* nestLevel at creation time *)
+			name: Stores.OpName
+		END;
+
+		StdSequencer = POINTER TO RECORD (Sequencers.Sequencer)
+			home: Window;
+			trapEra: INTEGER;	(* last observed TrapCount value *)
+			modLevel: INTEGER;	(* dirty if modLevel > 0 *)
+			entryLevel: INTEGER;	(* active = (entryLevel > 0) *)
+			nestLevel: INTEGER;	(* nesting level of BeginScript/Modification *)
+			modStack: ARRAY 64 OF RECORD store: Stores.Store; type: INTEGER END;
+			lastSt: Stores.Store;
+			lastOp: Stores.Operation;
+			script: Script;
+			undo, redo: OpElem;	(* undo/redo stacks *)
+			noUndo: BOOLEAN;	(* script # NIL and BeginModification called *)
+			invisibleLevel, transparentLevel, notRecordedLevel: INTEGER
+		END;
+		
+		SequencerDirectory = POINTER TO RECORD (Sequencers.Directory) END;
+
+		Forwarder = POINTER TO RECORD (Controllers.Forwarder) END;
+		
+		RootContext = POINTER TO RECORD (Models.Context)
+			win: Window
+		END;
+		
+		Reducer = POINTER TO RECORD (Kernel.Reducer) END;
+
+		Hook = POINTER TO RECORD (Views.MsgHook) END;
+		
+		CheckAction = POINTER TO RECORD (Services.Action) 
+			wait: WaitAction
+		END;
+
+		WaitAction = POINTER TO RECORD (Services.Action) 
+			check: CheckAction
+		END;
+		
+		LangNotifier = POINTER TO RECORD (Dialog.LangNotifier) END;
+
+	VAR dir-, stdDir-: Directory;
+
+	PROCEDURE ^ Reset (s: StdSequencer);
+
+
+	PROCEDURE CharError;
+	BEGIN
+		Dialog.Beep
+	END CharError;
+
+	
+	
+	(** Window **)
+
+	PROCEDURE (w: Window) Init* (port: Ports.Port), NEW;
+	BEGIN
+		ASSERT(w.port = NIL, 20); ASSERT(port # NIL, 21);
+		w.port := port
+	END Init;
+
+	PROCEDURE (w: Window) SetTitle* (title: Views.Title), NEW, ABSTRACT;
+	PROCEDURE (w: Window) GetTitle* (OUT title: Views.Title), NEW, ABSTRACT;
+	PROCEDURE (w: Window) RefreshTitle* (), NEW, ABSTRACT;
+
+	PROCEDURE (w: Window) SetSpec* (loc: Files.Locator; name: Files.Name; conv: Converters.Converter), NEW, EXTENSIBLE;
+		VAR u: Window;
+	BEGIN
+		u := w;
+		REPEAT
+			u := u.link;
+			u.loc := loc; u.name := name$; u.conv := conv
+		UNTIL u = w
+	END SetSpec;
+
+	PROCEDURE (w: Window) Restore* (l, t, r, b: INTEGER), NEW;
+		VAR f: Views.Frame; u, pw, ph: INTEGER;
+	BEGIN
+		f := w.frame;
+		IF f # NIL THEN
+			w.port.GetSize(pw, ph); u := w.port.unit;
+			IF r > pw THEN r := pw END;
+			IF b > ph THEN b := ph END;
+			l := l * u - f.gx; t := t * u - f.gy; r := r * u - f.gx; b := b * u - f.gy;
+			(* only adds to the BlackBox region, but doesn't draw: *)
+			Views.UpdateRoot(w.frame, l, t, r, b, Views.keepFrames)	
+		END
+	END Restore;
+
+	PROCEDURE (w: Window) Update*, NEW;
+	BEGIN
+		ASSERT(w.frame # NIL, 20);
+		(* redraws the whole accumulated BlackBox region: *)
+		Views.ValidateRoot(w.frame)
+	END Update;
+
+	PROCEDURE (w: Window) GetSize*(OUT width, height: INTEGER), NEW, EXTENSIBLE;
+	BEGIN
+		w.port.GetSize(width, height)
+	END GetSize;
+	
+	PROCEDURE (w: Window) SetSize* (width, height: INTEGER), NEW, EXTENSIBLE;
+		VAR c: Containers.Controller; w0, h0: INTEGER;
+	BEGIN
+		w.port.GetSize(w0, h0);
+		w.port.SetSize(width, height);
+		IF w.frame # NIL THEN Views.AdaptRoot(w.frame) END;
+		c := w.doc.ThisController();
+		IF c.opts * {Documents.winWidth, Documents.winHeight} # {} THEN
+			w.Restore(0, 0, width, height)
+		END
+	END SetSize;
+
+	PROCEDURE (w: Window) BroadcastModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
+	BEGIN
+		IF w.frame # NIL THEN
+			Views.BroadcastModelMsg(w.frame, msg)
+		END
+	END BroadcastModelMsg;
+
+	PROCEDURE (w: Window) BroadcastViewMsg* (VAR msg: Views.Message), NEW, EXTENSIBLE;
+	BEGIN
+		IF w.frame # NIL THEN
+			Views.BroadcastViewMsg(w.frame, msg)
+		END
+	END BroadcastViewMsg;
+
+	PROCEDURE (w: Window) ForwardCtrlMsg* (VAR msg: Controllers.Message), NEW, EXTENSIBLE;
+	BEGIN
+		IF w.frame # NIL THEN
+			WITH msg: Controllers.CursorMessage DO
+				DEC(msg.x, w.frame.gx); DEC(msg.y, w.frame.gy)
+			ELSE
+			END;
+			Views.ForwardCtrlMsg(w.frame, msg)
+		END
+	END ForwardCtrlMsg;
+
+	PROCEDURE (w: Window) MouseDown* (x, y, time: INTEGER; modifiers: SET), NEW, ABSTRACT;
+
+	PROCEDURE (w: Window) KeyDown* (ch: CHAR; modifiers: SET), NEW, EXTENSIBLE;
+		VAR key: Controllers.EditMsg;
+	BEGIN
+		IF ch = 0X THEN
+			CharError
+		ELSE
+			key.op := Controllers.pasteChar; key.char := ch;
+			key.modifiers:= modifiers;
+			w.ForwardCtrlMsg(key)
+		END
+	END KeyDown;
+
+	PROCEDURE (w: Window) Close*, NEW, EXTENSIBLE;
+		VAR u: Window; f: Views.Frame; s: Sequencers.Sequencer; msg: Sequencers.RemoveMsg;
+	BEGIN
+		u := w.link; WHILE u.link # w DO u := u.link END;
+		u.link := w.link;
+		f := w.frame; s := w.seq;
+		IF ~w.sub THEN s.Notify(msg) END;
+		WITH s: StdSequencer DO
+			IF s.home = w THEN s.home := NIL END
+		ELSE
+		END;
+		w.port.SetSize(0, 0); Views.AdaptRoot(w.frame);
+		w.port := NIL; w.frame := NIL; w.doc := NIL; w.seq := NIL; w.link := NIL; w.loc := NIL;
+		f.Close
+	END Close;
+
+
+	(** Directory **)
+
+	PROCEDURE (d: Directory) NewSequencer* (): Sequencers.Sequencer, NEW;
+		VAR s: StdSequencer;
+	BEGIN
+		NEW(s); Reset(s); RETURN s
+	END NewSequencer;
+
+
+	PROCEDURE (d: Directory) First* (): Window, NEW, ABSTRACT;
+	PROCEDURE (d: Directory) Next* (w: Window): Window, NEW, ABSTRACT;
+
+	PROCEDURE (d: Directory) New* (): Window, NEW, ABSTRACT;
+	
+	PROCEDURE (d: Directory) Open* (w: Window; doc: Documents.Document;
+																		flags: SET; name: Views.Title;
+																		loc: Files.Locator; fname: Files.Name;
+																		conv: Converters.Converter),
+																		NEW, EXTENSIBLE;
+		VAR v: Views.View; c: RootContext; s: Sequencers.Sequencer; f: Views.Frame; any: ANYPTR;
+	BEGIN
+		ASSERT(w # NIL, 20); ASSERT(doc # NIL, 21); ASSERT(doc.context = NIL, 22);
+		v := doc.ThisView(); ASSERT(v # NIL, 23);
+		ASSERT(w.doc = NIL, 24); ASSERT(w.port # NIL, 25);
+		IF w.link = NIL THEN w.link := w END;	(* create new window ring *)
+		w.doc := doc; w.flags := flags;
+		IF w.seq = NIL THEN
+			ASSERT(doc.Domain() # NIL, 27);
+			any := doc.Domain().GetSequencer();
+			IF any # NIL THEN
+				ASSERT(any IS Sequencers.Sequencer, 26);
+				w.seq := any(Sequencers.Sequencer)
+			ELSE
+				w.seq := d.NewSequencer();
+				doc.Domain().SetSequencer(w.seq)
+			END			
+		END;
+		s := w.seq;
+		WITH s: StdSequencer DO
+			IF s.home = NIL THEN s.home := w END
+		ELSE
+		END;
+		NEW(c); c.win := w; doc.InitContext(c);
+		doc.GetNewFrame(f); w.frame := f(Views.RootFrame);
+		w.frame.ConnectTo(w.port);
+		Views.SetRoot(w.frame, w.doc, FALSE, w.flags);
+		w.SetSpec(loc, fname, conv)
+	END Open;
+
+	PROCEDURE (d: Directory) OpenSubWindow* (w: Window; doc: Documents.Document; flags: SET; name: Views.Title), NEW, EXTENSIBLE;
+		VAR u: Window; title: Views.Title;
+	BEGIN
+		ASSERT(w # NIL, 20); ASSERT(doc # NIL, 21);
+		u := d.First(); WHILE (u # NIL) & (u.seq # doc.Domain().GetSequencer()) DO u := d.Next(u) END;
+		IF u # NIL THEN
+			w.sub := TRUE;
+			w.link := u.link; u.link := w;
+			w.seq := u.seq; w.loc := u.loc; w.name := u.name; w.conv := u.conv;
+			u.GetTitle(title);
+			d.Open(w, doc, flags, title, u.loc, u.name, u.conv)
+		ELSE
+			d.Open(w, doc, flags, name, NIL, "", NIL)
+		END
+	END OpenSubWindow;
+
+	PROCEDURE ^ RestoreSequencer(seq: Sequencers.Sequencer);
+
+	PROCEDURE (d: Directory) Focus* (target: BOOLEAN): Window, NEW, ABSTRACT;
+	PROCEDURE (d: Directory) GetThisWindow* (p: Ports.Port; px, py: INTEGER; OUT x, y: INTEGER; OUT w: Window), NEW, ABSTRACT;
+	PROCEDURE (d: Directory) Select* (w: Window; lazy: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (d: Directory) Close* (w: Window), NEW, ABSTRACT;
+
+	PROCEDURE (d: Directory) Update* (w: Window), NEW;
+		VAR u: Window;
+	BEGIN
+		(* redraws the BlackBox region of a given window, or of all windows *)
+		u := d.First();
+		WHILE u # NIL DO
+			ASSERT(u.frame # NIL, 101);
+			IF (u = w) OR (w = NIL) THEN RestoreSequencer(u.seq) END;
+			u := d.Next(u)
+		END
+	END Update;
+	
+	PROCEDURE (d: Directory) GetBounds* (OUT w, h: INTEGER), NEW, ABSTRACT;
+
+
+	(* RootContext *)
+
+	PROCEDURE (c: RootContext) GetSize (OUT w, h: INTEGER);
+	BEGIN
+		c.win.port.GetSize(w, h);
+		w := w * c.win.port.unit; h := h * c.win.port.unit
+	END GetSize;
+
+	PROCEDURE (c: RootContext) SetSize (w, h: INTEGER);
+	END SetSize;
+	
+	PROCEDURE (c: RootContext) Normalize (): BOOLEAN;
+	BEGIN
+		RETURN TRUE
+	END Normalize;
+	
+	PROCEDURE (c: RootContext) ThisModel (): Models.Model;
+	BEGIN
+		RETURN NIL
+	END ThisModel;
+
+
+	(* sequencing utilities *)
+
+	PROCEDURE Prepend (s: Script; st: Stores.Store; IN name: Stores.OpName; op: Stores.Operation);
+		VAR e: OpElem;
+	BEGIN
+		ASSERT(op # NIL, 20);
+		NEW(e); e.st := st; e.op := op; e.name := name;
+		e.next := s.list; s.list := e
+	END Prepend;
+
+	PROCEDURE Push (VAR list, e: OpElem);
+	BEGIN
+		e.next := list; list := e
+	END Push;
+
+	PROCEDURE Pop (VAR list, e: OpElem);
+	BEGIN
+		e := list; list := list.next
+	END Pop;
+
+	PROCEDURE Reduce (VAR list: OpElem; max: INTEGER);
+		VAR e: OpElem;
+	BEGIN
+		e := list; WHILE (max > 1) & (e # NIL) DO DEC(max); e := e.next END;
+		IF e # NIL THEN e.next := NIL END
+	END Reduce;
+	
+	PROCEDURE (r: Reducer) Reduce (full: BOOLEAN);
+		VAR e: OpElem; n: INTEGER; w: Window;
+	BEGIN
+		IF dir # NIL THEN
+			w := dir.First();
+			WHILE w # NIL DO
+				IF w.seq IS StdSequencer THEN
+					IF full THEN
+						n := 1
+					ELSE
+						n := 0; e := w.seq(StdSequencer).undo;
+						WHILE e # NIL DO INC(n); e := e.next END;
+						IF n > 20 THEN n := n DIV 2 ELSE n := 10 END
+					END;
+					Reduce(w.seq(StdSequencer).undo, n)
+				END;
+				w := dir.Next(w)
+			END
+		END;
+		Kernel.InstallReducer(r)
+	END Reduce;
+
+	PROCEDURE Reset (s: StdSequencer);
+	BEGIN
+		s.trapEra := Kernel.trapCount;
+		IF (s.entryLevel # 0) OR (s.nestLevel # 0) THEN
+			s.modLevel := 0;
+			s.entryLevel := 0;
+			s.nestLevel := 0;
+			s.lastSt := NIL;
+			s.lastOp := NIL;
+			s.script := NIL;
+			s.noUndo := FALSE;
+			s.undo := NIL; s.redo := NIL;
+			s.invisibleLevel := 0;
+			s.transparentLevel := 0;
+			s.notRecordedLevel := 0
+		END
+	END Reset;
+
+	PROCEDURE Neutralize (st: Stores.Store);
+		VAR neutralize: Models.NeutralizeMsg;
+	BEGIN
+		IF st # NIL THEN	(* st = NIL for scripts *)
+			WITH st: Models.Model DO
+				Models.Broadcast(st, neutralize)
+			| st: Views.View DO
+				st.Neutralize
+			ELSE
+			END
+		END
+	END Neutralize;
+
+	PROCEDURE Do (s: StdSequencer; st: Stores.Store; op: Stores.Operation);
+	BEGIN
+		INC(s.entryLevel); s.lastSt := NIL; s.lastOp := NIL;
+		Neutralize(st); op.Do;
+		DEC(s.entryLevel)
+	END Do;
+
+	PROCEDURE AffectsDoc (s: StdSequencer; st: Stores.Store): BOOLEAN;
+		VAR v, w: Window;
+	BEGIN
+		w := s.home;
+		IF (w = NIL) OR (st = w.doc) OR (st = w.doc.ThisView()) THEN
+			RETURN TRUE
+		ELSE
+			v := w.link;
+			WHILE (v # w) & (st # v.doc) & (st # v.doc.ThisView()) DO v := v.link END;
+			RETURN v = w
+		END
+	END AffectsDoc;
+
+
+	(* Script *)
+
+	PROCEDURE (s: Script) Do;
+		VAR e, f, g: OpElem;
+	BEGIN
+		e := s.list; f := NIL;
+		REPEAT
+			Neutralize(e.st); e.op.Do;
+			g := e.next; e.next := f; f := e; e := g
+		UNTIL e = NIL;
+		s.list := f
+	END Do;
+
+
+	(* StdSequencer *)
+
+	PROCEDURE (s: StdSequencer) Handle (VAR msg: ANYREC);
+	(* send message to all windows attached to s *)
+		VAR w: Window;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		WITH msg: Models.Message DO
+			IF msg IS Models.UpdateMsg THEN
+				Properties.IncEra;
+				IF s.entryLevel = 0 THEN
+					(* updates in dominated model bypassed the sequencer *)
+					Reset(s);	(* panic reset: clear sequencer *)
+					INC(s.modLevel)	(* but leave dirty *)
+				END
+			END;
+			w := dir.First();
+			WHILE w # NIL DO
+				IF w.seq = s THEN w.BroadcastModelMsg(msg) END;
+				w := dir.Next(w)
+			END
+		| msg: Views.Message DO
+			w := dir.First();
+			WHILE w # NIL DO
+				IF w.seq = s THEN w.BroadcastViewMsg(msg) END;
+				w := dir.Next(w)
+			END
+		ELSE
+		END
+	END Handle;
+
+
+	PROCEDURE (s: StdSequencer) Dirty (): BOOLEAN;
+	BEGIN
+		RETURN s.modLevel > 0
+	END Dirty;
+
+	PROCEDURE (s: StdSequencer) SetDirty (dirty: BOOLEAN);
+	BEGIN
+		IF dirty THEN INC(s.modLevel) ELSE s.modLevel := 0 END
+	END SetDirty;
+
+	PROCEDURE (s: StdSequencer) LastOp (st: Stores.Store): Stores.Operation;
+	BEGIN
+		ASSERT(st # NIL, 20);
+		IF s.lastSt = st THEN RETURN s.lastOp ELSE RETURN NIL END
+	END LastOp;
+
+
+	PROCEDURE (s: StdSequencer) BeginScript (IN name: Stores.OpName; VAR script: Stores.Operation);
+		VAR sop: Script;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		INC(s.nestLevel);
+		IF (s.nestLevel = 1) & (s.invisibleLevel = 0) & (s.transparentLevel = 0) & (s.notRecordedLevel = 0) THEN
+			INC(s.modLevel)
+		END;
+		s.lastSt := NIL; s.lastOp := NIL;
+		NEW(sop); sop.up := s.script; sop.list := NIL; sop.level := s.nestLevel; sop.name := name;
+		s.script := sop;
+		script := sop
+	END BeginScript;
+
+	PROCEDURE (s: StdSequencer) Do (st: Stores.Store; IN name: Stores.OpName; op: Stores.Operation);
+		VAR e: OpElem;
+	BEGIN
+		ASSERT(st # NIL, 20); ASSERT(op # NIL, 21);
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		Do(s, st, op);
+		IF s.noUndo THEN	(* cannot undo: unbalanced BeginModification pending *)
+			s.lastSt := NIL; s.lastOp := NIL
+		ELSIF (s.entryLevel = 0)	(* don't record when called from within op.Do *)
+		& AffectsDoc(s, st) THEN	(* don't record when Do affected child window only *)
+			s.lastSt := st; s.lastOp := op;
+			s.redo := NIL;	(* clear redo stack *)
+			IF s.script # NIL THEN
+				Prepend(s.script, st, name, op)
+			ELSE
+				IF (s.invisibleLevel = 0) & (s.transparentLevel = 0) & (s.notRecordedLevel = 0) THEN INC(s.modLevel) END;
+				NEW(e); e.st := st; e.op := op; e.name := name;
+				e.invisible := s.invisibleLevel > 0; e.transparent := s.transparentLevel > 0;
+				IF (s.notRecordedLevel=0) THEN Push(s.undo, e) END
+			END
+		END
+	END Do;
+
+	PROCEDURE (s: StdSequencer) Bunch (st: Stores.Store);
+		VAR lastOp: Stores.Operation;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		ASSERT(st # NIL, 20); ASSERT(st = s.lastSt, 21);
+		lastOp := s.lastOp;
+		Do(s, st, lastOp);
+		IF s.noUndo THEN
+			s.lastSt := NIL; s.lastOp := NIL
+		ELSIF (s.entryLevel = 0)	(* don't record when called from within op.Do *)
+		& AffectsDoc(s, st) THEN	(* don't record when Do affected child window only *)
+			s.lastSt := st; s.lastOp := lastOp
+		END
+	END Bunch;
+
+	PROCEDURE (s: StdSequencer) EndScript (script: Stores.Operation);
+		VAR e: OpElem;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		ASSERT(script # NIL, 20); ASSERT(s.script = script, 21);
+		WITH script: Script DO
+			ASSERT(s.nestLevel = script.level, 22);
+			s.script := script.up;
+			IF s.entryLevel = 0 THEN	(* don't record when called from within op.Do *)
+				IF script.list # NIL THEN
+					IF s.script # NIL THEN
+						Prepend(s.script, NIL, script.name, script)
+					ELSE	(* outermost scripting level *)
+						s.redo := NIL;	(* clear redo stack *)
+						IF ~s.noUndo THEN
+							NEW(e); e.st := NIL; e.op := script; e.name := script.name;
+							e.invisible := s.invisibleLevel > 0; e.transparent := s.transparentLevel > 0;
+							IF s.notRecordedLevel=0 THEN Push(s.undo, e) END
+						END;
+						s.lastSt := NIL; s.lastOp := NIL
+					END
+				ELSE
+					IF (s.script = NIL) & (s.modLevel > 0) & (s.invisibleLevel = 0) & (s.transparentLevel = 0) THEN 
+						DEC(s.modLevel)
+					END
+				END
+			END
+		END;
+		DEC(s.nestLevel);
+		IF s.nestLevel = 0 THEN ASSERT(s.script = NIL, 22); s.noUndo := FALSE END
+	END EndScript;
+
+	PROCEDURE (s: StdSequencer) StopBunching;
+	BEGIN
+		s.lastSt := NIL; s.lastOp := NIL
+	END StopBunching;
+
+	PROCEDURE (s: StdSequencer) BeginModification (type: INTEGER; st: Stores.Store);
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		IF s.nestLevel < LEN(s.modStack) THEN s.modStack[s.nestLevel].store := st; s.modStack[s.nestLevel].type := type END;
+		INC(s.nestLevel);
+		IF type = Sequencers.notUndoable THEN
+			INC(s.modLevel);	(* unbalanced! *)
+			s.noUndo := TRUE; s.undo := NIL; s.redo := NIL;
+			s.lastSt := NIL; s.lastOp := NIL;
+			INC(s.entryLevel)	(* virtual entry of modification "operation" *)
+		ELSIF type = Sequencers.invisible THEN
+			INC(s.invisibleLevel)
+		ELSIF type = Sequencers.clean THEN
+			INC(s.transparentLevel)
+		ELSIF type = notRecorded THEN
+			INC(s.notRecordedLevel)
+		END
+	END BeginModification;
+
+	PROCEDURE (s: StdSequencer) EndModification (type: INTEGER; st: Stores.Store);
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		ASSERT(s.nestLevel > 0, 20);
+		IF s.nestLevel <= LEN(s.modStack) THEN
+			ASSERT((s.modStack[s.nestLevel - 1].store = st) & (s.modStack[s.nestLevel - 1].type = type), 21)
+		END;
+		DEC(s.nestLevel);
+		IF type = Sequencers.notUndoable THEN
+			DEC(s.entryLevel)
+		ELSIF type = Sequencers.invisible THEN
+			DEC(s.invisibleLevel)
+		ELSIF type = Sequencers.clean THEN
+			DEC(s.transparentLevel)
+		ELSIF type = notRecorded THEN
+			DEC(s.notRecordedLevel)
+		END;
+		IF s.nestLevel = 0 THEN ASSERT(s.script = NIL, 22); s.noUndo := FALSE END
+	END EndModification;
+
+	PROCEDURE (s: StdSequencer) CanUndo (): BOOLEAN;
+		VAR op: OpElem;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		op := s.undo;
+		WHILE (op # NIL) & op.invisible DO op := op.next END;
+		RETURN op # NIL
+	END CanUndo;
+
+	PROCEDURE (s: StdSequencer) CanRedo (): BOOLEAN;
+		VAR op: OpElem;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		op := s.redo;
+		WHILE (op # NIL) & op.invisible DO op := op.next END;
+		RETURN op # NIL
+	END CanRedo;
+
+	PROCEDURE (s: StdSequencer) GetUndoName (VAR name: Stores.OpName);
+		VAR op: OpElem;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		op := s.undo;
+		WHILE (op # NIL) & op.invisible DO op := op.next END;
+		IF op # NIL THEN name := op.name$ ELSE name[0] := 0X END
+	END GetUndoName;
+
+	PROCEDURE (s: StdSequencer) GetRedoName (VAR name: Stores.OpName);
+		VAR op: OpElem;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		op := s.redo;
+		WHILE (op # NIL) & op.invisible DO op := op.next END;
+		IF op # NIL THEN name := op.name$ ELSE name[0] := 0X END
+	END GetRedoName;
+
+	PROCEDURE (s: StdSequencer) Undo;
+		VAR e: OpElem;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		IF s.undo # NIL THEN
+			REPEAT
+				Pop(s.undo, e); Do(s, e.st, e.op); Push(s.redo, e)
+			UNTIL ~e.invisible OR (s.undo = NIL);
+			IF ~e.transparent THEN
+				IF s.modLevel > 0 THEN DEC(s.modLevel) END
+			END
+		END
+	END Undo;
+
+	PROCEDURE (s: StdSequencer) Redo;
+		VAR e: OpElem;
+	BEGIN
+		IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+		IF s.redo # NIL THEN
+			Pop(s.redo, e); Do(s, e.st, e.op); Push(s.undo, e);
+			WHILE (s.redo # NIL) & s.redo.invisible DO
+				Pop(s.redo, e); Do(s, e.st, e.op); Push(s.undo, e)
+			END;
+			IF ~e.transparent THEN
+				INC(s.modLevel)
+			END
+		END
+	END Redo;
+
+
+	(* Forwarder *)
+
+	PROCEDURE (f: Forwarder) Forward (target: BOOLEAN; VAR msg: Controllers.Message);
+		VAR w: Window;
+	BEGIN
+		w := dir.Focus(target);
+		IF w # NIL THEN w.ForwardCtrlMsg(msg) END
+	END Forward;
+
+	PROCEDURE (f: Forwarder) Transfer (VAR msg: Controllers.TransferMessage);
+		VAR w: Window; h: Views.Frame; p: Ports.Port; sx, sy, tx, ty, pw, ph: INTEGER;
+	BEGIN
+		h := msg.source; p := h.rider.Base();
+		(* (msg.x, msg.y) is point in local coordinates of source frame *)
+		sx := (msg.x + h.gx) DIV h.unit;
+		sy := (msg.y + h.gy) DIV h.unit;
+		(* (sx, sy) is point in global coordinates of source port *)
+		dir.GetThisWindow(p, sx, sy, tx, ty, w);
+		IF w # NIL THEN
+			(* (tx, ty) is point in global coordinates of target port *)
+			w.port.GetSize(pw, ph);
+			msg.x := tx * w.port.unit;
+			msg.y := ty * w.port.unit;
+			(* (msg.x, msg.y) is point in coordinates of target window *)
+			w.ForwardCtrlMsg(msg)
+		END
+	END Transfer;
+
+
+	(** miscellaneous **)
+
+	PROCEDURE SetDir* (d: Directory);
+	BEGIN
+		ASSERT(d # NIL, 20);
+		IF stdDir = NIL THEN stdDir := d END;
+		dir := d
+	END SetDir;
+
+	PROCEDURE SelectBySpec* (loc: Files.Locator; name: Files.Name; conv: Converters.Converter; VAR done: BOOLEAN);
+		VAR w: Window;
+	BEGIN
+		Kernel.MakeFileName(name, "");
+		w := dir.First();
+		WHILE (w # NIL) & ((loc = NIL) OR (w.loc = NIL) OR (loc.res = 77) OR  (w.loc.res = 77) OR
+										 (name = "") OR (w.name = "") OR
+										~Files.dir.SameFile(loc, name, w.loc, w.name) OR (w.conv # conv)) DO
+			w := dir.Next(w)
+		END;
+		IF w # NIL THEN dir.Select(w, lazy); done := TRUE ELSE done := FALSE END
+	END SelectBySpec;
+
+	PROCEDURE SelectByTitle* (v: Views.View; flags: SET; title: Views.Title; VAR done: BOOLEAN);
+		VAR w: Window; t: Views.Title; n1, n2: ARRAY 64 OF CHAR;
+	BEGIN
+		done := FALSE;
+		IF v # NIL THEN
+			IF v IS Documents.Document THEN v := v(Documents.Document).ThisView() END;
+			Services.GetTypeName(v, n1)
+		ELSE n1 := ""
+		END;
+		w := dir.First();
+		WHILE w # NIL DO
+			IF ((w.flags / flags) * {isAux, isTool} = {}) & ~(allowDuplicates IN w.flags) THEN
+				w.GetTitle(t);
+				IF t = title THEN
+					Services.GetTypeName(w.doc.ThisView(), n2);
+					IF (n1 = "") OR (n1 = n2) THEN dir.Select(w, lazy); done := TRUE; RETURN END
+				END
+			END;
+			w := dir.Next(w)
+		END
+	END SelectByTitle;
+
+
+	PROCEDURE (h: Hook) Omnicast (VAR msg: ANYREC);
+		VAR w: Window;
+	BEGIN
+		w := dir.First();
+		WHILE w # NIL DO
+			IF ~w.sub THEN w.seq.Handle(msg) END;
+			w := dir.Next(w)
+		END
+	END Omnicast;
+
+	PROCEDURE RestoreSequencer (seq: Sequencers.Sequencer);
+		VAR w: Window;
+	BEGIN
+		w := dir.First();
+		WHILE w # NIL DO
+			ASSERT(w.frame # NIL, 100);
+			IF (seq = NIL) OR (w.seq = seq) THEN
+				w.Update	(* causes redrawing of BlackBox region *)
+			END;
+			w := dir.Next(w)
+		END
+	END RestoreSequencer;
+
+	PROCEDURE (h: Hook) RestoreDomain (d: Stores.Domain);
+		VAR seq: ANYPTR;
+	BEGIN
+		IF d = NIL THEN
+			RestoreSequencer(NIL)
+		ELSE
+			seq := d.GetSequencer();
+			IF seq # NIL THEN
+				RestoreSequencer (seq(Sequencers.Sequencer))
+			END
+		END
+	END RestoreDomain;
+
+
+	(* SequencerDirectory *)
+	
+	PROCEDURE (d: SequencerDirectory) New (): Sequencers.Sequencer;
+	BEGIN
+		RETURN dir.NewSequencer()
+	END New;
+
+	(** CheckAction **)
+	
+	PROCEDURE (a: CheckAction) Do;
+		VAR w: Window; s: StdSequencer;
+	BEGIN
+		Services.DoLater(a.wait, Services.resolution);
+		w := dir.First();
+		WHILE w # NIL DO
+			s := w.seq(StdSequencer);
+			IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
+			ASSERT(s.nestLevel = 0, 100);
+			(* unbalanced calls of Views.BeginModification/EndModification or Views.BeginScript/EndScript *)
+			w := dir.Next(w)
+		END
+	END Do;
+	
+	PROCEDURE (a: WaitAction) Do;
+	BEGIN
+		Services.DoLater(a.check, Services.immediately)
+	END Do;
+
+
+	PROCEDURE (n: LangNotifier) Notify;
+		VAR w: Window; pw, ph: INTEGER;
+	BEGIN
+		w := dir.First();
+		WHILE w # NIL DO
+			w.port.GetSize(pw, ph);
+			w.Restore(0, 0, pw, ph);
+			w.RefreshTitle;
+			w := dir.Next(w)
+		END
+	END Notify;
+	
+	PROCEDURE Init;
+		VAR f: Forwarder; r: Reducer; sdir: SequencerDirectory;
+			a: CheckAction; w: WaitAction; h: Hook;  ln: LangNotifier;
+	BEGIN
+		NEW(sdir); Sequencers.SetDir(sdir);
+		NEW(h); Views.SetMsgHook(h);
+		NEW(f); Controllers.Register(f);
+		NEW(r); Kernel.InstallReducer(r);
+		NEW(a); NEW(w); a.wait := w; w.check := a; Services.DoLater(a, Services.immediately);
+		NEW(ln); Dialog.RegisterLangNotifier(ln)
+	END Init;
+
+BEGIN
+	Init
+END Windows.

BlackBox/build

@@ -4,18 +4,40 @@
 LindevCompiler.Compile('Lin/Mod', 'Obsd.Dl.txt')
 LindevCompiler.Compile('Lin/Mod', 'Obsd.Libc.txt')
 LindevCompiler.Compile('Lin/Mod', 'Obsd.linKernel.txt')
+
 LindevCompiler.Compile('System/Mod', 'Files.txt')
 LindevCompiler.Compile('System/Mod', 'Dialog.txt')
 LindevCompiler.Compile('System/Mod', 'Math.txt')
 LindevCompiler.Compile('System/Mod', 'Strings.txt')
-LindevCompiler.Compile('Lin/Mod', 'Obsd.linHostFiles.txt')
 LindevCompiler.Compile('System/Mod', 'Meta.txt')
+
+LindevCompiler.Compile('System/Mod', 'Stores.txt')
+LindevCompiler.Compile('System/Mod', 'Converters.txt')
+LindevCompiler.Compile('System/Mod', 'Dates.txt')
+LindevCompiler.Compile('System/Mod', 'Integers.txt')
+LindevCompiler.Compile('System/Mod', 'Sequencers.txt')
+LindevCompiler.Compile('System/Mod', 'Services.txt')
+LindevCompiler.Compile('System/Mod', 'Log.txt')
+LindevCompiler.Compile('System/Mod', 'SMath.txt')
+
+LindevCompiler.Compile('System/Mod', 'Fonts.txt')
+LindevCompiler.Compile('System/Mod', 'Ports.txt')
+LindevCompiler.Compile('System/Mod', 'Printers.txt')
+LindevCompiler.Compile('System/Mod', 'Models.txt')
+LindevCompiler.Compile('System/Mod', 'Views.txt')
+LindevCompiler.Compile('System/Mod', 'Printing.txt')
+LindevCompiler.Compile('System/Mod', 'Mechanisms.txt')
+LindevCompiler.Compile('System/Mod', 'Controllers.txt')
+LindevCompiler.Compile('System/Mod', 'Properties.txt')
+LindevCompiler.Compile('System/Mod', 'Containers.txt')
+LindevCompiler.Compile('System/Mod', 'Documents.txt')
+LindevCompiler.Compile('System/Mod', 'Windows.txt')
+
+LindevCompiler.Compile('Lin/Mod', 'Obsd.linHostFiles.txt')
 LindevCompiler.Compile('Std/Mod', 'Loader.txt')
 LindevCompiler.Compile('System/Mod', 'Console.txt')
 LindevCompiler.Compile('Lin/Mod', 'Console.txt')
 LindevCompiler.Compile('Lin/Mod', 'Kernel_so_init.txt')
-LindevCompiler.Compile('', 'Views.txt')
-LindevCompiler.Compile('Std/Mod', 'Interpreter.txt')
 
 LindevCompiler.Compile('Lindev/Mod', 'CPM.txt')
 LindevCompiler.Compile('Lindev/Mod', 'CPT.txt')
@@ -31,11 +53,21 @@ LindevCompiler.Compile('Lindev/Mod', 'CPV486.txt')
 LindevCompiler.Compile('', 'LindevCompiler.txt')
 LindevCompiler.Compile('', 'LindevElfLinker16.txt')
 
+### simple dev interpreter (include LindevCompiler and LindevElfLinker)
+
+LindevCompiler.Compile('', 'Views.txt')
+LindevCompiler.Compile('Std/Mod', 'Interpreter.txt')
+
 LindevCompiler.Compile('', 'Interp.txt')
 LindevCompiler.Compile('', 'Init-Interp.txt')
 
-LindevElfLinker.LinkDll('libBB.so := Kernel+ Files HostFiles StdLoader')
-
 # LindevElfLinker.LinkDll('libBBInterp.so := Kernel+ Kernel_so_init# Console Math Strings LinConsole Files HostFiles LindevCPM LindevCPT LindevCPS LindevCPH LindevCPB LindevCPP LindevCPE LindevCPL486 LindevCPC486 LindevCPV486 LindevCompiler LindevElfLinker Dialog Meta Views StdInterpreter Interp#')
 LindevElfLinker.LinkDll('libBBInterp.so := Kernel+ Console Math Strings LinConsole Files HostFiles LindevCPM LindevCPT LindevCPS LindevCPH LindevCPB LindevCPP LindevCPE LindevCPL486 LindevCPC486 LindevCPV486 LindevCompiler LindevElfLinker Dialog Meta Views StdInterpreter Interp#')
+
+### BlackBox
+
+LindevCompiler.Compile('System/Mod', 'Views.txt')
+LindevCompiler.Compile('Std/Mod', 'Interpreter.txt')
+
+LindevElfLinker.LinkDll('libBB.so := Kernel+ Files HostFiles StdLoader')
 DATA