-
Notifications
You must be signed in to change notification settings - Fork 2
/
Wrappers.cp
118 lines (99 loc) · 3.54 KB
/
Wrappers.cp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
MODULE ObxWrappers;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT Dialog, Stores, Models, Views, Controllers, Properties, StdLog;
CONST minVersion = 2; maxVersion = 2;
TYPE
View = POINTER TO RECORD (Views.View)
inner: Views.View (* v # NIL *)
END;
PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
VAR version: INTEGER;
BEGIN
rd.ReadVersion(minVersion, maxVersion, version);
IF ~rd.cancelled THEN
Views.ReadView(rd, v.inner) (* generate Views.Alien if necessary *)
END
END Internalize;
PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
BEGIN
wr.WriteVersion(maxVersion);
Views.WriteView(wr, v.inner) (* handle Views.Alien if necessary *)
END Externalize;
PROCEDURE (v: View) CopyFromModelView (source: Views.View; model: Models.Model);
BEGIN
WITH source: View DO
IF model = NIL THEN
v.inner := Views.CopyOf(source.inner, Views.deep)
ELSE
v.inner := Views.CopyWithNewModel(source.inner, model)
END
END
END CopyFromModelView;
PROCEDURE (v: View) ThisModel (): Models.Model;
BEGIN
RETURN v.inner.ThisModel()
END ThisModel;
PROCEDURE (v: View) InitContext (context: Models.Context);
BEGIN
v.InitContext^(context);
v.inner.InitContext(context) (* wrapper and wrapped view share the same context *)
END InitContext;
PROCEDURE (v: View) Neutralize;
BEGIN
v.inner.Neutralize
END Neutralize;
(* GetNewFrame: wrapper uses standard frame *)
(* GetBackground: wrapper has no intrinsic background color *)
PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
BEGIN
Views.InstallFrame(f, v.inner, 0, 0, 0, TRUE) (* create and install wrapped view's frame *)
END Restore;
(* RestoreMarks: wrapper has no intrinsic marks, wrapped view's RestoreMarks is called by framework *)
(* HandleModelMsg: framework performs message propagation *)
(* HandleViewMsg: framework performs message propagation *)
PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
BEGIN
(* here comes the behavior which is specific to this wrapper -
it modifies the wrapped view's behavior *)
WITH msg: Controllers.EditMsg DO
(* sample special behavior: copy typing into log *)
IF msg.op = Controllers.pasteChar THEN StdLog.Char(msg.char); StdLog.Ln END
ELSE
END;
focus := v.inner (* forward all controller messages to wrapped view *)
END HandleCtrlMsg;
PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
BEGIN
Views.HandlePropMsg(v.inner, msg) (* forward all property messages to wrapped view *)
END HandlePropMsg;
PROCEDURE Wrap*;
VAR poll: Controllers.PollOpsMsg; w: View; replace: Controllers.ReplaceViewMsg;
BEGIN
Controllers.PollOps(poll);
IF (poll.singleton # NIL) & ~(poll.singleton IS View) THEN
NEW(w); w.inner := poll.singleton; Stores.Join(w, w.inner);
replace.old := poll.singleton; replace.new := w;
Controllers.Forward(replace)
ELSE Dialog.Beep
END
END Wrap;
PROCEDURE Unwrap*;
VAR poll: Controllers.PollOpsMsg; replace: Controllers.ReplaceViewMsg;
BEGIN
Controllers.PollOps(poll);
IF (poll.singleton # NIL) & (poll.singleton IS View) THEN
replace.old := poll.singleton; replace.new := poll.singleton(View).inner;
Controllers.Forward(replace)
ELSE Dialog.Beep
END
END Unwrap;
END ObxWrappers.