1 MODULE Controls;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Controls.odc *)
4 (* DO NOT EDIT *)
6 IMPORT
7 Kernel, Dates, Dialog, Meta, Services, Stores, Views, Properties,
8 Strings, Fonts, Ports, Controllers, Windows, StdCFrames;
10 CONST
11 (** elements of Property.valid **)
12 opt0* = 0; opt1* = 1; opt2* = 2; opt3* = 3; opt4* = 4;
13 link* = 5; label* = 6; guard* = 7; notifier* = 8; level* = 9;
15 default* = opt0; cancel* = opt1;
16 left* = opt0; right* = opt1; multiLine* = opt2; password* = opt3;
17 sorted* = opt0;
18 haslines* = opt1; hasbuttons* = opt2; atroot* = opt3; foldericons* = opt4;
20 minVersion = 0; maxBaseVersion = 4;
21 pbVersion = 0; cbVersion = 0; rbVersion = 0; fldVersion = 0;
22 dfldVersion = 0; tfldVersion = 0; cfldVersion = 0;
23 lbxVersion = 0; sbxVersion = 0; cbxVersion = 0; capVersion = 1; grpVersion = 0;
24 tfVersion = 0;
26 rdel = 07X; ldel = 08X; tab = 09X; ltab = 0AX; lineChar = 0DX; esc = 01BX;
27 arrowLeft = 1CX; arrowRight = 1DX; arrowUp = 1EX; arrowDown = 1FX;
29 update = 2; (* notify options *)
30 listUpdate = 3;
31 guardCheck = 4;
32 flushCaches = 5; (* re-map labels for flushed string resources, after a language change *)
34 maxAdr = 8;
36 TYPE
37 Prop* = POINTER TO RECORD (Properties.Property)
38 opt*: ARRAY 5 OF BOOLEAN;
39 link*: Dialog.String;
40 label*: Dialog.String;
41 guard*: Dialog.String;
42 notifier*: Dialog.String;
43 level*: INTEGER
44 END;
46 Directory* = POINTER TO ABSTRACT RECORD END;
48 Control* = POINTER TO ABSTRACT RECORD (Views.View)
49 item-: Meta.Item;
50 disabled-, undef-, readOnly-, customFont-: BOOLEAN;
51 font-: Fonts.Font;
52 label-: Dialog.String;
53 prop-: Prop;
54 adr: ARRAY maxAdr OF INTEGER;
55 num: INTEGER;
56 stamp: INTEGER;
57 shortcut: CHAR;
58 guardErr, notifyErr: BOOLEAN
59 END;
61 DefaultsPref* = RECORD (Properties.Preference)
62 disabled*: BOOLEAN; (** OUT, preset to ~c.item.Valid() *)
63 undef*: BOOLEAN; (** OUT, preset to FALSE *)
64 readOnly*: BOOLEAN (** OUT, preset to c.item.vis = readOnly *)
65 END;
67 PropPref* = RECORD (Properties.Preference)
68 valid*: SET (** OUT, preset to {link, label, guard, notifier, customFont} *)
69 END;
71 PushButton = POINTER TO RECORD (Control) END;
73 CheckBox = POINTER TO RECORD (Control) END;
75 RadioButton = POINTER TO RECORD (Control) END;
77 Field = POINTER TO RECORD (Control)
78 maxLen: INTEGER
79 END;
81 UpDownField = POINTER TO RECORD (Control)
82 min, max, inc: INTEGER
83 END;
85 DateField = POINTER TO RECORD (Control)
86 selection: INTEGER (* 0: no selection, 1..n-1: this part selected, -1: part n selected *)
87 END;
89 TimeField = POINTER TO RECORD (Control)
90 selection: INTEGER
91 END;
93 ColorField = POINTER TO RECORD (Control) END;
95 ListBox = POINTER TO RECORD (Control) END;
97 SelectionBox = POINTER TO RECORD (Control) END;
99 ComboBox = POINTER TO RECORD (Control) END;
101 Caption = POINTER TO RECORD (Control) END;
103 Group = POINTER TO RECORD (Control) END;
105 TreeControl = POINTER TO RECORD (Control) END;
107 StdDirectory = POINTER TO RECORD (Directory) END;
109 Op = POINTER TO RECORD (Stores.Operation)
110 ctrl: Control;
111 prop: Prop
112 END;
114 FontOp = POINTER TO RECORD (Stores.Operation)
115 ctrl: Control;
116 font: Fonts.Font;
117 custom: BOOLEAN
118 END;
120 NotifyMsg = RECORD (Views.NotifyMsg)
121 frame: Views.Frame;
122 op, from, to: INTEGER
123 END;
125 UpdateCachesMsg = RECORD (Views.UpdateCachesMsg) END;
127 SelectPtr = POINTER TO Dialog.Selection;
129 ProcValue = RECORD (Meta.Value) p*: PROCEDURE END;
130 SelectValue = RECORD (Meta.Value) p*: SelectPtr END;
131 GuardProcVal = RECORD (Meta.Value) p*: Dialog.GuardProc END;
132 NotifyProcValOld = RECORD (Meta.Value) p*: PROCEDURE (op, from, to: INTEGER) END;
133 GuardProcPVal = RECORD (Meta.Value) p*: PROCEDURE(n: INTEGER; VAR p: Dialog.Par) END;
134 NotifyProcPVal = RECORD (Meta.Value) p*: PROCEDURE(n, op, f, t: INTEGER) END;
136 Param = RECORD from, to, i: INTEGER; n: Dialog.String END;
138 TVParam = RECORD l: INTEGER; e: BOOLEAN; nodeIn, nodeOut: Dialog.TreeNode END;
140 Action = POINTER TO RECORD (Services.Action)
141 w: Windows.Window;
142 resolution, cnt: INTEGER
143 END;
145 TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
147 VAR
148 dir-, stdDir-: Directory;
149 par-: Control;
150 stamp: INTEGER;
151 action: Action;
152 cleaner: TrapCleaner;
153 cleanerInstalled: INTEGER;
156 (** Cleaner **)
158 PROCEDURE (c: TrapCleaner) Cleanup;
159 BEGIN
160 par := NIL;
161 cleanerInstalled := 0
162 END Cleanup;
165 PROCEDURE (c: Control) Update- (f: Views.Frame; op, from, to: INTEGER), NEW, EMPTY;
166 PROCEDURE (c: Control) UpdateList- (f: Views.Frame), NEW, EMPTY;
167 PROCEDURE (c: Control) CheckLink- (VAR ok: BOOLEAN), NEW, EMPTY;
168 PROCEDURE (c: Control) HandlePropMsg2- (VAR p: Views.PropMessage), NEW, EMPTY;
169 PROCEDURE (c: Control) HandleViewMsg2- (f: Views.Frame; VAR msg: Views.Message), NEW, EMPTY;
170 PROCEDURE (c: Control) HandleCtrlMsg2- (f: Views.Frame; VAR msg: Views.CtrlMessage;
171 VAR focus: Views.View), NEW, EMPTY;
172 PROCEDURE (c: Control) Externalize2- (VAR wr: Stores.Writer), NEW, EMPTY;
173 PROCEDURE (c: Control) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
176 (* auxiliary procedures *)
178 PROCEDURE IsShortcut (ch: CHAR; c: Control): BOOLEAN;
179 BEGIN
180 IF (ch >= "a") & (ch <= "z") OR (ch >= 0E0X) THEN ch := CAP(ch) END;
181 RETURN ch = c.shortcut
182 END IsShortcut;
184 PROCEDURE ExtractShortcut (c: Control);
185 VAR label: Dialog.String; i: INTEGER; ch, sCh: CHAR;
186 BEGIN
187 Dialog.MapString(c.label, label);
188 i := 0; ch := label[0]; sCh := "&";
189 WHILE sCh = "&" DO
190 WHILE (ch # 0X) & (ch # "&") DO INC(i); ch := label[i] END;
191 IF ch = 0X THEN sCh := 0X
192 ELSE INC(i); sCh := label[i]; INC(i); ch := label[i]
193 END
194 END;
195 IF (sCh >= "a") & (sCh <= "z") OR (sCh >= 0E0X) THEN sCh := CAP(sCh) END;
196 c.shortcut := sCh
197 END ExtractShortcut;
199 PROCEDURE GetGuardProc (name: ARRAY OF CHAR; VAR i: Meta.Item; VAR err: BOOLEAN;
200 VAR par: BOOLEAN; VAR n: INTEGER);
201 VAR j, k, e: INTEGER; num: ARRAY 32 OF CHAR;
202 BEGIN
203 j := 0;
204 WHILE (name[j] # 0X) & (name[j] # "(") DO INC(j) END;
205 IF name[j] = "(" THEN
206 INC(j); k := 0;
207 WHILE (name[j] # 0X) & (name[j] # ")") DO num[k] := name[j]; INC(j); INC(k) END;
208 IF (name[j] = ")") & (name[j+1] = 0X) THEN
209 num[k] := 0X; Strings.StringToInt(num, n, e);
210 IF e = 0 THEN
211 name[j - k - 1] := 0X;
212 Meta.LookupPath(name, i); par := TRUE
213 ELSE
214 IF ~err THEN
215 Dialog.ShowParamMsg("#System:SyntaxErrorIn", name, "", "");
216 err := TRUE
217 END;
218 Meta.Lookup("", i);
219 RETURN
220 END
221 ELSE
222 IF ~err THEN
223 Dialog.ShowParamMsg("#System:SyntaxErrorIn", name, "", "");
224 err := TRUE
225 END;
226 Meta.Lookup("", i);
227 RETURN
228 END
229 ELSE
230 Meta.LookupPath(name, i); par := FALSE
231 END;
232 IF (i.obj = Meta.procObj) OR (i.obj = Meta.varObj) & (i.typ = Meta.procTyp) THEN (*ok *)
233 ELSE
234 IF ~err THEN
235 IF i.obj = Meta.undef THEN
236 Dialog.ShowParamMsg("#System:NotFound", name, "", "")
237 ELSE
238 Dialog.ShowParamMsg("#System:HasWrongType", name, "", "")
239 END;
240 err := TRUE
241 END;
242 Meta.Lookup("", i)
243 END
244 END GetGuardProc;
246 PROCEDURE CallGuard (c: Control);
247 VAR ok, up: BOOLEAN; n: INTEGER; dpar: Dialog.Par; p: Control;
248 v: GuardProcVal; vp: GuardProcPVal; i: Meta.Item; pref: DefaultsPref;
249 BEGIN
250 Controllers.SetCurrentPath(Controllers.targetPath);
251 pref.disabled := ~c.item.Valid();
252 pref.undef := FALSE;
253 pref.readOnly := c.item.vis = Meta.readOnly;
254 Views.HandlePropMsg(c, pref);
255 c.disabled := pref.disabled;
256 c.undef := pref.undef;
257 c.readOnly := pref.readOnly;
258 c.label := c.prop.label$;
259 IF ~c.disabled & (c.prop.guard # "") & ~c.guardErr THEN
260 IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
261 INC(cleanerInstalled);
262 p := par; par := c;
263 dpar.disabled := FALSE; dpar.undef := FALSE;
264 dpar.readOnly := c.readOnly;
265 dpar.checked := FALSE; dpar.label := c.label$;
266 GetGuardProc(c.prop.guard, i, c.guardErr, up, n);
267 IF i.obj # Meta.undef THEN
268 IF up THEN (* call with numeric parameter *)
269 i.GetVal(vp, ok);
270 IF ok THEN vp.p(n, dpar) END
271 ELSE
272 i.GetVal(v, ok);
273 IF ok THEN v.p(dpar) END
274 END;
275 IF ok THEN
276 c.disabled := dpar.disabled;
277 c.undef := dpar.undef;
278 IF dpar.readOnly THEN c.readOnly := TRUE END;
279 IF dpar.label # c.label THEN c.label := dpar.label END
280 ELSIF ~c.guardErr THEN
281 Dialog.ShowParamMsg("#System:HasWrongType", c.prop.guard, "", "");
282 c.guardErr := TRUE
283 END
284 END;
285 par := p;
286 DEC(cleanerInstalled);
287 IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
288 END;
289 ExtractShortcut(c);
290 Controllers.ResetCurrentPath()
291 END CallGuard;
293 PROCEDURE CallNotifier (c: Control; op, from, to: INTEGER);
294 VAR ok, up: BOOLEAN; n: INTEGER; vold: NotifyProcValOld; vp: NotifyProcPVal;
295 i: Meta.Item; p: Control;
296 BEGIN
297 IF c.prop.notifier # "" THEN
298 IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
299 INC(cleanerInstalled);
300 p := par; par := c;
301 IF c.prop.notifier[0] = "!" THEN
302 IF op = Dialog.pressed THEN
303 c.prop.notifier[0] := " ";
304 Dialog.ShowStatus(c.prop.notifier);
305 c.prop.notifier[0] := "!"
306 ELSIF op = Dialog.released THEN
307 Dialog.ShowStatus("")
308 END
309 ELSE
310 GetGuardProc(c.prop.notifier, i, c.notifyErr, up, n);
311 IF i.obj # Meta.undef THEN
312 IF up THEN (* call with numeric parameter *)
313 i.GetVal(vp, ok);
314 IF ok THEN vp.p(n, op, from, to) END
315 ELSE
316 i.GetVal(vold, ok);
317 IF ok THEN vold.p(op, from, to) END
318 END;
319 IF ~ok & ~c.notifyErr THEN
320 Dialog.ShowParamMsg("#System:HasWrongType", c.prop.notifier, "", "");
321 c.notifyErr := TRUE
322 END
323 END
324 END;
325 par := p;
326 DEC(cleanerInstalled);
327 IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
328 END
329 END CallNotifier;
331 PROCEDURE DCHint (modifiers: SET): INTEGER;
332 BEGIN
333 IF Controllers.doubleClick IN modifiers THEN RETURN 1
334 ELSE RETURN 0
335 END
336 END DCHint;
338 PROCEDURE Notify* (c: Control; f: Views.Frame; op, from, to: INTEGER);
339 VAR msg: NotifyMsg;
340 BEGIN
341 IF ~c.readOnly & ~ c.disabled THEN
342 CallNotifier(c, op, from, to);
343 IF op >= Dialog.changed THEN
344 msg.id0 := c.item.adr; msg.id1 := msg.id0 + c.item.Size(); msg.frame := f;
345 msg.op := op; msg.from := from; msg.to := to;
346 msg.opts := {update, guardCheck};
347 Views.Omnicast(msg)
348 END
349 END
350 END Notify;
352 PROCEDURE NotifyFlushCaches*;
353 VAR msg: NotifyMsg;
354 BEGIN
355 msg.opts := {flushCaches}; msg.id0 := 0; msg.id1 := 0;
356 Views.Omnicast(msg)
357 END NotifyFlushCaches;
359 PROCEDURE GetName (VAR path, name: ARRAY OF CHAR; VAR i: INTEGER);
360 VAR j: INTEGER; ch: CHAR;
361 BEGIN
362 j := 0; ch := path[i];
363 WHILE (j < LEN(name) - 1) & ((ch >= "0") & (ch <= "9") OR (CAP(ch) >= "A") & (CAP(ch) <= "Z")
364 OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_")) DO
365 name[j] := ch; INC(i); INC(j); ch := path[i]
366 END;
367 IF (ch = 0X) OR (ch = ".") OR (ch = "[") OR (ch = "^") THEN name[j] := 0X
368 ELSE name[0] := 0X
369 END
370 END GetName;
372 PROCEDURE LookupPath (path: ARRAY OF CHAR; VAR i: Meta.Item;
373 VAR adr: ARRAY OF INTEGER; VAR num: INTEGER);
374 VAR j, n: INTEGER; name: Meta.Name; ch: CHAR;
375 BEGIN
376 path[LEN(path) - 1] := 0X; j := 0; num := 0;
377 GetName(path, name, j); Meta.Lookup(name, i);
378 IF (i.obj = Meta.modObj) & (path[j] = ".") THEN
379 INC(j); GetName(path, name, j);
380 i.Lookup(name, i); ch := path[j]; INC(j);
381 WHILE i.obj = Meta.varObj DO
382 adr[num] := i.adr;
383 IF num < LEN(adr) - 1 THEN INC(num) END;
384 IF ch = 0X THEN RETURN
385 ELSIF i.typ = Meta.ptrTyp THEN
386 IF ch = "^" THEN ch := path[j]; INC(j) END;
387 i.Deref(i)
388 ELSIF (i.typ = Meta.recTyp) & (ch = ".") THEN
389 GetName(path, name, j); i.Lookup(name, i);
390 ch := path[j]; INC(j)
391 ELSIF (i.typ = Meta.arrTyp) & (ch = "[") THEN
392 ch := path[j]; INC(j); n := 0;
393 WHILE (ch >= "0") & (ch <= "9") DO n := 10 * n + ORD(ch) - ORD("0"); ch := path[j]; INC(j) END;
394 IF ch = "]" THEN ch := path[j]; INC(j); i.Index(n, i) ELSE Meta.Lookup("", i) END
395 ELSE Meta.Lookup("", i)
396 END
397 END
398 ELSE
399 Meta.LookupPath(path, i); num := 0;
400 IF i.obj = Meta.varObj THEN adr[0] := i.adr; num := 1
401 ELSIF i.obj # Meta.procObj THEN Meta.Lookup("", i)
402 END
403 END
404 END LookupPath;
406 PROCEDURE Sort (VAR adr: ARRAY OF INTEGER; num: INTEGER);
407 VAR i, j, p: INTEGER;
408 BEGIN
409 i := 1;
410 WHILE i < num DO
411 p := adr[i]; j := i;
412 WHILE (j >= 1) & (adr[j - 1] > p) DO adr[j] := adr[j - 1]; DEC(j) END;
413 adr[j] := p; INC(i)
414 END
415 END Sort;
417 PROCEDURE GetTypeName (IN item: Meta.Item; OUT name: Meta.Name);
418 VAR mod: Meta.Name;
419 BEGIN
420 IF (item.typ = Meta.recTyp) THEN
421 item.GetTypeName(mod, name);
422 IF (mod = "Dialog") OR (mod = "Dates") THEN (* ok *)
423 ELSE name := ""
424 END
425 ELSE name := ""
426 END
427 END GetTypeName;
429 PROCEDURE OpenLink* (c: Control; p: Prop);
430 VAR ok: BOOLEAN;
431 BEGIN
432 ASSERT(c # NIL, 20); ASSERT(p # NIL, 21);
433 c.num := 0;
434 c.prop := Properties.CopyOf(p)(Prop);
435 IF c.font = NIL THEN
436 IF c.customFont THEN c.font := StdCFrames.defaultLightFont
437 ELSE c.font := StdCFrames.defaultFont
438 END
439 END;
440 c.guardErr := FALSE; c.notifyErr := FALSE;
441 LookupPath(p.link, c.item, c.adr, c.num);
442 IF c.item.obj = Meta.varObj THEN
443 Sort(c.adr, c.num);
444 ok := TRUE; c.CheckLink(ok);
445 IF ~ok THEN
446 Meta.Lookup("", c.item);
447 Dialog.ShowParamMsg("#System:HasWrongType", p.link, "", "")
448 END
449 ELSE
450 Meta.Lookup("", c.item); c.num := 0
451 END;
452 CallGuard(c);
453 c.stamp := stamp
454 END OpenLink;
457 (** Prop **)
459 PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
460 VAR valid: SET;
461 BEGIN
462 WITH q: Prop DO
463 valid := p.valid * q.valid; equal := TRUE;
464 IF p.link # q.link THEN EXCL(valid, link) END;
465 IF p.label # q.label THEN EXCL(valid, label) END;
466 IF p.guard # q.guard THEN EXCL(valid, guard) END;
467 IF p.notifier # q.notifier THEN EXCL(valid, notifier) END;
468 IF p.level # q.level THEN EXCL(valid, level) END;
469 IF p.opt[0] # q.opt[0] THEN EXCL(valid, opt0) END;
470 IF p.opt[1] # q.opt[1] THEN EXCL(valid, opt1) END;
471 IF p.opt[2] # q.opt[2] THEN EXCL(valid, opt2) END;
472 IF p.opt[3] # q.opt[3] THEN EXCL(valid, opt3) END;
473 IF p.opt[4] # q.opt[4] THEN EXCL(valid, opt4) END;
474 IF p.valid # valid THEN p.valid := valid; equal := FALSE END
475 END
476 END IntersectWith;
479 (* Control *)
481 PROCEDURE (c: Control) CopyFromSimpleView2- (source: Control), NEW, EMPTY;
483 PROCEDURE (c: Control) CopyFromSimpleView- (source: Views.View);
484 BEGIN
485 WITH source: Control DO
486 c.item := source.item;
487 c.adr := source.adr;
488 c.num := source.num;
489 c.disabled := source.disabled;
490 c.undef := source.undef;
491 c.readOnly := source.readOnly;
492 c.shortcut := source.shortcut;
493 c.customFont := source.customFont;
494 c.font := source.font;
495 c.label := source.label$;
496 c.prop := Properties.CopyOf(source.prop)(Prop);
497 c.CopyFromSimpleView2(source)
498 END
499 END CopyFromSimpleView;
501 PROCEDURE (c: Control) Internalize- (VAR rd: Stores.Reader);
502 VAR thisVersion: INTEGER; x, def, canc, sort: BOOLEAN;
503 BEGIN
504 c.Internalize^(rd);
505 IF rd.cancelled THEN RETURN END;
506 rd.ReadVersion(minVersion, maxBaseVersion, thisVersion);
507 IF rd.cancelled THEN RETURN END;
508 NEW(c.prop);
509 IF thisVersion >= 3 THEN
510 rd.ReadString(c.prop.link);
511 rd.ReadString(c.prop.label);
512 rd.ReadString(c.prop.guard);
513 rd.ReadString(c.prop.notifier);
514 rd.ReadInt(c.prop.level);
515 rd.ReadBool(c.customFont);
516 rd.ReadBool(c.prop.opt[0]);
517 rd.ReadBool(c.prop.opt[1]);
518 rd.ReadBool(c.prop.opt[2]);
519 rd.ReadBool(c.prop.opt[3]);
520 rd.ReadBool(c.prop.opt[4]);
521 IF c.customFont & (thisVersion = 4) THEN
522 Views.ReadFont(rd, c.font)
523 END
524 ELSE
525 rd.ReadXString(c.prop.link);
526 rd.ReadXString(c.prop.label);
527 rd.ReadXString(c.prop.guard);
528 c.prop.notifier := "";
529 c.prop.opt[2] := FALSE;
530 c.prop.opt[3] := FALSE;
531 c.prop.opt[4] := FALSE;
532 sort := FALSE;
533 IF thisVersion = 2 THEN
534 rd.ReadXString(c.prop.notifier);
535 rd.ReadBool(sort);
536 rd.ReadBool(c.prop.opt[multiLine])
537 ELSIF thisVersion = 1 THEN
538 rd.ReadXString(c.prop.notifier);
539 rd.ReadBool(sort)
540 END;
541 rd.ReadBool(x); (* free, was sed for prop.element *)
542 rd.ReadBool(def);
543 rd.ReadBool(canc);
544 rd.ReadXInt(c.prop.level);
545 rd.ReadBool(c.customFont);
546 c.prop.opt[default] := def OR sort OR (c IS Field);
547 c.prop.opt[cancel] := canc
548 END;
549 c.Internalize2(rd);
550 OpenLink(c, c.prop)
551 END Internalize;
553 PROCEDURE (c: Control) Externalize- (VAR wr: Stores.Writer);
554 BEGIN
555 c.Externalize^(wr);
556 wr.WriteVersion(maxBaseVersion);
557 wr.WriteString(c.prop.link);
558 wr.WriteString(c.prop.label);
559 wr.WriteString(c.prop.guard);
560 wr.WriteString(c.prop.notifier);
561 wr.WriteInt(c.prop.level);
562 wr.WriteBool(c.customFont);
563 wr.WriteBool(c.prop.opt[0]);
564 wr.WriteBool(c.prop.opt[1]);
565 wr.WriteBool(c.prop.opt[2]);
566 wr.WriteBool(c.prop.opt[3]);
567 wr.WriteBool(c.prop.opt[4]);
568 IF c.customFont THEN Views.WriteFont(wr, c.font) END;
569 c.Externalize2(wr)
570 END Externalize;
572 PROCEDURE (c: Control) HandleViewMsg- (f: Views.Frame; VAR msg: Views.Message);
573 VAR disabled, undef, readOnly, done, allDone: BOOLEAN; i: INTEGER; lbl: Dialog.String;
574 BEGIN
575 WITH msg: Views.NotifyMsg DO
576 done := FALSE; allDone := FALSE;
577 IF guardCheck IN msg.opts THEN
578 (* should call c.Update for each frame but Views.Update only once *)
579 WITH f: StdCFrames.Caption DO lbl := f.label$
580 | f: StdCFrames.PushButton DO lbl := f.label$
581 | f: StdCFrames.RadioButton DO lbl := f.label$
582 | f: StdCFrames.CheckBox DO lbl := f.label$
583 | f: StdCFrames.Group DO lbl := f.label$
584 ELSE lbl := c.label$
585 END;
586 WITH f: StdCFrames.Frame DO
587 disabled := f.disabled; undef := f.undef; readOnly := f.readOnly
588 ELSE
589 disabled := c.disabled; undef := c.undef; readOnly := c.readOnly
590 END;
591 CallGuard(c);
592 IF (c.disabled # disabled) OR (c.undef # undef)
593 OR (c.readOnly # readOnly) OR (c.label # lbl) THEN
594 WITH f: StdCFrames.Frame DO
595 IF f.noRedraw THEN
596 f.disabled := c.disabled;
597 f.undef := c.undef;
598 f.readOnly := c.readOnly;
599 c.Update(f, 0, 0, 0); done := TRUE
600 ELSE Views.Update(c, Views.rebuildFrames); allDone := TRUE
601 END
602 ELSE Views.Update(c, Views.keepFrames); done := TRUE
603 END
604 END
605 END;
606 IF flushCaches IN msg.opts THEN
607 Views.Update(c, Views.rebuildFrames)
608 END;
609 i := 0; WHILE (i < c.num) & (c.adr[i] < msg.id0) DO INC(i) END;
610 IF (i < c.num) & (c.adr[i] < msg.id1) & ~allDone THEN
611 IF (update IN msg.opts) & ~done THEN
612 WITH msg: NotifyMsg DO
613 IF msg.frame # f THEN (* don't update origin frame *)
614 c.Update(f, msg.op, msg.from, msg.to)
615 END
616 ELSE
617 c.Update(f, 0, 0, 0)
618 END
619 END;
620 IF listUpdate IN msg.opts THEN
621 c.UpdateList(f)
622 END
623 END
624 | msg: Views.UpdateCachesMsg DO
625 IF c.stamp # stamp THEN
626 OpenLink(c, c.prop);
627 IF msg IS UpdateCachesMsg THEN
628 Views.Update(c, Views.rebuildFrames)
629 END
630 END
631 ELSE
632 END;
633 c.HandleViewMsg2(f, msg)
634 END HandleViewMsg;
636 PROCEDURE (c: Control) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message;
637 VAR focus: Views.View);
638 VAR sp: Properties.SizeProp; p: Control; dcOk: BOOLEAN;
639 BEGIN
640 IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
641 INC(cleanerInstalled);
642 p := par; par := c;
643 WITH msg: Properties.PollPickMsg DO
644 msg.dest := f
645 | msg: Properties.PickMsg DO
646 NEW(sp); sp.known := {Properties.width, Properties.height}; sp.valid := sp.known;
647 c.context.GetSize(sp.width, sp.height);
648 Properties.Insert(msg.prop, sp)
649 | msg: Controllers.TrackMsg DO
650 IF ~c.disabled THEN
651 dcOk := TRUE;
652 IF f IS StdCFrames.Frame THEN dcOk := f(StdCFrames.Frame).DblClickOk(msg.x, msg.y) END;
653 IF (DCHint(msg.modifiers) = 1) & dcOk THEN
654 (* double click *)
655 Notify(c, f, Dialog.pressed, 1, 0)
656 ELSE
657 Notify(c, f, Dialog.pressed, 0, 0)
658 END
659 END
660 ELSE
661 END;
662 c.HandleCtrlMsg2(f, msg, focus);
663 WITH msg: Controllers.TrackMsg DO
664 IF ~c.disabled THEN
665 Notify(c, f, Dialog.released, 0, 0)
666 END
667 ELSE
668 END;
669 par := p;
670 DEC(cleanerInstalled);
671 IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
672 END HandleCtrlMsg;
674 PROCEDURE (c: Control) HandlePropMsg- (VAR msg: Properties.Message);
675 VAR fpref: Properties.FocusPref; stp: Properties.StdProp;
676 cp: Prop; ppref: PropPref; op: Op; valid: SET; p: Properties.Property;
677 fop: FontOp; face: Fonts.Typeface; size, weight: INTEGER; style: SET;
678 BEGIN
679 WITH msg: Properties.ControlPref DO
680 IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
681 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN
682 fpref.hotFocus := FALSE; fpref.setFocus := FALSE; fpref.atLocation := FALSE;
683 Views.HandlePropMsg(c, fpref);
684 IF fpref.setFocus THEN msg.getFocus := TRUE END
685 END
686 | msg: Properties.PollMsg DO
687 ppref.valid := {link, label, notifier, guard};
688 Views.HandlePropMsg(c, ppref);
689 cp := Properties.CopyOf(c.prop)(Prop);
690 cp.valid := ppref.valid; cp.known := cp.valid; cp.readOnly := {};
691 Properties.Insert(msg.prop, cp);
692 NEW(stp);
693 stp.valid := {Properties.typeface..Properties.weight};
694 stp.known := stp.valid;
695 IF c.customFont THEN stp.typeface := c.font.typeface$
696 ELSE stp.typeface := Fonts.default
697 END;
698 stp.size := c.font.size; stp.style.val := c.font.style; stp.weight := c.font.weight;
699 stp.style.mask := {Fonts.italic, Fonts.strikeout, Fonts.underline};
700 Properties.Insert(msg.prop, stp)
701 | msg: Properties.SetMsg DO
702 p := msg.prop; op := NIL; fop := NIL;
703 WHILE (p # NIL) & (op = NIL) DO
704 WITH p: Prop DO
705 ppref.valid := {link, label, notifier, guard};
706 Views.HandlePropMsg(c, ppref);
707 valid := p.valid * ppref.valid;
708 IF valid # {} THEN
709 NEW(op);
710 op.ctrl := c;
711 op.prop := Properties.CopyOf(p)(Prop); op.prop.valid := valid
712 END
713 | p: Properties.StdProp DO
714 valid := p.valid * {Properties.typeface..Properties.weight};
715 IF valid # {} THEN
716 NEW(fop); fop.ctrl := c;
717 face := c.font.typeface$; size := c.font.size; style := c.font.style; weight := c.font.weight;
718 IF Properties.typeface IN p.valid THEN face := p.typeface$;
719 IF face = Fonts.default THEN face := StdCFrames.defaultFont.typeface END
720 END;
721 IF Properties.size IN p.valid THEN size := p.size END;
722 IF Properties.style IN p.valid THEN
723 style := (p.style.val * p.style.mask) + (style - p.style.mask)
724 END;
725 IF Properties.weight IN p.valid THEN weight := p.weight END;
726 fop.custom := TRUE;
727 fop.font := Fonts.dir.This(face, size, style, weight);
728 IF (fop.font.typeface = StdCFrames.defaultFont.typeface)
729 & (fop.font.size = StdCFrames.defaultFont.size)
730 & (fop.font.style = StdCFrames.defaultFont.style)
731 & (fop.font.weight = StdCFrames.defaultFont.weight) THEN
732 fop.custom := FALSE;
733 fop.font := StdCFrames.defaultFont
734 END
735 END
736 ELSE
737 END;
738 p := p.next
739 END;
740 IF op # NIL THEN Views.Do(c, "#System:SetProp", op) END;
741 IF fop # NIL THEN Views.Do(c, "#System:SetProp", fop) END
742 | msg: Properties.TypePref DO
743 IF Services.Is(c, msg.type) THEN msg.view := c END
744 ELSE
745 END;
746 c.HandlePropMsg2(msg)
747 END HandlePropMsg;
750 (* Op *)
752 PROCEDURE (op: Op) Do;
753 VAR c: Control; prop: Prop;
754 BEGIN
755 c := op.ctrl;
756 prop := Properties.CopyOf(c.prop)(Prop);
757 prop.valid := op.prop.valid; (* fields to be restored *)
758 IF link IN op.prop.valid THEN c.prop.link := op.prop.link END;
759 IF label IN op.prop.valid THEN c.prop.label := op.prop.label END;
760 IF guard IN op.prop.valid THEN c.prop.guard := op.prop.guard END;
761 IF notifier IN op.prop.valid THEN c.prop.notifier := op.prop.notifier END;
762 IF level IN op.prop.valid THEN c.prop.level := op.prop.level END;
763 IF opt0 IN op.prop.valid THEN c.prop.opt[0] := op.prop.opt[0] END;
764 IF opt1 IN op.prop.valid THEN c.prop.opt[1] := op.prop.opt[1] END;
765 IF opt2 IN op.prop.valid THEN c.prop.opt[2] := op.prop.opt[2] END;
766 IF opt3 IN op.prop.valid THEN c.prop.opt[3] := op.prop.opt[3] END;
767 IF opt4 IN op.prop.valid THEN c.prop.opt[4] := op.prop.opt[4] END;
768 IF c.prop.guard # prop.guard THEN c.guardErr := FALSE END;
769 IF c.prop.notifier # prop.notifier THEN c.notifyErr := FALSE END;
770 IF c.prop.link # prop.link THEN OpenLink(c, c.prop) ELSE CallGuard(c) END;
771 op.prop := prop;
772 Views.Update(c, Views.rebuildFrames)
773 END Do;
775 PROCEDURE (op: FontOp) Do;
776 VAR c: Control; custom: BOOLEAN; font: Fonts.Font;
777 BEGIN
778 c := op.ctrl;
779 custom := c.customFont; c.customFont := op.custom; op.custom := custom;
780 font := c.font; c.font := op.font; op.font := font;
781 Views.Update(c, Views.rebuildFrames)
782 END Do;
785 (* ------------------------- standard controls ------------------------- *)
787 PROCEDURE CatchCtrlMsg (c: Control; f: Views.Frame; VAR msg: Controllers.Message;
788 VAR focus: Views.View);
789 BEGIN
790 IF ~c.disabled THEN
791 WITH f: StdCFrames.Frame DO
792 WITH msg: Controllers.PollCursorMsg DO
793 f.GetCursor(msg.x, msg.y, msg.modifiers, msg.cursor)
794 | msg: Controllers.PollOpsMsg DO
795 msg.valid := {Controllers.pasteChar}
796 | msg: Controllers.TrackMsg DO
797 f.MouseDown(msg.x, msg.y, msg.modifiers)
798 | msg: Controllers.MarkMsg DO
799 f.Mark(msg.show, msg.focus)
800 |msg: Controllers.WheelMsg DO
801 f.WheelMove(msg.x, msg.y, msg.op, msg.nofLines, msg.done)
802 ELSE
803 END
804 END
805 END
806 END CatchCtrlMsg;
809 (** Directory **)
811 PROCEDURE (d: Directory) NewPushButton* (p: Prop): Control, NEW, ABSTRACT;
812 PROCEDURE (d: Directory) NewCheckBox* (p: Prop): Control, NEW, ABSTRACT;
813 PROCEDURE (d: Directory) NewRadioButton* (p: Prop): Control, NEW, ABSTRACT;
814 PROCEDURE (d: Directory) NewField* (p: Prop): Control, NEW, ABSTRACT;
815 PROCEDURE (d: Directory) NewUpDownField* (p: Prop): Control, NEW, ABSTRACT;
816 PROCEDURE (d: Directory) NewDateField* (p: Prop): Control, NEW, ABSTRACT;
817 PROCEDURE (d: Directory) NewTimeField* (p: Prop): Control, NEW, ABSTRACT;
818 PROCEDURE (d: Directory) NewColorField* (p: Prop): Control, NEW, ABSTRACT;
819 PROCEDURE (d: Directory) NewListBox* (p: Prop): Control, NEW, ABSTRACT;
820 PROCEDURE (d: Directory) NewSelectionBox* (p: Prop): Control, NEW, ABSTRACT;
821 PROCEDURE (d: Directory) NewComboBox* (p: Prop): Control, NEW, ABSTRACT;
822 PROCEDURE (d: Directory) NewCaption* (p: Prop): Control, NEW, ABSTRACT;
823 PROCEDURE (d: Directory) NewGroup* (p: Prop): Control, NEW, ABSTRACT;
824 PROCEDURE (d: Directory) NewTreeControl* (p: Prop): Control, NEW, ABSTRACT;
827 (* PushButton *)
829 PROCEDURE Call (c: PushButton);
830 VAR res: INTEGER; p: Control; ok: BOOLEAN; msg: Views.NotifyMsg;
831 BEGIN
832 IF c.item.Valid() & ((c.item.obj = Meta.procObj) OR (c.item.obj = Meta.varObj) & (c.item.typ = Meta.procTyp)) THEN
833 IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
834 INC(cleanerInstalled);
835 p := par; c.item.Call(ok); par := p;
836 DEC(cleanerInstalled);
837 IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END;
838 IF ~ok THEN Dialog.ShowMsg("#System:BehaviorNotAccessible") END
839 ELSIF c.prop.link # "" THEN
840 IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
841 INC(cleanerInstalled);
842 p := par; par := c; Dialog.Call(c.prop.link, " ", res); par := p;
843 DEC(cleanerInstalled);
844 IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
845 ELSE Dialog.ShowMsg("#System:NoBehaviorBound")
846 END;
847 msg.opts := {guardCheck};
848 Views.Omnicast(msg)
849 END Call;
851 PROCEDURE Do (f: StdCFrames.PushButton);
852 BEGIN
853 Call(f.view(PushButton))
854 END Do;
856 PROCEDURE (c: PushButton) Internalize2 (VAR rd: Stores.Reader);
857 VAR thisVersion: INTEGER;
858 BEGIN
859 rd.ReadVersion(minVersion, pbVersion, thisVersion)
860 END Internalize2;
862 PROCEDURE (c: PushButton) Externalize2 (VAR wr: Stores.Writer);
863 BEGIN
864 wr.WriteVersion(pbVersion)
865 END Externalize2;
867 PROCEDURE (c: PushButton) GetNewFrame (VAR frame: Views.Frame);
868 VAR f: StdCFrames.PushButton;
869 BEGIN
870 f := StdCFrames.dir.NewPushButton();
871 f.disabled := c.disabled;
872 f.undef := c.undef;
873 f.readOnly := c.readOnly;
874 f.font := c.font;
875 f.label := c.label$;
876 f.default := c.prop.opt[default];
877 f.cancel := c.prop.opt[cancel];
878 f.Do := Do;
879 frame := f
880 END GetNewFrame;
882 PROCEDURE (c: PushButton) Restore (f: Views.Frame; l, t, r, b: INTEGER);
883 BEGIN
884 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
885 END Restore;
887 PROCEDURE (c: PushButton) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
888 VAR focus: Views.View);
889 BEGIN
890 IF ~c.disabled THEN
891 WITH f: StdCFrames.Frame DO
892 WITH msg: Controllers.EditMsg DO
893 IF (msg.op = Controllers.pasteChar)
894 & ((msg.char = lineChar)
895 OR (msg.char = " ")
896 OR (msg.char = esc) & c.prop.opt[cancel]
897 OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
898 ELSE
899 CatchCtrlMsg(c, f, msg, focus)
900 END
901 END
902 END
903 END HandleCtrlMsg2;
905 PROCEDURE (c: PushButton) HandlePropMsg2 (VAR msg: Properties.Message);
906 BEGIN
907 WITH msg: Properties.ControlPref DO
908 msg.accepts := ~c.disabled & ((msg.char = lineChar) & c.prop.opt[default]
909 OR (msg.char = esc) & c.prop.opt[cancel]
910 OR IsShortcut(msg.char, c))
911 | msg: Properties.FocusPref DO
912 IF ~c.disabled & ~ c.readOnly THEN
913 msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
914 END
915 | msg: Properties.SizePref DO
916 StdCFrames.dir.GetPushButtonSize(msg.w, msg.h)
917 | msg: PropPref DO
918 msg.valid := {link, label, guard, notifier, default, cancel}
919 | msg: DefaultsPref DO
920 IF c.prop.link # "" THEN msg.disabled := FALSE END
921 ELSE
922 END
923 END HandlePropMsg2;
925 PROCEDURE (c: PushButton) Update (f: Views.Frame; op, from, to: INTEGER);
926 BEGIN
927 f(StdCFrames.PushButton).label := c.label$;
928 f(StdCFrames.Frame).Update
929 END Update;
931 PROCEDURE (c: PushButton) CheckLink (VAR ok: BOOLEAN);
932 BEGIN
933 ok := c.item.typ = Meta.procTyp
934 END CheckLink;
937 (* CheckBox *)
939 PROCEDURE GetCheckBox (f: StdCFrames.CheckBox; OUT x: BOOLEAN);
940 VAR c: CheckBox;
941 BEGIN
942 x := FALSE;
943 c := f.view(CheckBox);
944 IF c.item.Valid() THEN
945 IF c.item.typ = Meta.boolTyp THEN x := c.item.BoolVal()
946 ELSIF c.item.typ = Meta.setTyp THEN x := c.prop.level IN c.item.SetVal()
947 END
948 END
949 END GetCheckBox;
951 PROCEDURE SetCheckBox (f: StdCFrames.CheckBox; x: BOOLEAN);
952 VAR c: CheckBox; s: SET;
953 BEGIN
954 c := f.view(CheckBox);
955 IF c.item.Valid() & ~c.readOnly THEN
956 IF c.item.typ = Meta.boolTyp THEN
957 c.item.PutBoolVal(x); Notify(c, f, Dialog.changed, 0, 0)
958 ELSIF c.item.typ = Meta.setTyp THEN
959 s := c.item.SetVal();
960 IF x THEN INCL(s, c.prop.level) ELSE EXCL(s, c.prop.level) END;
961 c.item.PutSetVal(s);
962 IF x THEN Notify(c, f, Dialog.included, c.prop.level, c.prop.level)
963 ELSE Notify(c, f, Dialog.excluded, c.prop.level, c.prop.level)
964 END
965 END
966 END
967 END SetCheckBox;
969 PROCEDURE (c: CheckBox) Internalize2 (VAR rd: Stores.Reader);
970 VAR thisVersion: INTEGER;
971 BEGIN
972 rd.ReadVersion(minVersion, cbVersion, thisVersion)
973 END Internalize2;
975 PROCEDURE (c: CheckBox) Externalize2 (VAR wr: Stores.Writer);
976 BEGIN
977 wr.WriteVersion(cbVersion)
978 END Externalize2;
980 PROCEDURE (c: CheckBox) GetNewFrame (VAR frame: Views.Frame);
981 VAR f: StdCFrames.CheckBox;
982 BEGIN
983 f := StdCFrames.dir.NewCheckBox();
984 f.disabled := c.disabled;
985 f.undef := c.undef;
986 f.readOnly := c.readOnly;
987 f.font := c.font;
988 f.label := c.label$;
989 f.Get := GetCheckBox;
990 f.Set := SetCheckBox;
991 frame := f
992 END GetNewFrame;
994 PROCEDURE (c: CheckBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
995 BEGIN
996 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
997 END Restore;
999 PROCEDURE (c: CheckBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
1000 VAR focus: Views.View);
1001 BEGIN
1002 IF ~c.disabled & ~c.readOnly THEN
1003 WITH f: StdCFrames.Frame DO
1004 WITH msg: Controllers.EditMsg DO
1005 IF (msg.op = Controllers.pasteChar)
1006 & ((msg.char = " ") OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
1007 ELSE
1008 CatchCtrlMsg(c, f, msg, focus)
1009 END
1010 END
1011 END
1012 END HandleCtrlMsg2;
1014 PROCEDURE (c: CheckBox) HandlePropMsg2 (VAR msg: Properties.Message);
1015 BEGIN
1016 WITH msg: Properties.ControlPref DO
1017 IF ~c.disabled & ~c.readOnly THEN
1018 IF (msg.char = tab) OR (msg.char = ltab) THEN
1019 (* tabs set focus to first checkbox only *)
1020 IF (msg.focus # NIL) & (msg.focus IS CheckBox)
1021 & (msg.focus(CheckBox).item.adr = c.item.adr) THEN
1022 msg.getFocus := FALSE
1023 END
1024 ELSIF (msg.char >= arrowLeft) & (msg.char <= arrowDown) THEN
1025 (* arrows set focus to next checkbox bound to same variable *)
1026 msg.getFocus := StdCFrames.setFocus
1027 & (msg.focus # NIL)
1028 & (msg.focus IS CheckBox)
1029 & (msg.focus(CheckBox).item.adr = c.item.adr);
1030 msg.accepts := msg.getFocus & (msg.focus # c)
1031 ELSIF IsShortcut(msg.char, c) THEN
1032 msg.accepts := TRUE; msg.getFocus := StdCFrames.setFocus
1033 ELSIF msg.char # " " THEN
1034 msg.accepts := FALSE
1035 END
1036 END
1037 | msg: Properties.FocusPref DO
1038 IF ~c.disabled & ~c.readOnly THEN
1039 msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
1040 END
1041 | msg: Properties.SizePref DO
1042 StdCFrames.dir.GetCheckBoxSize(msg.w, msg.h)
1043 | msg: PropPref DO
1044 msg.valid := {link, label, guard, notifier, level}
1045 ELSE
1046 END
1047 END HandlePropMsg2;
1049 PROCEDURE (c: CheckBox) CheckLink (VAR ok: BOOLEAN);
1050 BEGIN
1051 ok := (c.item.typ = Meta.boolTyp) OR (c.item.typ = Meta.setTyp)
1052 END CheckLink;
1054 PROCEDURE (c: CheckBox) Update (f: Views.Frame; op, from, to: INTEGER);
1055 BEGIN
1056 IF (op = 0) OR (c.item.typ = Meta.boolTyp) OR (c.prop.level = to) THEN
1057 f(StdCFrames.CheckBox).label := c.label$;
1058 f(StdCFrames.Frame).Update
1059 END
1060 END Update;
1063 (* RadioButton *)
1065 PROCEDURE GetRadioButton (f: StdCFrames.RadioButton; OUT x: BOOLEAN);
1066 VAR c: RadioButton;
1067 BEGIN
1068 x := FALSE;
1069 c := f.view(RadioButton);
1070 IF c.item.Valid() THEN
1071 IF c.item.typ = Meta.boolTyp THEN x := c.item.BoolVal() = (c.prop.level # 0)
1072 ELSE x := c.item.IntVal() = c.prop.level
1073 END
1074 END
1075 END GetRadioButton;
1077 PROCEDURE SetRadioButton (f: StdCFrames.RadioButton; x: BOOLEAN);
1078 VAR c: RadioButton; old: INTEGER;
1079 BEGIN
1080 IF x THEN
1081 c := f.view(RadioButton);
1082 IF c.item.Valid() & ~c.readOnly THEN
1083 IF c.item.typ = Meta.boolTyp THEN
1084 IF c.item.BoolVal() THEN old := 1 ELSE old := 0 END;
1085 IF c.prop.level # old THEN
1086 c.item.PutBoolVal(c.prop.level # 0);
1087 Notify(c, f, Dialog.changed, old, c.prop.level)
1088 END
1089 ELSE
1090 old := c.item.IntVal();
1091 IF c.prop.level # old THEN
1092 c.item.PutIntVal(c.prop.level);
1093 Notify(c, f, Dialog.changed, old, c.prop.level)
1094 END
1095 END
1096 END
1097 END
1098 END SetRadioButton;
1100 PROCEDURE (c: RadioButton) Internalize2 (VAR rd: Stores.Reader);
1101 VAR thisVersion: INTEGER;
1102 BEGIN
1103 rd.ReadVersion(minVersion, rbVersion, thisVersion)
1104 END Internalize2;
1106 PROCEDURE (c: RadioButton) Externalize2 (VAR wr: Stores.Writer);
1107 BEGIN
1108 wr.WriteVersion(rbVersion)
1109 END Externalize2;
1111 PROCEDURE (c: RadioButton) GetNewFrame (VAR frame: Views.Frame);
1112 VAR f: StdCFrames.RadioButton;
1113 BEGIN
1114 f := StdCFrames.dir.NewRadioButton();
1115 f.disabled := c.disabled;
1116 f.undef := c.undef;
1117 f.readOnly := c.readOnly;
1118 f.font := c.font;
1119 f.label := c.label$;
1120 f.Get := GetRadioButton;
1121 f.Set := SetRadioButton;
1122 frame := f
1123 END GetNewFrame;
1125 PROCEDURE (c: RadioButton) Restore (f: Views.Frame; l, t, r, b: INTEGER);
1126 BEGIN
1127 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
1128 END Restore;
1130 PROCEDURE (c: RadioButton) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
1131 VAR focus: Views.View);
1132 BEGIN
1133 IF ~c.disabled & ~c.readOnly THEN
1134 WITH f: StdCFrames.Frame DO
1135 WITH msg: Controllers.EditMsg DO
1136 IF (msg.op = Controllers.pasteChar)
1137 & ((msg.char <= " ") OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
1138 ELSE
1139 CatchCtrlMsg(c, f, msg, focus)
1140 END
1141 END
1142 END
1143 END HandleCtrlMsg2;
1145 PROCEDURE (c: RadioButton) HandlePropMsg2 (VAR msg: Properties.Message);
1146 VAR hot: BOOLEAN;
1147 BEGIN
1148 WITH msg: Properties.ControlPref DO
1149 IF ~c.disabled & ~c.readOnly THEN
1150 IF (msg.char = tab) OR (msg.char = ltab) THEN
1151 (* tabs set focus to active radio button only *)
1152 IF c.item.Valid() THEN
1153 IF c.item.typ = Meta.boolTyp THEN hot := c.item.BoolVal() = (c.prop.level # 0)
1154 ELSE hot := c.item.IntVal() = c.prop.level
1155 END
1156 ELSE hot := FALSE
1157 END;
1158 IF ~hot THEN msg.getFocus := FALSE END
1159 ELSIF (msg.char >= arrowLeft) & (msg.char <= arrowDown) THEN
1160 (* arrows set focus to next radio button bound to same variable *)
1161 msg.getFocus := StdCFrames.setFocus
1162 & (msg.focus # NIL) & (msg.focus IS RadioButton)
1163 & (msg.focus(RadioButton).item.adr = c.item.adr);
1164 msg.accepts := msg.getFocus & (msg.focus # c)
1165 ELSIF IsShortcut(msg.char, c) THEN
1166 msg.accepts := TRUE; msg.getFocus := StdCFrames.setFocus
1167 ELSIF msg.char # " " THEN
1168 msg.accepts := FALSE
1169 END
1170 END
1171 | msg: Properties.FocusPref DO
1172 IF ~c.disabled & ~c.readOnly THEN
1173 msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
1174 END
1175 | msg: Properties.SizePref DO
1176 StdCFrames.dir.GetRadioButtonSize(msg.w, msg.h)
1177 | msg: PropPref DO
1178 msg.valid := {link, label, guard, notifier, level}
1179 ELSE
1180 END
1181 END HandlePropMsg2;
1183 PROCEDURE (c: RadioButton) CheckLink (VAR ok: BOOLEAN);
1184 VAR name: Meta.Name;
1185 BEGIN
1186 GetTypeName(c.item, name);
1187 IF name = "List" THEN c.item.Lookup("index", c.item) END;
1188 ok := (c.item.typ >= Meta.byteTyp) & (c.item.typ <= Meta.intTyp) OR (c.item.typ = Meta.boolTyp)
1189 END CheckLink;
1191 PROCEDURE (c: RadioButton) Update (f: Views.Frame; op, from, to: INTEGER);
1192 BEGIN
1193 IF (op = 0) OR (c.prop.level = to) OR (c.prop.level = from) THEN
1194 f(StdCFrames.RadioButton).label := c.label$;
1195 f(StdCFrames.Frame).Update
1196 END
1197 END Update;
1200 (* Field *)
1202 PROCEDURE LongToString (x: LONGINT; OUT s: ARRAY OF CHAR);
1203 VAR d: ARRAY 24 OF CHAR; i, j: INTEGER;
1204 BEGIN
1205 IF x = MIN(LONGINT) THEN
1206 s := "-9223372036854775808"
1207 ELSE
1208 i := 0; j := 0;
1209 IF x < 0 THEN s[0] := "-"; i := 1; x := -x END;
1210 REPEAT d[j] := CHR(x MOD 10 + ORD("0")); INC(j); x := x DIV 10 UNTIL x = 0;
1211 WHILE j > 0 DO DEC(j); s[i] := d[j]; INC(i) END;
1212 s[i] := 0X
1213 END
1214 END LongToString;
1216 PROCEDURE StringToLong (IN s: ARRAY OF CHAR; OUT x: LONGINT; OUT res: INTEGER);
1217 VAR i, sign, d: INTEGER;
1218 BEGIN
1219 i := 0; sign := 1; x := 0; res := 0;
1220 WHILE s[i] = " " DO INC(i) END;
1221 IF s[i] = "-" THEN sign := -1; INC(i) END;
1222 WHILE s[i] = " " DO INC(i) END;
1223 IF s[i] = 0X THEN res := 2 END;
1224 WHILE (s[i] >= "0") & (s[i] <= "9") DO
1225 d := ORD(s[i]) - ORD("0"); INC(i);
1226 IF x <= (MAX(LONGINT) - d) DIV 10 THEN x := 10 * x + d
1227 ELSE res := 1
1228 END
1229 END;
1230 x := x * sign;
1231 IF s[i] # 0X THEN res := 2 END
1232 END StringToLong;
1234 PROCEDURE FixToInt (fix: ARRAY OF CHAR; OUT int: ARRAY OF CHAR; scale: INTEGER);
1235 VAR i, j: INTEGER;
1236 BEGIN
1237 IF scale > 24 THEN scale := 24 ELSIF scale < 0 THEN scale := 0 END;
1238 i := 0; j := 0;
1239 WHILE (fix[i] # ".") & (fix[i] # 0X) DO int[j] := fix[i]; INC(i); INC(j) END;
1240 IF fix[i] = "." THEN INC(i) END;
1241 WHILE (scale > 0) & (fix[i] >= "0") & (fix[i] <= "9") DO int[j] := fix[i]; INC(i); INC(j); DEC(scale) END;
1242 WHILE scale > 0 DO int[j] := "0"; INC(j); DEC(scale) END;
1243 int[j] := 0X
1244 END FixToInt;
1246 PROCEDURE IntToFix (int: ARRAY OF CHAR; OUT fix: ARRAY OF CHAR; scale: INTEGER);
1247 VAR i, j, n: INTEGER;
1248 BEGIN
1249 IF scale > 24 THEN scale := 24 ELSIF scale < 0 THEN scale := 0 END;
1250 n := LEN(int$); i := 0; j := 0;
1251 WHILE int[i] < "0" DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END;
1252 IF n > scale THEN
1253 WHILE n > scale DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END
1254 ELSE
1255 fix[j] := "0"; INC(j)
1256 END;
1257 fix[j] := "."; INC(j);
1258 WHILE n < scale DO fix[j] := "0"; INC(j); DEC(scale) END;
1259 WHILE n > 0 DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END;
1260 fix[j] := 0X
1261 END IntToFix;
1263 PROCEDURE GetField (f: StdCFrames.Field; OUT x: ARRAY OF CHAR);
1264 VAR c: Field; ok: BOOLEAN; b, v: Meta.Item; mod, name: Meta.Name;
1265 BEGIN
1266 x := "";
1267 c := f.view(Field);
1268 IF c.item.Valid() THEN
1269 IF c.item.typ = Meta.arrTyp THEN
1270 c.item.GetStringVal(x, ok)
1271 ELSIF c.item.typ IN {Meta.byteTyp, Meta.sIntTyp, Meta.intTyp} THEN
1272 Strings.IntToString(c.item.IntVal(), x);
1273 IF c.prop.level > 0 THEN IntToFix(x, x, c.prop.level) END
1274 ELSIF c.item.typ = Meta.longTyp THEN
1275 LongToString(c.item.LongVal(), x);
1276 IF c.prop.level > 0 THEN IntToFix(x, x, c.prop.level) END
1277 ELSIF c.item.typ = Meta.sRealTyp THEN
1278 IF c.prop.level <= 0 THEN
1279 Strings.RealToStringForm(c.item.RealVal(), 7, 0, c.prop.level, " ", x)
1280 ELSE
1281 Strings.RealToStringForm(c.item.RealVal(), c.prop.level, 0, 1, " ", x)
1282 END
1283 ELSIF c.item.typ = Meta.realTyp THEN
1284 IF c.prop.level <= 0 THEN
1285 Strings.RealToStringForm(c.item.RealVal(), 16, 0, c.prop.level, " ", x)
1286 ELSE
1287 Strings.RealToStringForm(c.item.RealVal(), c.prop.level, 0, 1, " ", x)
1288 END
1289 ELSIF c.item.typ = Meta.recTyp THEN
1290 c.item.GetTypeName(mod, name);
1291 IF mod = "Dialog" THEN
1292 IF name = "Currency" THEN
1293 c.item.Lookup("val", v); c.item.Lookup("scale", b);
1294 LongToString(v.LongVal(), x); IntToFix(x, x, b.IntVal())
1295 ELSE (* Combo *)
1296 c.item.Lookup("item", v); (* Combo *)
1297 IF v.typ = Meta.arrTyp THEN v.GetStringVal(x, ok) END
1298 END
1299 END
1300 END
1301 ELSE
1302 x := c.label$
1303 END
1304 END GetField;
1306 PROCEDURE SetField (f: StdCFrames.Field; IN x: ARRAY OF CHAR);
1307 VAR c: Field; ok: BOOLEAN; i, res, old: INTEGER; r, or: REAL; b, v: Meta.Item;
1308 mod, name: Meta.Name; long, long0: LONGINT;
1309 s: ARRAY 1024 OF CHAR;
1310 BEGIN
1311 c := f.view(Field);
1312 IF c.item.Valid() & ~c.readOnly THEN
1313 CASE c.item.typ OF
1314 | Meta.arrTyp:
1315 c.item.GetStringVal(s, ok);
1316 IF ~ok OR (s$ # x$) THEN
1317 c.item.PutStringVal(x, ok);
1318 IF ok THEN Notify(c, f, Dialog.changed, 0, 0) ELSE Dialog.Beep END
1319 END
1320 | Meta.byteTyp:
1321 IF x = "" THEN i := 0; res := 0
1322 ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
1323 ELSE Strings.StringToInt(x, i, res)
1324 END;
1325 IF (res = 0) & (i >= MIN(BYTE)) & (i <= MAX(BYTE)) THEN
1326 old := c.item.IntVal();
1327 IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
1328 ELSIF x # "-" THEN
1329 Dialog.Beep
1330 END
1331 | Meta.sIntTyp:
1332 IF x = "" THEN i := 0; res := 0
1333 ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
1334 ELSE Strings.StringToInt(x, i, res)
1335 END;
1336 IF (res = 0) & (i >= MIN(SHORTINT)) & (i <= MAX(SHORTINT)) THEN
1337 old := c.item.IntVal();
1338 IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
1339 ELSIF x # "-" THEN
1340 Dialog.Beep
1341 END
1342 | Meta.intTyp:
1343 IF x = "" THEN i := 0; res := 0
1344 ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
1345 ELSE Strings.StringToInt(x, i, res)
1346 END;
1347 IF res = 0 THEN
1348 old := c.item.IntVal();
1349 IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
1350 ELSIF x # "-" THEN
1351 Dialog.Beep
1352 END
1353 | Meta.longTyp:
1354 IF x = "" THEN long := 0; res := 0
1355 ELSE FixToInt(x, s, c.prop.level); StringToLong(s, long, res)
1356 END;
1357 IF res = 0 THEN
1358 long0 := c.item.LongVal();
1359 IF long # long0 THEN c.item.PutLongVal(long); Notify(c, f, Dialog.changed, 0, 0) END
1360 ELSIF x # "-" THEN
1361 Dialog.Beep
1362 END
1363 | Meta.sRealTyp:
1364 IF (x = "") OR (x = "-") THEN r := 0; res := 0 ELSE Strings.StringToReal(x, r, res) END;
1365 IF (res = 0) & (r >= MIN(SHORTREAL)) & (r <= MAX(SHORTREAL)) THEN
1366 or := c.item.RealVal();
1367 IF r # or THEN c.item.PutRealVal(r); Notify(c, f, Dialog.changed, 0, 0) END
1368 ELSIF x # "-" THEN
1369 Dialog.Beep
1370 END
1371 | Meta.realTyp:
1372 IF (x = "") OR (x = "-") THEN r := 0; res := 0 ELSE Strings.StringToReal(x, r, res) END;
1373 IF res = 0 THEN
1374 or := c.item.RealVal();
1375 IF r # or THEN c.item.PutRealVal(r); Notify(c, f, Dialog.changed, 0, 0) END
1376 ELSIF x # "-" THEN
1377 Dialog.Beep
1378 END
1379 | Meta.recTyp:
1380 c.item.GetTypeName(mod, name);
1381 IF mod = "Dialog" THEN
1382 IF name = "Currency" THEN
1383 c.item.Lookup("val", v); c.item.Lookup("scale", b);
1384 IF x = "" THEN long := 0; res := 0
1385 ELSE FixToInt(x, s, b.IntVal()); StringToLong(s, long, res)
1386 END;
1387 IF res = 0 THEN
1388 long0 := v.LongVal();
1389 IF long # long0 THEN v.PutLongVal(long); Notify(c, f, Dialog.changed, 0, 0) END
1390 ELSIF x # "-" THEN
1391 Dialog.Beep
1392 END
1393 ELSE (* name = "Combo" *)
1394 c.item.Lookup("item", v);
1395 IF v.typ = Meta.arrTyp THEN
1396 v.GetStringVal(s, ok);
1397 IF ~ok OR (s$ # x$) THEN
1398 v.PutStringVal(x, ok);
1399 IF ok THEN Notify(c, f, Dialog.changed, 0, 0) ELSE Dialog.Beep END
1400 END
1401 END
1402 END
1403 END
1404 END
1405 END
1406 END SetField;
1408 PROCEDURE EqualField (f: StdCFrames.Field; IN s1, s2: ARRAY OF CHAR): BOOLEAN;
1409 VAR c: Field; i1, i2, res1, res2: INTEGER; r1, r2: REAL; l1, l2: LONGINT;
1410 mod, name: Meta.Name; t1, t2: ARRAY 64 OF CHAR; b: Meta.Item;
1411 BEGIN
1412 c := f.view(Field);
1413 CASE c.item.typ OF
1414 | Meta.arrTyp:
1415 RETURN s1 = s2
1416 | Meta.byteTyp, Meta.sIntTyp, Meta.intTyp:
1417 IF c.prop.level > 0 THEN
1418 FixToInt(s1, t1, c.prop.level); Strings.StringToInt(t1, i1, res1);
1419 FixToInt(s2, t2, c.prop.level); Strings.StringToInt(t2, i2, res2)
1420 ELSE
1421 Strings.StringToInt(s1, i1, res1);
1422 Strings.StringToInt(s2, i2, res2)
1423 END;
1424 RETURN (res1 = 0) & (res2 = 0) & (i1 = i2)
1425 | Meta.longTyp:
1426 IF c.prop.level > 0 THEN
1427 FixToInt(s1, t1, c.prop.level); StringToLong(t1, l1, res1);
1428 FixToInt(s2, t2, c.prop.level); StringToLong(t2, l2, res2)
1429 ELSE
1430 StringToLong(s1, l1, res1);
1431 StringToLong(s2, l2, res2)
1432 END;
1433 RETURN (res1 = 0) & (res2 = 0) & (l1 = l2)
1434 | Meta.sRealTyp, Meta.realTyp:
1435 Strings.StringToReal(s1, r1, res1);
1436 Strings.StringToReal(s2, r2, res2);
1437 RETURN (res1 = 0) & (res2 = 0) & (r1 = r2)
1438 | Meta.recTyp:
1439 c.item.GetTypeName(mod, name);
1440 IF mod = "Dialog" THEN
1441 IF name = "Currency" THEN
1442 c.item.Lookup("scale", b); i1 := b.IntVal();
1443 FixToInt(s1, t1, i1); StringToLong(t1, l1, res1);
1444 FixToInt(s2, t2, i1); StringToLong(t2, l2, res2);
1445 RETURN (res1 = 0) & (res2 = 0) & (l1 =l2)
1446 ELSE (* name = "Combo" *)
1447 RETURN s1 = s2
1448 END
1449 END
1450 ELSE RETURN s1 = s2
1451 END
1452 END EqualField;
1454 PROCEDURE (c: Field) CopyFromSimpleView2 (source: Control);
1455 BEGIN
1456 WITH source: Field DO c.maxLen := source.maxLen END
1457 END CopyFromSimpleView2;
1459 PROCEDURE (c: Field) Internalize2 (VAR rd: Stores.Reader);
1460 VAR thisVersion: INTEGER;
1461 BEGIN
1462 rd.ReadVersion(minVersion, fldVersion, thisVersion)
1463 END Internalize2;
1465 PROCEDURE (c: Field) Externalize2 (VAR wr: Stores.Writer);
1466 BEGIN
1467 wr.WriteVersion(fldVersion)
1468 END Externalize2;
1470 PROCEDURE (c: Field) GetNewFrame (VAR frame: Views.Frame);
1471 VAR f: StdCFrames.Field;
1472 BEGIN
1473 f := StdCFrames.dir.NewField();
1474 f.disabled := c.disabled;
1475 f.undef := c.undef;
1476 f.readOnly := c.readOnly;
1477 f.font := c.font;
1478 f.maxLen := c.maxLen;
1479 f.left := c.prop.opt[left];
1480 f.right := c.prop.opt[right];
1481 f.multiLine := c.prop.opt[multiLine];
1482 f.password := c.prop.opt[password];
1483 f.Get := GetField;
1484 f.Set := SetField;
1485 f.Equal := EqualField;
1486 frame := f
1487 END GetNewFrame;
1489 PROCEDURE (c: Field) Restore (f: Views.Frame; l, t, r, b: INTEGER);
1490 BEGIN
1491 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
1492 END Restore;
1494 PROCEDURE (c: Field) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
1495 VAR focus: Views.View);
1496 VAR ch: CHAR; mod, name: Meta.Name;
1497 BEGIN
1498 WITH f: StdCFrames.Field DO
1499 IF ~c.disabled & ~c.readOnly THEN
1500 WITH msg: Controllers.PollOpsMsg DO
1501 msg.selectable := TRUE;
1502 (* should ask Frame if there is a selection for cut or copy! *)
1503 msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
1504 | msg: Controllers.TickMsg DO
1505 f.Idle
1506 | msg: Controllers.EditMsg DO
1507 IF msg.op = Controllers.pasteChar THEN
1508 ch := msg.char;
1509 IF (ch = ldel) OR (ch = rdel) OR (ch >= 10X) & (ch <= 1FX)
1510 OR ("0" <= ch) & (ch <= "9") OR (ch = "+") OR (ch = "-")
1511 OR (c.item.typ = Meta.arrTyp)
1512 OR (c.item.typ IN {Meta.sRealTyp, Meta.realTyp}) & ((ch = ".") OR (ch = "E"))
1513 OR (c.prop.level > 0) & (ch = ".")
1514 THEN f.KeyDown(ch)
1515 ELSIF c.item.typ = Meta.recTyp THEN
1516 c.item.GetTypeName(mod, name);
1517 IF (mod = "Dialog") & (name = "Combo") OR (ch = ".") THEN
1518 f.KeyDown(ch)
1519 ELSE Dialog.Beep
1520 END
1521 ELSE Dialog.Beep
1522 END
1523 ELSE
1524 f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
1525 END
1526 | msg: Controllers.SelectMsg DO
1527 IF msg.set THEN f.Select(0, MAX(INTEGER))
1528 ELSE f.Select(-1, -1)
1529 END
1530 | msg: Controllers.MarkMsg DO
1531 f.Mark(msg.show, msg.focus);
1532 IF ~msg.show & msg.focus THEN f.Update END;
1533 IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
1534 ELSE
1535 CatchCtrlMsg(c, f, msg, focus)
1536 END
1537 ELSIF ~c.disabled THEN
1538 WITH msg: Controllers.TrackMsg DO
1539 f.MouseDown(msg.x, msg.y, msg.modifiers)
1540 ELSE
1541 END
1542 END
1543 END
1544 END HandleCtrlMsg2;
1546 PROCEDURE (c: Field) HandlePropMsg2 (VAR msg: Properties.Message);
1547 BEGIN
1548 WITH msg: Properties.ControlPref DO
1549 IF msg.char = lineChar THEN msg.accepts := c.prop.opt[multiLine] & (msg.focus = c)
1550 ELSIF msg.char = esc THEN msg.accepts := FALSE
1551 END;
1552 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
1553 | msg: Properties.FocusPref DO
1554 IF ~c.disabled & ~c.readOnly THEN
1555 msg.setFocus := TRUE
1556 ELSIF~c.disabled THEN
1557 msg.hotFocus := TRUE
1558 END
1559 | msg: Properties.SizePref DO
1560 StdCFrames.dir.GetFieldSize(c.maxLen, msg.w, msg.h)
1561 | msg: PropPref DO
1562 msg.valid := {link, label, guard, level, notifier, left, right, multiLine, password}
1563 ELSE
1564 END
1565 END HandlePropMsg2;
1567 PROCEDURE (c: Field) CheckLink (VAR ok: BOOLEAN);
1568 VAR t: INTEGER; name: Meta.Name;
1569 BEGIN
1570 GetTypeName(c.item, name); t := c.item.typ;
1571 IF (t = Meta.arrTyp) & (c.item.BaseTyp() = Meta.charTyp) THEN c.maxLen := SHORT(c.item.Len() - 1)
1572 ELSIF t = Meta.byteTyp THEN c.maxLen := 6
1573 ELSIF t = Meta.sIntTyp THEN c.maxLen := 9
1574 ELSIF t = Meta.intTyp THEN c.maxLen := 13
1575 ELSIF t = Meta.longTyp THEN c.maxLen := 24
1576 ELSIF t = Meta.sRealTyp THEN c.maxLen := 16
1577 ELSIF t = Meta.realTyp THEN c.maxLen := 24
1578 ELSIF name = "Combo" THEN c.maxLen := 64
1579 ELSIF name = "Currency" THEN c.maxLen := 16
1580 ELSE ok := FALSE
1581 END
1582 END CheckLink;
1584 PROCEDURE (c: Field) Update (f: Views.Frame; op, from, to: INTEGER);
1585 BEGIN
1586 f(StdCFrames.Frame).Update
1587 END Update;
1590 (* UpDownField *)
1592 PROCEDURE GetUpDownField (f: StdCFrames.UpDownField; OUT val: INTEGER);
1593 VAR c: UpDownField;
1594 BEGIN
1595 val := 0;
1596 c := f.view(UpDownField);
1597 IF c.item.Valid() THEN val := c.item.IntVal() END
1598 END GetUpDownField;
1600 PROCEDURE SetUpDownField (f: StdCFrames.UpDownField; val: INTEGER);
1601 VAR c: UpDownField; old: INTEGER;
1602 BEGIN
1603 c := f.view(UpDownField);
1604 IF c.item.Valid() & ~c.readOnly THEN
1605 IF (val >= c.min) & (val <= c.max) THEN
1606 old := c.item.IntVal();
1607 IF old # val THEN c.item.PutIntVal(val); Notify(c, f, Dialog.changed, old, val) END
1608 ELSE Dialog.Beep
1609 END
1610 END
1611 END SetUpDownField;
1613 PROCEDURE (c: UpDownField) CopyFromSimpleView2 (source: Control);
1614 BEGIN
1615 WITH source: UpDownField DO
1616 c.min := source.min;
1617 c.max := source.max;
1618 c.inc := source.inc
1619 END
1620 END CopyFromSimpleView2;
1622 PROCEDURE (c: UpDownField) Internalize2 (VAR rd: Stores.Reader);
1623 VAR thisVersion: INTEGER;
1624 BEGIN
1625 rd.ReadVersion(minVersion, fldVersion, thisVersion)
1626 END Internalize2;
1628 PROCEDURE (c: UpDownField) Externalize2 (VAR wr: Stores.Writer);
1629 BEGIN
1630 wr.WriteVersion(fldVersion)
1631 END Externalize2;
1633 PROCEDURE (c: UpDownField) GetNewFrame (VAR frame: Views.Frame);
1634 VAR f: StdCFrames.UpDownField;
1635 BEGIN
1636 f := StdCFrames.dir.NewUpDownField();
1637 f.disabled := c.disabled;
1638 f.undef := c.undef;
1639 f.readOnly := c.readOnly;
1640 f.font := c.font;
1641 f.min := c.min;
1642 f.max := c.max;
1643 f.inc := c.inc;
1644 f.Get := GetUpDownField;
1645 f.Set := SetUpDownField;
1646 frame := f
1647 END GetNewFrame;
1649 PROCEDURE (c: UpDownField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
1650 BEGIN
1651 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
1652 END Restore;
1654 PROCEDURE (c: UpDownField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
1655 VAR focus: Views.View);
1656 VAR ch: CHAR;
1657 BEGIN
1658 IF ~c.disabled & ~c.readOnly THEN
1659 WITH f: StdCFrames.UpDownField DO
1660 WITH msg: Controllers.PollOpsMsg DO
1661 msg.selectable := TRUE;
1662 (* should ask view if there is a selection for cut or copy! *)
1663 msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
1664 | msg: Controllers.TickMsg DO
1665 f.Idle
1666 | msg: Controllers.EditMsg DO
1667 IF msg.op = Controllers.pasteChar THEN
1668 ch := msg.char;
1669 IF (ch = ldel) OR (ch = rdel) OR (ch >= 10X) & (ch <= 1FX)
1670 OR ("0" <= ch) & (ch <= "9") OR (ch = "+") OR (ch = "-")
1671 OR (c.item.typ = Meta.arrTyp)
1672 THEN f.KeyDown(ch)
1673 ELSE Dialog.Beep
1674 END
1675 ELSE
1676 f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
1677 END
1678 | msg: Controllers.SelectMsg DO
1679 IF msg.set THEN f.Select(0, MAX(INTEGER))
1680 ELSE f.Select(-1, -1)
1681 END
1682 | msg: Controllers.MarkMsg DO
1683 f.Mark(msg.show, msg.focus);
1684 IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
1685 ELSE
1686 CatchCtrlMsg(c, f, msg, focus)
1687 END
1688 END
1689 END
1690 END HandleCtrlMsg2;
1692 PROCEDURE (c: UpDownField) HandlePropMsg2 (VAR msg: Properties.Message);
1693 VAR m: INTEGER; n: INTEGER;
1694 BEGIN
1695 WITH msg: Properties.ControlPref DO
1696 IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
1697 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
1698 | msg: Properties.FocusPref DO
1699 IF ~c.disabled & ~c.readOnly THEN
1700 msg.setFocus := TRUE
1701 END
1702 | msg: Properties.SizePref DO
1703 m := -c.min;
1704 IF c.max > m THEN m := c.max END;
1705 n := 3;
1706 WHILE m > 99 DO INC(n); m := m DIV 10 END;
1707 StdCFrames.dir.GetUpDownFieldSize(n, msg.w, msg.h)
1708 | msg: PropPref DO
1709 msg.valid := {link, label, guard, notifier}
1710 ELSE
1711 END
1712 END HandlePropMsg2;
1714 PROCEDURE (c: UpDownField) CheckLink (VAR ok: BOOLEAN);
1715 BEGIN
1716 IF c.item.typ = Meta.byteTyp THEN c.min := MIN(BYTE); c.max := MAX(BYTE)
1717 ELSIF c.item.typ = Meta.sIntTyp THEN c.min := MIN(SHORTINT); c.max := MAX(SHORTINT)
1718 ELSIF c.item.typ = Meta.intTyp THEN c.min := MIN(INTEGER); c.max := MAX(INTEGER)
1719 ELSE ok := FALSE
1720 END;
1721 c.inc := 1
1722 END CheckLink;
1724 PROCEDURE (c: UpDownField) Update (f: Views.Frame; op, from, to: INTEGER);
1725 BEGIN
1726 f(StdCFrames.Frame).Update
1727 END Update;
1730 (* DateField *)
1732 PROCEDURE GetDateField (f: StdCFrames.DateField; OUT date: Dates.Date);
1733 VAR c: DateField; v: Meta.Item;
1734 BEGIN
1735 date.year := 1; date.month := 1; date.day := 1;
1736 c := f.view(DateField);
1737 IF c.item.Valid() THEN
1738 c.item.Lookup("year", v); IF v.typ = Meta.intTyp THEN date.year := SHORT(v.IntVal()) END;
1739 c.item.Lookup("month", v); IF v.typ = Meta.intTyp THEN date.month := SHORT(v.IntVal()) END;
1740 c.item.Lookup("day", v); IF v.typ = Meta.intTyp THEN date.day := SHORT(v.IntVal()) END
1741 END
1742 END GetDateField;
1744 PROCEDURE SetDateField(f: StdCFrames.DateField; IN date: Dates.Date);
1745 VAR c: DateField; v: Meta.Item;
1746 BEGIN
1747 c := f.view(DateField);
1748 IF c.item.Valid() & ~c.readOnly THEN
1749 c.item.Lookup("year", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.year) END;
1750 c.item.Lookup("month", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.month) END;
1751 c.item.Lookup("day", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.day) END;
1752 Notify(c, f, Dialog.changed, 0, 0)
1753 END
1754 END SetDateField;
1756 PROCEDURE GetDateFieldSelection (f: StdCFrames.DateField; OUT sel: INTEGER);
1757 BEGIN
1758 sel := f.view(DateField).selection
1759 END GetDateFieldSelection;
1761 PROCEDURE SetDateFieldSelection (f: StdCFrames.DateField; sel: INTEGER);
1762 BEGIN
1763 f.view(DateField).selection := sel
1764 END SetDateFieldSelection;
1766 PROCEDURE (c: DateField) CopyFromSimpleView2 (source: Control);
1767 BEGIN
1768 WITH source: DateField DO c.selection := source.selection END
1769 END CopyFromSimpleView2;
1771 PROCEDURE (c: DateField) Internalize2 (VAR rd: Stores.Reader);
1772 VAR thisVersion: INTEGER;
1773 BEGIN
1774 rd.ReadVersion(minVersion, dfldVersion, thisVersion);
1775 c.selection := 0
1776 END Internalize2;
1778 PROCEDURE (c: DateField) Externalize2 (VAR wr: Stores.Writer);
1779 BEGIN
1780 wr.WriteVersion(dfldVersion)
1781 END Externalize2;
1783 PROCEDURE (c: DateField) GetNewFrame (VAR frame: Views.Frame);
1784 VAR f: StdCFrames.DateField;
1785 BEGIN
1786 f := StdCFrames.dir.NewDateField();
1787 f.disabled := c.disabled;
1788 f.undef := c.undef;
1789 f.readOnly := c.readOnly;
1790 f.font := c.font;
1791 f.Get := GetDateField;
1792 f.Set := SetDateField;
1793 f.GetSel := GetDateFieldSelection;
1794 f.SetSel := SetDateFieldSelection;
1795 frame := f
1796 END GetNewFrame;
1798 PROCEDURE (c: DateField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
1799 BEGIN
1800 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
1801 END Restore;
1803 PROCEDURE (c: DateField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
1804 VAR focus: Views.View);
1805 BEGIN
1806 IF ~c.disabled & ~c.readOnly THEN
1807 WITH f: StdCFrames.DateField DO
1808 WITH msg: Controllers.PollOpsMsg DO
1809 msg.valid := {Controllers.pasteChar, Controllers.copy}
1810 | msg: Controllers.EditMsg DO
1811 IF msg.op = Controllers.pasteChar THEN
1812 f.KeyDown(msg.char)
1813 ELSE
1814 f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
1815 END
1816 | msg: Controllers.TickMsg DO
1817 IF f.mark THEN
1818 IF c.selection = 0 THEN c.selection := 1; Views.Update(c, Views.keepFrames) END
1819 END
1820 ELSE
1821 CatchCtrlMsg(c, f, msg, focus)
1822 END
1823 END
1824 END
1825 END HandleCtrlMsg2;
1827 PROCEDURE (c: DateField) HandlePropMsg2 (VAR msg: Properties.Message);
1828 BEGIN
1829 WITH msg: Properties.ControlPref DO
1830 IF (msg.char = lineChar) OR (msg.char = esc) THEN
1831 msg.accepts := FALSE
1832 ELSIF (msg.char = tab) OR (msg.char = ltab) THEN
1833 msg.accepts := ((msg.focus # c) & (~c.disabled & ~c.readOnly)) OR
1834 (msg.focus = c) & ((msg.char = tab) & (c.selection # -1) OR (msg.char = ltab) & (c.selection # 1));
1835 msg.getFocus := msg.accepts
1836 END;
1837 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
1838 | msg: Properties.FocusPref DO
1839 IF ~c.disabled & ~c.readOnly THEN
1840 msg.setFocus := TRUE
1841 END
1842 | msg: Properties.SizePref DO
1843 StdCFrames.dir.GetDateFieldSize(msg.w, msg.h)
1844 | msg: PropPref DO
1845 msg.valid := {link, label, guard, notifier}
1846 ELSE
1847 END
1848 END HandlePropMsg2;
1850 PROCEDURE (c: DateField) CheckLink (VAR ok: BOOLEAN);
1851 VAR name: Meta.Name;
1852 BEGIN
1853 GetTypeName(c.item, name);
1854 ok := name = "Date"
1855 END CheckLink;
1857 PROCEDURE (c: DateField) Update (f: Views.Frame; op, from, to: INTEGER);
1858 BEGIN
1859 f(StdCFrames.Frame).Update
1860 END Update;
1863 (* TimeField *)
1865 PROCEDURE GetTimeField (f: StdCFrames.TimeField; OUT time: Dates.Time);
1866 VAR c: TimeField; v: Meta.Item;
1867 BEGIN
1868 time.hour := 0; time.minute := 0; time.second := 0;
1869 c := f.view(TimeField);
1870 IF c.item.Valid() THEN
1871 c.item.Lookup("hour", v); IF v.typ = Meta.intTyp THEN time.hour := SHORT(v.IntVal()) END;
1872 c.item.Lookup("minute", v); IF v.typ = Meta.intTyp THEN time.minute := SHORT(v.IntVal()) END;
1873 c.item.Lookup("second", v); IF v.typ = Meta.intTyp THEN time.second := SHORT(v.IntVal()) END
1874 END
1875 END GetTimeField;
1877 PROCEDURE SetTimeField(f: StdCFrames.TimeField; IN date: Dates.Time);
1878 VAR c: TimeField; v: Meta.Item;
1879 BEGIN
1880 c := f.view(TimeField);
1881 IF c.item.Valid() & ~c.readOnly THEN
1882 c.item.Lookup("hour", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.hour) END;
1883 c.item.Lookup("minute", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.minute) END;
1884 c.item.Lookup("second", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.second) END;
1885 Notify(c, f, Dialog.changed, 0, 0)
1886 END
1887 END SetTimeField;
1889 PROCEDURE GetTimeFieldSelection (f: StdCFrames.TimeField; OUT sel: INTEGER);
1890 BEGIN
1891 sel := f.view(TimeField).selection
1892 END GetTimeFieldSelection;
1894 PROCEDURE SetTimeFieldSelection (f: StdCFrames.TimeField; sel: INTEGER);
1895 BEGIN
1896 f.view(TimeField).selection := sel
1897 END SetTimeFieldSelection;
1899 PROCEDURE (c: TimeField) CopyFromSimpleView2 (source: Control);
1900 BEGIN
1901 WITH source: TimeField DO c.selection := source.selection END
1902 END CopyFromSimpleView2;
1904 PROCEDURE (c: TimeField) Internalize2 (VAR rd: Stores.Reader);
1905 VAR thisVersion: INTEGER;
1906 BEGIN
1907 rd.ReadVersion(minVersion, tfldVersion, thisVersion);
1908 c.selection := 0
1909 END Internalize2;
1911 PROCEDURE (c: TimeField) Externalize2 (VAR wr: Stores.Writer);
1912 BEGIN
1913 wr.WriteVersion(tfldVersion)
1914 END Externalize2;
1916 PROCEDURE (c: TimeField) GetNewFrame (VAR frame: Views.Frame);
1917 VAR f: StdCFrames.TimeField;
1918 BEGIN
1919 f := StdCFrames.dir.NewTimeField();
1920 f.disabled := c.disabled;
1921 f.undef := c.undef;
1922 f.readOnly := c.readOnly;
1923 f.font := c.font;
1924 f.Get := GetTimeField;
1925 f.Set := SetTimeField;
1926 f.GetSel := GetTimeFieldSelection;
1927 f.SetSel := SetTimeFieldSelection;
1928 frame := f
1929 END GetNewFrame;
1931 PROCEDURE (c: TimeField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
1932 BEGIN
1933 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
1934 END Restore;
1936 PROCEDURE (c: TimeField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
1937 VAR focus: Views.View);
1938 BEGIN
1939 IF ~c.disabled & ~c.readOnly THEN
1940 WITH f: StdCFrames.TimeField DO
1941 WITH msg: Controllers.PollOpsMsg DO
1942 msg.valid := {Controllers.pasteChar, Controllers.copy}
1943 | msg: Controllers.EditMsg DO
1944 IF msg.op = Controllers.pasteChar THEN
1945 f.KeyDown(msg.char)
1946 ELSE
1947 f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
1948 END
1949 | msg: Controllers.TickMsg DO
1950 IF f.mark THEN
1951 IF c.selection = 0 THEN c.selection := 1; Views.Update(c, Views.keepFrames) END
1952 END
1953 ELSE
1954 CatchCtrlMsg(c, f, msg, focus)
1955 END
1956 END
1957 END
1958 END HandleCtrlMsg2;
1960 PROCEDURE (c: TimeField) HandlePropMsg2 (VAR msg: Properties.Message);
1961 BEGIN
1962 WITH msg: Properties.ControlPref DO
1963 IF (msg.char = lineChar) OR (msg.char = esc) THEN
1964 msg.accepts := FALSE
1965 ELSIF (msg.char = tab) OR (msg.char = ltab) THEN
1966 msg.accepts := (msg.focus # c) OR
1967 ((msg.char = tab) & (c.selection # -1)) OR ((msg.char = ltab) & (c.selection # 1))
1968 END;
1969 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
1970 | msg: Properties.FocusPref DO
1971 IF ~c.disabled & ~c.readOnly THEN
1972 msg.setFocus := TRUE
1973 END
1974 | msg: Properties.SizePref DO
1975 StdCFrames.dir.GetTimeFieldSize(msg.w, msg.h)
1976 | msg: PropPref DO
1977 msg.valid := {link, label, guard, notifier}
1978 ELSE
1979 END
1980 END HandlePropMsg2;
1982 PROCEDURE (c: TimeField) CheckLink (VAR ok: BOOLEAN);
1983 VAR name: Meta.Name;
1984 BEGIN
1985 GetTypeName(c.item, name);
1986 ok := name = "Time"
1987 END CheckLink;
1989 PROCEDURE (c: TimeField) Update (f: Views.Frame; op, from, to: INTEGER);
1990 BEGIN
1991 f(StdCFrames.Frame).Update
1992 END Update;
1995 (* ColorField *)
1997 PROCEDURE GetColorField (f: StdCFrames.ColorField; OUT col: INTEGER);
1998 VAR c: ColorField; v: Meta.Item;
1999 BEGIN
2000 col := Ports.defaultColor;
2001 c := f.view(ColorField);
2002 IF c.item.Valid() THEN
2003 IF c.item.typ = Meta.intTyp THEN
2004 col := c.item.IntVal()
2005 ELSE
2006 c.item.Lookup("val", v); IF v.typ = Meta.intTyp THEN col := v.IntVal() END
2007 END
2008 END
2009 END GetColorField;
2011 PROCEDURE SetColorField(f: StdCFrames.ColorField; col: INTEGER);
2012 VAR c: ColorField; v: Meta.Item; old: INTEGER;
2013 BEGIN
2014 c := f.view(ColorField);
2015 IF c.item.Valid() & ~c.readOnly THEN
2016 IF c.item.typ = Meta.intTyp THEN
2017 old := c.item.IntVal();
2018 IF old # col THEN c.item.PutIntVal(col); Notify(c, f, Dialog.changed, old, col) END
2019 ELSE
2020 c.item.Lookup("val", v);
2021 IF v.typ = Meta.intTyp THEN
2022 old := v.IntVal();
2023 IF old # col THEN v.PutIntVal(col); Notify(c, f, Dialog.changed, old, col) END
2024 END
2025 END
2026 END
2027 END SetColorField;
2029 PROCEDURE (c: ColorField) Internalize2 (VAR rd: Stores.Reader);
2030 VAR thisVersion: INTEGER;
2031 BEGIN
2032 rd.ReadVersion(minVersion, cfldVersion, thisVersion)
2033 END Internalize2;
2035 PROCEDURE (c: ColorField) Externalize2 (VAR wr: Stores.Writer);
2036 BEGIN
2037 wr.WriteVersion(cfldVersion)
2038 END Externalize2;
2040 PROCEDURE (c: ColorField) GetNewFrame (VAR frame: Views.Frame);
2041 VAR f: StdCFrames.ColorField;
2042 BEGIN
2043 f := StdCFrames.dir.NewColorField();
2044 f.disabled := c.disabled;
2045 f.undef := c.undef;
2046 f.readOnly := c.readOnly;
2047 f.font := c.font;
2048 f.Get := GetColorField;
2049 f.Set := SetColorField;
2050 frame := f
2051 END GetNewFrame;
2053 PROCEDURE (c: ColorField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
2054 BEGIN
2055 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
2056 END Restore;
2058 PROCEDURE (c: ColorField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
2059 VAR focus: Views.View);
2060 BEGIN
2061 IF ~c.disabled & ~c.readOnly THEN
2062 WITH f: StdCFrames.ColorField DO
2063 WITH msg: Controllers.EditMsg DO
2064 IF msg.op = Controllers.pasteChar THEN
2065 f.KeyDown(msg.char)
2066 ELSE
2067 f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
2068 END
2069 ELSE
2070 CatchCtrlMsg(c, f, msg, focus)
2071 END
2072 END
2073 END
2074 END HandleCtrlMsg2;
2076 PROCEDURE (c: ColorField) HandlePropMsg2 (VAR msg: Properties.Message);
2077 BEGIN
2078 WITH msg: Properties.ControlPref DO
2079 msg.accepts := ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c)
2080 | msg: Properties.FocusPref DO
2081 IF ~c.disabled & ~c.readOnly THEN
2082 msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
2083 END
2084 | msg: Properties.SizePref DO
2085 StdCFrames.dir.GetColorFieldSize(msg.w, msg.h)
2086 ELSE
2087 END
2088 END HandlePropMsg2;
2090 PROCEDURE (c: ColorField) CheckLink (VAR ok: BOOLEAN);
2091 VAR name: Meta.Name;
2092 BEGIN
2093 GetTypeName(c.item, name);
2094 ok := (name = "Color") OR (c.item.typ = Meta.intTyp)
2095 END CheckLink;
2097 PROCEDURE (c: ColorField) Update (f: Views.Frame; op, from, to: INTEGER);
2098 BEGIN
2099 f(StdCFrames.Frame).Update
2100 END Update;
2103 (* ListBox *)
2105 PROCEDURE GetListBox (f: StdCFrames.ListBox; OUT i: INTEGER);
2106 VAR c: ListBox; v: Meta.Item;
2107 BEGIN
2108 i := -1;
2109 c := f.view(ListBox);
2110 IF c.item.Valid() THEN
2111 c.item.Lookup("index", v);
2112 IF v.typ = Meta.intTyp THEN i := v.IntVal() END
2113 END
2114 END GetListBox;
2116 PROCEDURE SetListBox (f: StdCFrames.ListBox; i: INTEGER);
2117 VAR c: ListBox; v: Meta.Item; old: INTEGER;
2118 BEGIN
2119 c := f.view(ListBox);
2120 IF c.item.Valid() & ~c.readOnly THEN
2121 c.item.Lookup("index", v);
2122 IF v.typ = Meta.intTyp THEN
2123 old := v.IntVal();
2124 IF i # old THEN v.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
2125 END
2126 END
2127 END SetListBox;
2129 PROCEDURE GetFName (VAR rec, par: ANYREC);
2130 BEGIN
2131 WITH par: Param DO
2132 WITH rec: Dialog.List DO rec.GetItem(par.i, par.n)
2133 | rec: Dialog.Selection DO rec.GetItem(par.i, par.n)
2134 | rec: Dialog.Combo DO rec.GetItem(par.i, par.n)
2135 ELSE par.n := ""
2136 END
2137 END
2138 END GetFName;
2140 PROCEDURE GetListName (f: StdCFrames.ListBox; i: INTEGER; VAR name: ARRAY OF CHAR);
2141 VAR c: ListBox; par: Param;
2142 BEGIN
2143 par.n := "";
2144 c := f.view(ListBox);
2145 IF c.item.Valid() THEN
2146 par.i := i;
2147 c.item.CallWith(GetFName, par)
2148 END;
2149 name := par.n$
2150 END GetListName;
2152 PROCEDURE (c: ListBox) Internalize2 (VAR rd: Stores.Reader);
2153 VAR thisVersion: INTEGER;
2154 BEGIN
2155 rd.ReadVersion(minVersion, lbxVersion, thisVersion)
2156 END Internalize2;
2158 PROCEDURE (c: ListBox) Externalize2 (VAR wr: Stores.Writer);
2159 BEGIN
2160 wr.WriteVersion(lbxVersion)
2161 END Externalize2;
2163 PROCEDURE (c: ListBox) GetNewFrame (VAR frame: Views.Frame);
2164 VAR f: StdCFrames.ListBox;
2165 BEGIN
2166 f := StdCFrames.dir.NewListBox();
2167 f.disabled := c.disabled;
2168 f.undef := c.undef;
2169 f.readOnly := c.readOnly;
2170 f.font := c.font;
2171 f.sorted := c.prop.opt[sorted];
2172 f.Get := GetListBox;
2173 f.Set := SetListBox;
2174 f.GetName := GetListName;
2175 frame := f
2176 END GetNewFrame;
2178 PROCEDURE (c: ListBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
2179 BEGIN
2180 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
2181 END Restore;
2183 PROCEDURE (c: ListBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
2184 VAR focus: Views.View);
2185 BEGIN
2186 WITH f: StdCFrames.ListBox DO
2187 IF ~c.disabled & ~c.readOnly THEN
2188 WITH msg: Controllers.EditMsg DO
2189 IF msg.op = Controllers.pasteChar THEN f.KeyDown(msg.char) END
2190 ELSE
2191 CatchCtrlMsg(c, f, msg, focus)
2192 END
2193 ELSIF ~c.disabled THEN
2194 WITH msg: Controllers.TrackMsg DO
2195 f.MouseDown(msg.x, msg.y, msg.modifiers)
2196 ELSE
2197 END
2198 END
2199 END
2200 END HandleCtrlMsg2;
2202 PROCEDURE (c: ListBox) HandlePropMsg2 (VAR msg: Properties.Message);
2203 BEGIN
2204 WITH msg: Properties.ControlPref DO
2205 IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
2206 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
2207 | msg: Properties.FocusPref DO
2208 IF ~c.disabled & ~c.readOnly THEN
2209 msg.setFocus := TRUE
2210 ELSIF~c.disabled THEN
2211 msg.hotFocus := TRUE
2212 END
2213 | msg: Properties.SizePref DO
2214 StdCFrames.dir.GetListBoxSize(msg.w, msg.h)
2215 | msg: PropPref DO
2216 msg.valid := {link, label, guard, notifier, sorted}
2217 ELSE
2218 END
2219 END HandlePropMsg2;
2221 PROCEDURE (c: ListBox) CheckLink (VAR ok: BOOLEAN);
2222 VAR name: Meta.Name;
2223 BEGIN
2224 GetTypeName(c.item, name);
2225 ok := name = "List"
2226 END CheckLink;
2228 PROCEDURE (c: ListBox) Update (f: Views.Frame; op, from, to: INTEGER);
2229 BEGIN
2230 f(StdCFrames.Frame).Update
2231 END Update;
2233 PROCEDURE (c: ListBox) UpdateList (f: Views.Frame);
2234 BEGIN
2235 f(StdCFrames.Frame).UpdateList
2236 END UpdateList;
2239 (* SelectionBox *)
2241 PROCEDURE InLargeSet (VAR rec, par: ANYREC);
2242 BEGIN
2243 WITH par: Param DO
2244 WITH rec: Dialog.Selection DO
2245 IF rec.In(par.i) THEN par.i := 1 ELSE par.i := 0 END
2246 ELSE par.i := 0
2247 END
2248 END
2249 END InLargeSet;
2251 PROCEDURE GetSelectionBox (f: StdCFrames.SelectionBox; i: INTEGER; OUT in: BOOLEAN);
2252 VAR c: SelectionBox; lv: SelectValue; par: Param;
2253 BEGIN
2254 in := FALSE;
2255 c := f.view(SelectionBox);
2256 IF c.item.Valid() THEN
2257 IF c.item.Is(lv) THEN
2258 par.i := i;
2259 c.item.CallWith(InLargeSet, par);
2260 in := par.i # 0
2261 END
2262 END
2263 END GetSelectionBox;
2265 PROCEDURE InclLargeSet (VAR rec, par: ANYREC);
2266 BEGIN
2267 WITH par: Param DO
2268 WITH rec: Dialog.Selection DO
2269 IF (par.from # par.to) OR ~rec.In(par.from) THEN
2270 rec.Incl(par.from, par.to); par.i := 1
2271 ELSE par.i := 0
2272 END
2273 ELSE par.i := 0
2274 END
2275 END
2276 END InclLargeSet;
2278 PROCEDURE InclSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
2279 VAR c: SelectionBox; lv: SelectValue; par: Param;
2280 BEGIN
2281 c := f.view(SelectionBox);
2282 IF c.item.Valid() & ~c.readOnly THEN
2283 IF c.item.Is(lv) THEN
2284 par.from := from; par.to := to;
2285 c.item.CallWith(InclLargeSet, par);
2286 IF par.i # 0 THEN Notify(c, f, Dialog.included, from, to) END
2287 END
2288 END
2289 END InclSelectionBox;
2291 PROCEDURE ExclLargeSet (VAR rec, par: ANYREC);
2292 BEGIN
2293 WITH par: Param DO
2294 WITH rec: Dialog.Selection DO
2295 IF (par.from # par.to) OR rec.In(par.from) THEN
2296 rec.Excl(par.from, par.to); par.i := 1
2297 ELSE par.i := 0
2298 END
2299 ELSE par.i := 0
2300 END
2301 END
2302 END ExclLargeSet;
2304 PROCEDURE ExclSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
2305 VAR c: SelectionBox; lv: SelectValue; par: Param;
2306 BEGIN
2307 c := f.view(SelectionBox);
2308 IF c.item.Valid() & ~c.readOnly THEN
2309 IF c.item.Is(lv) THEN
2310 par.from := from; par.to := to;
2311 c.item.CallWith(ExclLargeSet, par);
2312 IF par.i # 0 THEN Notify(c, f, Dialog.excluded, from, to) END
2313 END
2314 END
2315 END ExclSelectionBox;
2317 PROCEDURE SetSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
2318 VAR c: SelectionBox; lv: SelectValue; par: Param;
2319 BEGIN
2320 c := f.view(SelectionBox);
2321 IF c.item.Valid() & ~c.readOnly THEN
2322 IF c.item.Is(lv) THEN
2323 par.from := 0; par.to := MAX(INTEGER);
2324 c.item.CallWith(ExclLargeSet, par);
2325 par.from := from; par.to := to;
2326 c.item.CallWith(InclLargeSet, par);
2327 Notify(c, f, Dialog.set, from, to)
2328 END
2329 END
2330 END SetSelectionBox;
2332 PROCEDURE GetSelName (f: StdCFrames.SelectionBox; i: INTEGER; VAR name: ARRAY OF CHAR);
2333 VAR c: SelectionBox; par: Param;
2334 BEGIN
2335 par.n := "";
2336 c := f.view(SelectionBox);
2337 IF c.item.Valid() THEN
2338 par.i := i;
2339 c.item.CallWith(GetFName, par)
2340 END;
2341 name := par.n$
2342 END GetSelName;
2344 PROCEDURE (c: SelectionBox) Internalize2 (VAR rd: Stores.Reader);
2345 VAR thisVersion: INTEGER;
2346 BEGIN
2347 rd.ReadVersion(minVersion, sbxVersion, thisVersion)
2348 END Internalize2;
2350 PROCEDURE (c: SelectionBox) Externalize2 (VAR wr: Stores.Writer);
2351 BEGIN
2352 wr.WriteVersion(sbxVersion)
2353 END Externalize2;
2355 PROCEDURE (c: SelectionBox) GetNewFrame (VAR frame: Views.Frame);
2356 VAR f: StdCFrames.SelectionBox;
2357 BEGIN
2358 f := StdCFrames.dir.NewSelectionBox();
2359 f.disabled := c.disabled;
2360 f.undef := c.undef;
2361 f.readOnly := c.readOnly;
2362 f.font := c.font;
2363 f.sorted := c.prop.opt[sorted];
2364 f.Get := GetSelectionBox;
2365 f.Incl := InclSelectionBox;
2366 f.Excl := ExclSelectionBox;
2367 f.Set := SetSelectionBox;
2368 f.GetName := GetSelName;
2369 frame := f
2370 END GetNewFrame;
2372 PROCEDURE (c: SelectionBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
2373 BEGIN
2374 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
2375 END Restore;
2377 PROCEDURE (c: SelectionBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
2378 VAR focus: Views.View);
2379 BEGIN
2380 WITH f: StdCFrames.SelectionBox DO
2381 IF ~c.disabled & ~c.readOnly THEN
2382 WITH msg: Controllers.EditMsg DO
2383 IF msg.op = Controllers.pasteChar THEN f.KeyDown(msg.char) END
2384 | msg: Controllers.SelectMsg DO
2385 IF msg.set THEN f.Select(0, MAX(INTEGER))
2386 ELSE f.Select(-1, -1)
2387 END
2388 ELSE
2389 CatchCtrlMsg(c, f, msg, focus)
2390 END
2391 ELSIF ~c.disabled THEN
2392 WITH msg: Controllers.TrackMsg DO
2393 f.MouseDown(msg.x, msg.y, msg.modifiers)
2394 ELSE
2395 END
2396 END
2397 END
2398 END HandleCtrlMsg2;
2400 PROCEDURE (c: SelectionBox) HandlePropMsg2 (VAR msg: Properties.Message);
2401 BEGIN
2402 WITH msg: Properties.ControlPref DO
2403 IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
2404 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) OR msg.getFocus THEN
2405 msg.getFocus := StdCFrames.setFocus
2406 END
2407 | msg: Properties.FocusPref DO
2408 IF ~c.disabled & ~c.readOnly THEN
2409 msg.setFocus := TRUE
2410 ELSIF~c.disabled THEN
2411 msg.hotFocus := TRUE
2412 END
2413 | msg: Properties.SizePref DO
2414 StdCFrames.dir.GetSelectionBoxSize(msg.w, msg.h)
2415 | msg: PropPref DO
2416 msg.valid := {link, label, guard, notifier, sorted}
2417 ELSE
2418 END
2419 END HandlePropMsg2;
2421 PROCEDURE (c: SelectionBox) CheckLink (VAR ok: BOOLEAN);
2422 VAR name: Meta.Name;
2423 BEGIN
2424 GetTypeName(c.item, name);
2425 ok := name = "Selection"
2426 END CheckLink;
2428 PROCEDURE (c: SelectionBox) Update (f: Views.Frame; op, from, to: INTEGER);
2429 BEGIN
2430 IF (op >= Dialog.included) & (op <= Dialog.set) THEN
2431 f(StdCFrames.SelectionBox).UpdateRange(op, from, to)
2432 ELSE
2433 f(StdCFrames.Frame).Update
2434 END
2435 END Update;
2437 PROCEDURE (c: SelectionBox) UpdateList (f: Views.Frame);
2438 BEGIN
2439 f(StdCFrames.Frame).UpdateList
2440 END UpdateList;
2443 (* ComboBox *)
2445 PROCEDURE GetComboBox (f: StdCFrames.ComboBox; OUT x: ARRAY OF CHAR);
2446 VAR c: ComboBox; ok: BOOLEAN; v: Meta.Item;
2447 BEGIN
2448 x := "";
2449 c := f.view(ComboBox);
2450 IF c.item.Valid() THEN
2451 c.item.Lookup("item", v);
2452 IF v.typ = Meta.arrTyp THEN v.GetStringVal(x, ok) END
2453 END
2454 END GetComboBox;
2456 PROCEDURE SetComboBox (f: StdCFrames.ComboBox; IN x: ARRAY OF CHAR);
2457 VAR c: ComboBox; ok: BOOLEAN; v: Meta.Item; s: ARRAY 1024 OF CHAR;
2458 BEGIN
2459 c := f.view(ComboBox);
2460 IF c.item.Valid() & ~c.readOnly THEN
2461 c.item.Lookup("item", v);
2462 IF v.typ = Meta.arrTyp THEN
2463 v.GetStringVal(s, ok);
2464 IF ~ok OR (s$ # x$) THEN
2465 v.PutStringVal(x, ok);
2466 IF ok THEN Notify(c, f, Dialog.changed, 0, 0) END
2467 END
2468 END
2469 END
2470 END SetComboBox;
2472 PROCEDURE GetComboName (f: StdCFrames.ComboBox; i: INTEGER; VAR name: ARRAY OF CHAR);
2473 VAR c: ComboBox; par: Param;
2474 BEGIN
2475 par.n := "";
2476 c := f.view(ComboBox);
2477 IF c.item.Valid() THEN
2478 par.i := i;
2479 c.item.CallWith(GetFName, par)
2480 END;
2481 name := par.n$
2482 END GetComboName;
2484 PROCEDURE (c: ComboBox) Internalize2 (VAR rd: Stores.Reader);
2485 VAR thisVersion: INTEGER;
2486 BEGIN
2487 rd.ReadVersion(minVersion, cbxVersion, thisVersion)
2488 END Internalize2;
2490 PROCEDURE (c: ComboBox) Externalize2 (VAR wr: Stores.Writer);
2491 BEGIN
2492 wr.WriteVersion(cbxVersion)
2493 END Externalize2;
2495 PROCEDURE (c: ComboBox) GetNewFrame (VAR frame: Views.Frame);
2496 VAR f: StdCFrames.ComboBox;
2497 BEGIN
2498 f := StdCFrames.dir.NewComboBox();
2499 f.disabled := c.disabled;
2500 f.undef := c.undef;
2501 f.readOnly := c.readOnly;
2502 f.font := c.font;
2503 f.sorted := c.prop.opt[sorted];
2504 f.Get := GetComboBox;
2505 f.Set := SetComboBox;
2506 f.GetName := GetComboName;
2507 frame := f
2508 END GetNewFrame;
2510 PROCEDURE (c: ComboBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
2511 BEGIN
2512 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
2513 END Restore;
2515 PROCEDURE (c: ComboBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
2516 VAR focus: Views.View);
2517 BEGIN
2518 WITH f: StdCFrames.ComboBox DO
2519 IF ~c.disabled & ~c.readOnly THEN
2520 WITH msg: Controllers.PollOpsMsg DO
2521 msg.selectable := TRUE;
2522 (* should ask Frame if there is a selection for cut or copy! *)
2523 msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
2524 | msg: Controllers.TickMsg DO
2525 f.Idle
2526 | msg: Controllers.EditMsg DO
2527 IF msg.op = Controllers.pasteChar THEN
2528 f.KeyDown(msg.char)
2529 ELSE
2530 f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
2531 END
2532 | msg: Controllers.SelectMsg DO
2533 IF msg.set THEN f.Select(0, MAX(INTEGER))
2534 ELSE f.Select(-1, -1)
2535 END
2536 | msg: Controllers.MarkMsg DO
2537 f.Mark(msg.show, msg.focus);
2538 IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
2539 | msg: Controllers.TrackMsg DO
2540 f.MouseDown(msg.x, msg.y, msg.modifiers)
2541 ELSE
2542 CatchCtrlMsg(c, f, msg, focus)
2543 END
2544 END
2545 END
2546 END HandleCtrlMsg2;
2548 PROCEDURE (c: ComboBox) HandlePropMsg2 (VAR msg: Properties.Message);
2549 BEGIN
2550 WITH msg: Properties.ControlPref DO
2551 IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
2552 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
2553 | msg: Properties.FocusPref DO
2554 IF ~c.disabled & ~c.readOnly THEN
2555 msg.setFocus := TRUE
2556 END
2557 | msg: Properties.SizePref DO
2558 StdCFrames.dir.GetComboBoxSize(msg.w, msg.h)
2559 | msg: PropPref DO
2560 msg.valid := {link, label, guard, notifier, sorted}
2561 ELSE
2562 END
2563 END HandlePropMsg2;
2565 PROCEDURE (c: ComboBox) CheckLink (VAR ok: BOOLEAN);
2566 VAR name: Meta.Name;
2567 BEGIN
2568 GetTypeName(c.item, name);
2569 ok := name = "Combo"
2570 END CheckLink;
2572 PROCEDURE (c: ComboBox) Update (f: Views.Frame; op, from, to: INTEGER);
2573 BEGIN
2574 f(StdCFrames.Frame).Update
2575 END Update;
2577 PROCEDURE (c: ComboBox) UpdateList (f: Views.Frame);
2578 BEGIN
2579 f(StdCFrames.Frame).UpdateList
2580 END UpdateList;
2583 (* Caption *)
2585 PROCEDURE (c: Caption) Internalize2 (VAR rd: Stores.Reader);
2586 VAR thisVersion: INTEGER;
2587 BEGIN
2588 rd.ReadVersion(minVersion, capVersion, thisVersion);
2589 IF thisVersion < 1 THEN c.prop.opt[left] := TRUE END
2590 END Internalize2;
2592 PROCEDURE (c: Caption) Externalize2 (VAR wr: Stores.Writer);
2593 BEGIN
2594 (* Save old version for captions that are compatible with the old version *)
2595 IF c.prop.opt[left] THEN wr.WriteVersion(0) ELSE wr.WriteVersion(capVersion) END
2596 END Externalize2;
2598 PROCEDURE (c: Caption) GetNewFrame (VAR frame: Views.Frame);
2599 VAR f: StdCFrames.Caption;
2600 BEGIN
2601 f := StdCFrames.dir.NewCaption();
2602 f.disabled := c.disabled;
2603 f.undef := c.undef;
2604 f.readOnly := c.readOnly;
2605 f.font := c.font;
2606 f.label := c.label$;
2607 f.left := c.prop.opt[left];
2608 f.right := c.prop.opt[right];
2609 frame := f
2610 END GetNewFrame;
2612 PROCEDURE (c: Caption) Restore (f: Views.Frame; l, t, r, b: INTEGER);
2613 BEGIN
2614 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
2615 END Restore;
2617 PROCEDURE (c: Caption) HandlePropMsg2 (VAR msg: Properties.Message);
2618 BEGIN
2619 WITH msg: Properties.SizePref DO
2620 StdCFrames.dir.GetCaptionSize(msg.w, msg.h)
2621 | msg: PropPref DO
2622 msg.valid := {link, label, guard, left, right}
2623 | msg: DefaultsPref DO
2624 IF c.prop.link = "" THEN msg.disabled := FALSE END
2625 ELSE
2626 END
2627 END HandlePropMsg2;
2629 PROCEDURE (c: Caption) Update (f: Views.Frame; op, from, to: INTEGER);
2630 BEGIN
2631 f(StdCFrames.Caption).label := c.label$;
2632 f(StdCFrames.Frame).Update
2633 END Update;
2636 (* Group *)
2638 PROCEDURE (c: Group) Internalize2 (VAR rd: Stores.Reader);
2639 VAR thisVersion: INTEGER;
2640 BEGIN
2641 rd.ReadVersion(minVersion, grpVersion, thisVersion)
2642 END Internalize2;
2644 PROCEDURE (c: Group) Externalize2 (VAR wr: Stores.Writer);
2645 BEGIN
2646 wr.WriteVersion(grpVersion)
2647 END Externalize2;
2649 PROCEDURE (c: Group) GetNewFrame (VAR frame: Views.Frame);
2650 VAR f: StdCFrames.Group;
2651 BEGIN
2652 f := StdCFrames.dir.NewGroup();
2653 f.disabled := c.disabled;
2654 f.undef := c.undef;
2655 f.readOnly := c.readOnly;
2656 f.font := c.font;
2657 f.label := c.label$;
2658 frame := f
2659 END GetNewFrame;
2661 PROCEDURE (c: Group) Restore (f: Views.Frame; l, t, r, b: INTEGER);
2662 BEGIN
2663 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
2664 END Restore;
2666 PROCEDURE (c: Group) HandlePropMsg2 (VAR msg: Properties.Message);
2667 BEGIN
2668 WITH msg: Properties.SizePref DO
2669 StdCFrames.dir.GetGroupSize(msg.w, msg.h)
2670 | msg: PropPref DO
2671 msg.valid := {link, label, guard}
2672 | msg: DefaultsPref DO
2673 IF c.prop.link = "" THEN msg.disabled := FALSE END
2674 ELSE
2675 END
2676 END HandlePropMsg2;
2678 PROCEDURE (c: Group) Update (f: Views.Frame; op, from, to: INTEGER);
2679 BEGIN
2680 f(StdCFrames.Group).label := c.label$;
2681 f(StdCFrames.Frame).Update
2682 END Update;
2685 (* TreeControl *)
2687 PROCEDURE (c: TreeControl) Internalize2 (VAR rd: Stores.Reader);
2688 VAR thisVersion: INTEGER;
2689 BEGIN
2690 rd.ReadVersion(minVersion, tfVersion, thisVersion)
2691 END Internalize2;
2693 PROCEDURE (c: TreeControl) Externalize2 (VAR wr: Stores.Writer);
2694 BEGIN
2695 wr.WriteVersion(tfVersion)
2696 END Externalize2;
2698 PROCEDURE TVNofNodesF (VAR rec, par: ANYREC);
2699 BEGIN
2700 WITH par: TVParam DO
2701 WITH rec: Dialog.Tree DO par.l := rec.NofNodes()
2702 ELSE par.l := 0
2703 END
2704 END
2705 END TVNofNodesF;
2707 PROCEDURE TVNofNodes (f: StdCFrames.TreeFrame): INTEGER;
2708 VAR c: TreeControl; par: TVParam;
2709 BEGIN
2710 c := f.view(TreeControl); par.l := 0;
2711 IF c.item.Valid() THEN c.item.CallWith(TVNofNodesF, par) END;
2712 RETURN par.l
2713 END TVNofNodes;
2715 PROCEDURE TVChildF (VAR rec, par: ANYREC);
2716 BEGIN
2717 WITH par: TVParam DO
2718 WITH rec: Dialog.Tree DO par.nodeOut := rec.Child(par.nodeIn, Dialog.firstPos)
2719 ELSE par.nodeOut := NIL
2720 END
2721 END
2722 END TVChildF;
2724 PROCEDURE TVChild (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
2725 VAR c: TreeControl; par: TVParam;
2726 BEGIN
2727 c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
2728 IF c.item.Valid() THEN c.item.CallWith(TVChildF, par) END;
2729 RETURN par.nodeOut
2730 END TVChild;
2732 PROCEDURE TVParentF (VAR rec, par: ANYREC);
2733 BEGIN
2734 WITH par: TVParam DO
2735 WITH rec: Dialog.Tree DO par.nodeOut := rec.Parent(par.nodeIn)
2736 ELSE par.nodeOut := NIL
2737 END
2738 END
2739 END TVParentF;
2741 PROCEDURE TVParent (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
2742 VAR c: TreeControl; par: TVParam;
2743 BEGIN
2744 c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
2745 IF c.item.Valid() THEN c.item.CallWith(TVParentF, par) END;
2746 RETURN par.nodeOut
2747 END TVParent;
2749 PROCEDURE TVNextF (VAR rec, par: ANYREC);
2750 BEGIN
2751 WITH par: TVParam DO
2752 WITH rec: Dialog.Tree DO par.nodeOut := rec.Next(par.nodeIn)
2753 ELSE par.nodeOut := NIL
2754 END
2755 END
2756 END TVNextF;
2758 PROCEDURE TVNext (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
2759 VAR c: TreeControl; par: TVParam;
2760 BEGIN
2761 c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
2762 IF c.item.Valid() THEN c.item.CallWith(TVNextF, par) END;
2763 RETURN par.nodeOut
2764 END TVNext;
2766 PROCEDURE TVSelectF (VAR rec, par: ANYREC);
2767 BEGIN
2768 WITH par: TVParam DO
2769 WITH rec: Dialog.Tree DO rec.Select(par.nodeIn) END
2770 END
2771 END TVSelectF;
2773 PROCEDURE TVSelect (f: StdCFrames.TreeFrame; node: Dialog.TreeNode);
2774 VAR c: TreeControl; par: TVParam;
2775 BEGIN
2776 c := f.view(TreeControl); par.nodeIn := node;
2777 IF c.item.Valid() THEN
2778 c.item.CallWith(TVSelectF, par);
2779 Notify(c, f, Dialog.changed, 0, 0)
2780 END
2781 END TVSelect;
2783 PROCEDURE TVSelectedF (VAR rec, par: ANYREC);
2784 BEGIN
2785 WITH par: TVParam DO
2786 WITH rec: Dialog.Tree DO par.nodeOut := rec.Selected()
2787 ELSE par.nodeOut := NIL
2788 END
2789 END
2790 END TVSelectedF;
2792 PROCEDURE TVSelected (f: StdCFrames.TreeFrame): Dialog.TreeNode;
2793 VAR c: TreeControl; par: TVParam;
2794 BEGIN
2795 c := f.view(TreeControl); par.nodeOut := NIL;
2796 IF c.item.Valid() THEN c.item.CallWith(TVSelectedF, par) END;
2797 RETURN par.nodeOut
2798 END TVSelected;
2800 PROCEDURE TVSetExpansionF (VAR rec, par: ANYREC);
2801 BEGIN
2802 WITH par: TVParam DO
2803 par.nodeIn.SetExpansion(par.e)
2804 END
2805 END TVSetExpansionF;
2807 PROCEDURE TVSetExpansion (f: StdCFrames.TreeFrame; tn: Dialog.TreeNode; expanded: BOOLEAN);
2808 VAR c: TreeControl; par: TVParam;
2809 BEGIN
2810 c := f.view(TreeControl); par.e := expanded; par.nodeIn := tn;
2811 IF c.item.Valid() THEN c.item.CallWith(TVSetExpansionF, par) END
2812 END TVSetExpansion;
2814 PROCEDURE (c: TreeControl) GetNewFrame (VAR frame: Views.Frame);
2815 VAR f: StdCFrames.TreeFrame;
2816 BEGIN
2817 f := StdCFrames.dir.NewTreeFrame();
2818 f.disabled := c.disabled;
2819 f.undef := c.undef;
2820 f.readOnly := c.readOnly;
2821 f.font := c.font;
2822 f.sorted := c.prop.opt[sorted];
2823 f.haslines := c.prop.opt[haslines];
2824 f.hasbuttons := c.prop.opt[hasbuttons];
2825 f.atroot := c.prop.opt[atroot];
2826 f.foldericons := c.prop.opt[foldericons];
2827 f.NofNodes := TVNofNodes;
2828 f.Child := TVChild;
2829 f.Parent := TVParent;
2830 f.Next := TVNext;
2831 f.Select := TVSelect;
2832 f.Selected := TVSelected;
2833 f.SetExpansion := TVSetExpansion;
2834 frame := f
2835 END GetNewFrame;
2837 PROCEDURE (c: TreeControl) UpdateList (f: Views.Frame);
2838 BEGIN
2839 f(StdCFrames.Frame).UpdateList()
2840 END UpdateList;
2842 PROCEDURE (c: TreeControl) Restore (f: Views.Frame; l, t, r, b: INTEGER);
2843 BEGIN
2844 WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
2845 END Restore;
2847 PROCEDURE (c: TreeControl) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
2848 VAR focus: Views.View);
2849 BEGIN
2850 WITH f: StdCFrames.TreeFrame DO
2851 IF ~c.disabled & ~c.readOnly THEN
2852 WITH msg: Controllers.EditMsg DO
2853 IF (msg.op = Controllers.pasteChar) THEN
2854 f.KeyDown(msg.char)
2855 END
2856 ELSE
2857 CatchCtrlMsg(c, f, msg, focus)
2858 END
2859 ELSIF ~c.disabled THEN
2860 WITH msg: Controllers.TrackMsg DO
2861 f.MouseDown(msg.x, msg.y, msg.modifiers)
2862 ELSE
2863 END
2864 END
2865 END
2866 END HandleCtrlMsg2;
2868 PROCEDURE (c: TreeControl) HandlePropMsg2 (VAR msg: Properties.Message);
2869 BEGIN
2870 WITH msg: Properties.ControlPref DO
2871 IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
2872 IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) OR msg.getFocus THEN
2873 msg.getFocus := StdCFrames.setFocus
2874 END
2875 | msg: Properties.FocusPref DO
2876 IF ~c.disabled & ~c.readOnly THEN
2877 msg.setFocus := TRUE
2878 ELSIF~c.disabled THEN
2879 msg.hotFocus := TRUE
2880 END
2881 | msg: Properties.SizePref DO
2882 StdCFrames.dir.GetTreeFrameSize(msg.w, msg.h)
2883 | msg: PropPref DO
2884 msg.valid := {link, label, guard, notifier, sorted, haslines, hasbuttons, atroot, foldericons}
2885 | msg: Properties.ResizePref DO
2886 msg.horFitToWin := TRUE; msg.verFitToWin := TRUE
2887 ELSE
2888 END
2889 END HandlePropMsg2;
2891 PROCEDURE (c: TreeControl) CheckLink (VAR ok: BOOLEAN);
2892 VAR name: Meta.Name;
2893 BEGIN
2894 GetTypeName(c.item, name);
2895 ok := name = "Tree"
2896 END CheckLink;
2898 PROCEDURE (c: TreeControl) Update (f: Views.Frame; op, from, to: INTEGER);
2899 BEGIN
2900 f(StdCFrames.Frame).Update
2901 END Update;
2904 (* StdDirectory *)
2906 PROCEDURE (d: StdDirectory) NewPushButton (p: Prop): Control;
2907 VAR c: PushButton;
2908 BEGIN
2909 NEW(c); OpenLink(c, p); RETURN c
2910 END NewPushButton;
2912 PROCEDURE (d: StdDirectory) NewCheckBox (p: Prop): Control;
2913 VAR c: CheckBox;
2914 BEGIN
2915 NEW(c); OpenLink(c, p); RETURN c
2916 END NewCheckBox;
2918 PROCEDURE (d: StdDirectory) NewRadioButton (p: Prop): Control;
2919 VAR c: RadioButton;
2920 BEGIN
2921 NEW(c); OpenLink(c, p); RETURN c
2922 END NewRadioButton;
2924 PROCEDURE (d: StdDirectory) NewField (p: Prop): Control;
2925 VAR c: Field;
2926 BEGIN
2927 NEW(c); OpenLink(c, p); RETURN c
2928 END NewField;
2930 PROCEDURE (d: StdDirectory) NewUpDownField (p: Prop): Control;
2931 VAR c: UpDownField;
2932 BEGIN
2933 NEW(c); OpenLink(c, p); RETURN c
2934 END NewUpDownField;
2936 PROCEDURE (d: StdDirectory) NewDateField (p: Prop): Control;
2937 VAR c: DateField;
2938 BEGIN
2939 NEW(c); OpenLink(c, p); RETURN c
2940 END NewDateField;
2942 PROCEDURE (d: StdDirectory) NewTimeField (p: Prop): Control;
2943 VAR c: TimeField;
2944 BEGIN
2945 NEW(c); OpenLink(c, p); RETURN c
2946 END NewTimeField;
2948 PROCEDURE (d: StdDirectory) NewColorField (p: Prop): Control;
2949 VAR c: ColorField;
2950 BEGIN
2951 NEW(c); OpenLink(c, p); RETURN c
2952 END NewColorField;
2954 PROCEDURE (d: StdDirectory) NewListBox (p: Prop): Control;
2955 VAR c: ListBox;
2956 BEGIN
2957 NEW(c); OpenLink(c, p); RETURN c
2958 END NewListBox;
2960 PROCEDURE (d: StdDirectory) NewSelectionBox (p: Prop): Control;
2961 VAR c: SelectionBox;
2962 BEGIN
2963 NEW(c); OpenLink(c, p); RETURN c
2964 END NewSelectionBox;
2966 PROCEDURE (d: StdDirectory) NewComboBox (p: Prop): Control;
2967 VAR c: ComboBox;
2968 BEGIN
2969 NEW(c); OpenLink(c, p); RETURN c
2970 END NewComboBox;
2972 PROCEDURE (d: StdDirectory) NewCaption (p: Prop): Control;
2973 VAR c: Caption;
2974 BEGIN
2975 NEW(c); OpenLink(c, p); RETURN c
2976 END NewCaption;
2978 PROCEDURE (d: StdDirectory) NewGroup (p: Prop): Control;
2979 VAR c: Group;
2980 BEGIN
2981 NEW(c); OpenLink(c, p); RETURN c
2982 END NewGroup;
2984 PROCEDURE (d: StdDirectory) NewTreeControl (p: Prop): Control;
2985 VAR c: TreeControl;
2986 BEGIN
2987 NEW(c); OpenLink(c, p); RETURN c
2988 END NewTreeControl;
2990 PROCEDURE SetDir* (d: Directory);
2991 BEGIN
2992 ASSERT(d # NIL, 20); dir := d
2993 END SetDir;
2995 PROCEDURE InitProp (VAR p: Prop);
2996 BEGIN
2997 NEW(p);
2998 p.link := ""; p.label := ""; p.guard := ""; p.notifier := "";
2999 p.level := 0;
3000 p.opt[0] := FALSE; p.opt[1] := FALSE;
3001 p.opt[2] := FALSE; p.opt[3] := FALSE;
3002 p.opt[4] := FALSE
3003 END InitProp;
3005 PROCEDURE DepositPushButton*;
3006 VAR p: Prop;
3007 BEGIN
3008 InitProp(p);
3009 p.label := "#System:untitled";
3010 Views.Deposit(dir.NewPushButton(p))
3011 END DepositPushButton;
3013 PROCEDURE DepositCheckBox*;
3014 VAR p: Prop;
3015 BEGIN
3016 InitProp(p);
3017 p.label := "#System:untitled";
3018 Views.Deposit(dir.NewCheckBox(p))
3019 END DepositCheckBox;
3021 PROCEDURE DepositRadioButton*;
3022 VAR p: Prop;
3023 BEGIN
3024 InitProp(p);
3025 p.label := "#System:untitled";
3026 Views.Deposit(dir.NewRadioButton(p))
3027 END DepositRadioButton;
3029 PROCEDURE DepositField*;
3030 VAR p: Prop;
3031 BEGIN
3032 InitProp(p); p.opt[left] := TRUE;
3033 Views.Deposit(dir.NewField(p))
3034 END DepositField;
3036 PROCEDURE DepositUpDownField*;
3037 VAR p: Prop;
3038 BEGIN
3039 InitProp(p);
3040 Views.Deposit(dir.NewUpDownField(p))
3041 END DepositUpDownField;
3043 PROCEDURE DepositDateField*;
3044 VAR p: Prop;
3045 BEGIN
3046 InitProp(p);
3047 Views.Deposit(dir.NewDateField(p))
3048 END DepositDateField;
3050 PROCEDURE DepositTimeField*;
3051 VAR p: Prop;
3052 BEGIN
3053 InitProp(p);
3054 Views.Deposit(dir.NewTimeField(p))
3055 END DepositTimeField;
3057 PROCEDURE DepositColorField*;
3058 VAR p: Prop;
3059 BEGIN
3060 InitProp(p);
3061 Views.Deposit(dir.NewColorField(p))
3062 END DepositColorField;
3064 PROCEDURE DepositListBox*;
3065 VAR p: Prop;
3066 BEGIN
3067 InitProp(p);
3068 Views.Deposit(dir.NewListBox(p))
3069 END DepositListBox;
3071 PROCEDURE DepositSelectionBox*;
3072 VAR p: Prop;
3073 BEGIN
3074 InitProp(p);
3075 Views.Deposit(dir.NewSelectionBox(p))
3076 END DepositSelectionBox;
3078 PROCEDURE DepositComboBox*;
3079 VAR p: Prop;
3080 BEGIN
3081 InitProp(p);
3082 Views.Deposit(dir.NewComboBox(p))
3083 END DepositComboBox;
3085 PROCEDURE DepositCancelButton*;
3086 VAR p: Prop;
3087 BEGIN
3088 InitProp(p);
3089 p.link := "StdCmds.CloseDialog"; p.label := "#System:Cancel"; p.opt[cancel] := TRUE;
3090 Views.Deposit(dir.NewPushButton(p))
3091 END DepositCancelButton;
3093 PROCEDURE DepositCaption*;
3094 VAR p: Prop;
3095 BEGIN
3096 InitProp(p); p.opt[left] := TRUE;
3097 p.label := "#System:Caption";
3098 Views.Deposit(dir.NewCaption(p))
3099 END DepositCaption;
3101 PROCEDURE DepositGroup*;
3102 VAR p: Prop;
3103 BEGIN
3104 InitProp(p);
3105 p.label := "#System:Caption";
3106 Views.Deposit(dir.NewGroup(p))
3107 END DepositGroup;
3109 PROCEDURE DepositTreeControl*;
3110 VAR p: Prop;
3111 BEGIN
3112 InitProp(p);
3113 p.opt[haslines] := TRUE; p.opt[hasbuttons] := TRUE; p.opt[atroot] := TRUE; p.opt[foldericons] := TRUE;
3114 Views.Deposit(dir.NewTreeControl(p))
3115 END DepositTreeControl;
3117 PROCEDURE Relink*;
3118 VAR msg: UpdateCachesMsg;
3119 BEGIN
3120 INC(stamp);
3121 Views.Omnicast(msg)
3122 END Relink;
3125 PROCEDURE Init;
3126 VAR d: StdDirectory;
3127 BEGIN
3128 par := NIL; stamp := 0;
3129 NEW(d); stdDir := d; dir := d;
3130 NEW(cleaner); cleanerInstalled := 0
3131 END Init;
3134 (* check guards action *)
3136 PROCEDURE (a: Action) Do;
3137 VAR msg: Views.NotifyMsg;
3138 BEGIN
3139 IF Windows.dir # NIL THEN
3140 IF a.w # NIL THEN
3141 INC(a.cnt);
3142 msg.id0 := 0; msg.id1 := 0; msg.opts := {guardCheck};
3143 IF a.w.seq # NIL THEN a.w.seq.Handle(msg) END;
3144 a.w := Windows.dir.Next(a.w);
3145 WHILE (a.w # NIL) & a.w.sub DO a.w := Windows.dir.Next(a.w) END
3146 ELSE
3147 IF a.cnt = 0 THEN a.resolution := Services.resolution
3148 ELSE a.resolution := Services.resolution DIV a.cnt DIV 2
3149 END;
3150 a.cnt := 0;
3151 a.w := Windows.dir.First();
3152 WHILE (a.w # NIL) & a.w.sub DO a.w := Windows.dir.Next(a.w) END
3153 END
3154 END;
3155 Services.DoLater(a, Services.Ticks() + a.resolution)
3156 END Do;
3158 BEGIN
3159 Init;
3160 NEW(action); action.w := NIL; action.cnt := 0; Services.DoLater(action, Services.now)
3161 CLOSE
3162 Services.RemoveAction(action)
3163 END Controls.