1 MODULE Dialog;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Dialog.odc *)
4 (* DO NOT EDIT *)
6 IMPORT SYSTEM, Kernel, Files;
8 CONST
9 pressed* = 1; released* = 2; changed* = 3; included* = 5; excluded* = 6; set* = 7; (** notify ops **)
10 ok* = 1; yes* = 2; no* = 3; cancel* = 4; (** GetOK forms & results **)
11 persistent* = TRUE; nonPersistent* = FALSE; (** constants for SetLanguage **)
13 stringLen = 256;
14 bufLen = 252;
16 rsrcDir = "Rsrc";
17 stringFile = "Strings";
18 TAB = 09X; CR = 0DX;
19 update = 2; (* notify options *)
20 listUpdate = 3;
21 guardCheck = 4;
23 windows32s* = 11;
24 windows95* = 12;
25 windowsNT3* = 13;
26 windowsNT4* = 14;
27 windows2000* = 15;
28 windows98* = 16;
29 windowsXP* = 17;
30 windowsVista* = 18;
31 macOS* = 21;
32 macOSX* = 22;
33 linux* = 30;
34 tru64* = 40;
36 firstPos* = 0;
37 lastPos* = -1;
39 TYPE
40 String* = ARRAY stringLen OF CHAR;
42 Buf = POINTER TO RECORD
43 next: Buf;
44 s: ARRAY bufLen OF CHAR
45 END;
47 StrList = RECORD
48 len, max: INTEGER; (* number of items, max number of items *)
49 strings: Buf; (* string buffer list. strings[0] = 0X -> uninitialized items appear as empty *)
50 end: INTEGER; (* next free position in string buffer list *)
51 scnt: INTEGER; (* number of strings in list, including unused entries *)
52 items: POINTER TO ARRAY OF INTEGER (* indices into string buffer list *)
53 END;
55 List* = RECORD
56 index*: INTEGER; (** val IN [0, n-1] **)
57 len-: INTEGER;
58 l: StrList
59 END;
61 Combo* = RECORD
62 item*: String;
63 len-: INTEGER;
64 l: StrList
65 END;
67 Selection* = RECORD
68 len-: INTEGER;
69 sel: POINTER TO ARRAY OF SET;
70 l: StrList
71 END;
73 Currency* = RECORD (* number = val * 10^-scale *)
74 val*: LONGINT;
75 scale*: INTEGER
76 END;
78 Color* = RECORD
79 val*: INTEGER
80 END;
82 TreeNode* = POINTER TO LIMITED RECORD
83 nofChildren: INTEGER;
84 name: String;
85 parent, next, prev, firstChild: TreeNode;
86 viewAsFolder, expanded: BOOLEAN;
87 data: ANYPTR;
88 tree: INTEGER
89 END;
91 Tree* = RECORD
92 nofRoots, nofNodes: INTEGER;
93 firstRoot, selected: TreeNode
94 END;
96 (** command procedure types**)
98 Par* = RECORD (** parameter for guard procedures **)
99 disabled*: BOOLEAN; (** OUT, preset to FALSE **)
100 checked*: BOOLEAN; (** OUT, preset to default **)
101 undef*: BOOLEAN; (** OUT, preset to default **)
102 readOnly*: BOOLEAN; (** OUT, preset to default **)
103 label*: String (** OUT, preset to "" **)
104 END;
106 GuardProc* = PROCEDURE (VAR par: Par);
107 NotifierProc* = PROCEDURE (op, from, to: INTEGER);
109 StringPtr = POINTER TO ARRAY [untagged] OF CHAR;
110 StringTab = POINTER TO RECORD
111 next: StringTab;
112 name: Files.Name;
113 key: POINTER TO ARRAY OF StringPtr;
114 str: POINTER TO ARRAY OF StringPtr;
115 data: POINTER TO ARRAY OF CHAR
116 END;
118 LangNotifier* = POINTER TO ABSTRACT RECORD next: LangNotifier END;
119 Language* = ARRAY 3 OF CHAR;
121 LangTrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
123 GetHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
124 ShowHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
125 CallHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
126 NotifyHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
127 LanguageHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
129 VAR
130 metricSystem*: BOOLEAN;
131 showsStatus*: BOOLEAN;
132 platform*: INTEGER;
133 commandLinePars*: String;
134 version*: INTEGER;
135 appName*: ARRAY 32 OF CHAR;
136 language-: Language;
137 user*: ARRAY 32 OF CHAR;
138 caretPeriod*: INTEGER;
139 thickCaret*: BOOLEAN;
141 tabList: StringTab;
142 langNotifiers: LangNotifier;
143 currentNotifier: LangNotifier;
145 gethook: GetHook;
146 showHook: ShowHook;
147 callHook: CallHook;
148 notifyHook: NotifyHook;
149 languageHook: LanguageHook;
151 PROCEDURE (h: GetHook) GetOK* (IN str, p0, p1, p2: ARRAY OF CHAR; form: SET;
152 OUT res: INTEGER), NEW, ABSTRACT;
153 PROCEDURE (h: GetHook) GetColor* (in: INTEGER; OUT out: INTEGER;
154 OUT set: BOOLEAN), NEW, ABSTRACT;
155 PROCEDURE (h: GetHook) GetIntSpec* (IN defType: Files.Type; VAR loc: Files.Locator;
156 OUT name: Files.Name), NEW, ABSTRACT;
157 PROCEDURE (h: GetHook) GetExtSpec* (IN defName: Files.Name; IN defType: Files.Type;
158 VAR loc: Files.Locator; OUT name: Files.Name), NEW, ABSTRACT;
160 PROCEDURE SetGetHook*(h: GetHook);
161 BEGIN
162 gethook := h
163 END SetGetHook;
165 PROCEDURE (h: ShowHook) ShowParamMsg* (IN str, p0, p1, p2: ARRAY OF CHAR), NEW, ABSTRACT;
166 PROCEDURE (h: ShowHook) ShowParamStatus* (IN str, p0, p1, p2: ARRAY OF CHAR), NEW, ABSTRACT;
168 PROCEDURE SetShowHook* (h: ShowHook);
169 BEGIN
170 showHook := h
171 END SetShowHook;
173 PROCEDURE (h: CallHook) Call* (IN proc, errorMsg: ARRAY OF CHAR; VAR res: INTEGER), NEW, ABSTRACT;
175 PROCEDURE SetCallHook* (h: CallHook);
176 BEGIN
177 callHook := h
178 END SetCallHook;
180 PROCEDURE (h: NotifyHook) Notify* (id0, id1: INTEGER; opts: SET), NEW, ABSTRACT;
182 PROCEDURE SetNotifyHook* (h: NotifyHook);
183 BEGIN
184 notifyHook := h
185 END SetNotifyHook;
187 PROCEDURE (h: LanguageHook) SetLanguage* (lang: Language; persistent: BOOLEAN;
188 OUT ok: BOOLEAN), NEW, ABSTRACT;
189 PROCEDURE (h: LanguageHook) GetPersistentLanguage* (OUT lang: Language), NEW, ABSTRACT;
191 PROCEDURE SetLanguageHook* (h: LanguageHook);
192 BEGIN
193 languageHook := h
194 END SetLanguageHook;
196 PROCEDURE ReadStringFile (subsys: Files.Name; f: Files.File; VAR tab: StringTab);
197 VAR i, j, h, n, s, x, len, next, down, end: INTEGER; in, in1: Files.Reader;
198 ch: CHAR; b: BYTE; p, q: StringPtr;
200 PROCEDURE ReadInt (OUT x: INTEGER);
201 VAR b: BYTE;
202 BEGIN
203 in.ReadByte(b); x := b MOD 256;
204 in.ReadByte(b); x := x + (b MOD 256) * 100H;
205 in.ReadByte(b); x := x + (b MOD 256) * 10000H;
206 in.ReadByte(b); x := x + b * 1000000H
207 END ReadInt;
209 PROCEDURE ReadHead (OUT next, down, end: INTEGER);
210 VAR b, t: BYTE; n: INTEGER;
211 BEGIN
212 in.ReadByte(b);
213 REPEAT
214 in.ReadByte(t);
215 IF t = -14 THEN ReadInt(n)
216 ELSE
217 REPEAT in.ReadByte(b) UNTIL b = 0
218 END
219 UNTIL t # -15;
220 ReadInt(n);
221 ReadInt(next); next := next + in.Pos();
222 ReadInt(down); down := down + in.Pos();
223 ReadInt(end); end := end + in.Pos()
224 END ReadHead;
226 BEGIN
227 tab := NIL;
228 IF f # NIL THEN (* read text file *)
229 in := f.NewReader(NIL); in1 := f.NewReader(NIL);
230 IF (in # NIL) & (in1 # NIL) THEN
231 in.SetPos(8); ReadHead(next, down, end); (* document view *)
232 in.SetPos(down); ReadHead(next, down, end); (* document model *)
233 in.SetPos(down); ReadHead(next, down, end); (* text view *)
234 in.SetPos(down); ReadHead(next, down, end); (* text model *)
235 in.ReadByte(b); in.ReadByte(b); in.ReadByte(b); (* versions *)
236 in.ReadByte(b); in.ReadByte(b); in.ReadByte(b);
237 ReadInt(x); in1.SetPos(in.Pos() + x); (* text offset *)
238 next := down;
239 NEW(tab); tab.name := subsys$;
240 NEW(tab.data, f.Length());
241 n := 0; i := 0; s := 0; in.ReadByte(b);
242 WHILE b # -1 DO
243 IF next = in.Pos() THEN ReadHead(next, down, end); in.SetPos(end) END; (* skip attributes *)
244 ReadInt(len);
245 IF len > 0 THEN (* shortchar run *)
246 WHILE len > 0 DO
247 in1.ReadByte(b); ch := CHR(b MOD 256);
248 IF ch >= " " THEN
249 IF s = 0 THEN j := i; s := 1 END; (* start of left part *)
250 tab.data[j] := ch; INC(j)
251 ELSIF (s = 1) & (ch = TAB) THEN
252 tab.data[j] := 0X; INC(j);
253 s := 2 (* start of right part *)
254 ELSIF (s = 2) & (ch = CR) THEN
255 tab.data[j] := 0X; INC(j);
256 INC(n); i := j; s := 0 (* end of line *)
257 ELSE
258 s := 0 (* reset *)
259 END;
260 DEC(len)
261 END
262 ELSIF len < 0 THEN (* longchar run *)
263 WHILE len < 0 DO
264 in1.ReadByte(b); x := b MOD 256; in1.ReadByte(b); ch := CHR(x + 256 * (b + 128));
265 IF s = 0 THEN j := i; s := 1 END; (* start of left part *)
266 tab.data[j] := ch; INC(j);
267 INC(len, 2)
268 END
269 ELSE (* view *)
270 ReadInt(x); ReadInt(x); in1.ReadByte(b); (* ignore *)
271 END;
272 IF next = in.Pos() THEN ReadHead(next, down, end); in.SetPos(end) END; (* skip view data *)
273 in.ReadByte(b);
274 END;
275 IF n > 0 THEN
276 NEW(tab.key, n); NEW(tab.str, n); i := 0; j := 0;
277 WHILE j < n DO
278 tab.key[j] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[i]));
279 WHILE tab.data[i] >= " " DO INC(i) END;
280 INC(i);
281 tab.str[j] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[i]));
282 WHILE tab.data[i] >= " " DO INC(i) END;
283 INC(i); INC(j)
284 END;
285 (* sort keys (shellsort) *)
286 h := 1; REPEAT h := h*3 + 1 UNTIL h > n;
287 REPEAT h := h DIV 3; i := h;
288 WHILE i < n DO p := tab.key[i]; q := tab.str[i]; j := i;
289 WHILE (j >= h) & (tab.key[j-h]^ > p^) DO
290 tab.key[j] := tab.key[j-h]; tab.str[j] := tab.str[j-h]; j := j-h
291 END;
292 tab.key[j] := p; tab.str[j] := q; INC(i)
293 END
294 UNTIL h = 1
295 END
296 END
297 END
298 END ReadStringFile;
300 PROCEDURE MergeTabs (VAR master, extra: StringTab): StringTab;
301 VAR tab: StringTab; nofKeys, datalength, di, mi, ei, ml, el, ti, i: INTEGER;
302 BEGIN
303 IF (extra = NIL) OR (extra.key = NIL) THEN RETURN master END;
304 IF (master = NIL) OR (master.key = NIL) THEN RETURN extra END;
305 ml := LEN(master.key); el := LEN(extra.key);
306 mi := 0; ei := 0; datalength := 0; nofKeys := 0;
307 (* find out how big the resulting table will be *)
308 WHILE (mi < ml) OR (ei < el) DO
309 INC(nofKeys);
310 IF (mi < ml) & (ei < el) & (master.key[mi]$ = extra.key[ei]$) THEN
311 datalength := datalength + LEN(master.key[mi]$) + LEN(master.str[mi]$) + 2; INC(mi); INC(ei)
312 ELSIF (ei < el) & ((mi >= ml) OR (master.key[mi]$ > extra.key[ei]$)) THEN
313 datalength := datalength + LEN(extra.key[ei]$) + LEN(extra.str[ei]$) + 2; INC(ei)
314 ELSE
315 datalength := datalength + LEN(master.key[mi]$) + LEN(master.str[mi]$) + 2; INC(mi)
316 END
317 END;
318 NEW(tab); tab.name := master.name;
319 NEW(tab.key, nofKeys); NEW(tab.str, nofKeys); NEW(tab.data, datalength);
320 mi := 0; ei := 0; di := 0; ti := 0;
321 (* do the merge *)
322 WHILE (mi < ml) OR (ei < el) DO
323 IF (mi < ml) & (ei < el) & (master.key[mi]$ = extra.key[ei]$) THEN
324 i := 0; tab.key[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
325 WHILE master.key[mi][i] # 0X DO tab.data[di] := master.key[mi][i]; INC(di); INC(i) END;
326 tab.data[di] :=0X; INC(di); i := 0;
327 tab.str[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
328 WHILE master.str[mi][i] # 0X DO tab.data[di] := master.str[mi][i]; INC(di); INC(i) END;
329 tab.data[di] :=0X; INC(di);
330 INC(mi); INC(ei)
331 ELSIF (ei < el) & ((mi >= ml) OR (master.key[mi]$ > extra.key[ei]$)) THEN
332 i := 0; tab.key[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
333 WHILE extra.key[ei][i] # 0X DO tab.data[di] := extra.key[ei][i]; INC(di); INC(i) END;
334 tab.data[di] :=0X; INC(di); i := 0;
335 tab.str[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
336 WHILE extra.str[ei][i] # 0X DO tab.data[di] := extra.str[ei][i]; INC(di); INC(i) END;
337 tab.data[di] :=0X; INC(di);
338 INC(ei)
339 ELSE
340 i := 0; tab.key[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
341 WHILE master.key[mi][i] # 0X DO tab.data[di] := master.key[mi][i]; INC(di); INC(i) END;
342 tab.data[di] :=0X; INC(di); i := 0;
343 tab.str[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
344 WHILE master.str[mi][i] # 0X DO tab.data[di] := master.str[mi][i]; INC(di); INC(i) END;
345 tab.data[di] :=0X; INC(di);
346 INC(mi)
347 END;
348 INC(ti)
349 END;
350 RETURN tab
351 END MergeTabs;
353 PROCEDURE LoadStringTab (subsys: Files.Name; VAR tab: StringTab);
354 VAR loc: Files.Locator; f: Files.File; name: Files.Name; ltab: StringTab;
355 BEGIN
356 tab := NIL;
357 name := stringFile; Kernel.MakeFileName(name, "");
358 loc := Files.dir.This(subsys); loc := loc.This(rsrcDir);
359 IF loc # NIL THEN
360 f := Files.dir.Old(loc, name, Files.shared);
361 ReadStringFile(subsys, f, tab);
362 IF language # "" THEN
363 loc := loc.This(language);
364 IF loc # NIL THEN
365 f := Files.dir.Old(loc, name, Files.shared);
366 ReadStringFile(subsys, f, ltab);
367 tab := MergeTabs(ltab, tab)
368 END
369 END;
370 IF tab # NIL THEN tab.next := tabList; tabList := tab END
371 END
372 END LoadStringTab;
374 PROCEDURE SearchString (VAR in: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
375 VAR i, j, k, len: INTEGER; ch: CHAR; subsys: Files.Name; tab: StringTab;
376 BEGIN
377 out := "";
378 IF in[0] = "#" THEN
379 i := 0; ch := in[1];
380 WHILE (ch # 0X) (* & (ch # ".") *) & (ch # ":") DO subsys[i] := ch; INC(i); ch := in[i + 1] END;
381 subsys[i] := 0X;
382 IF ch # 0X THEN
383 INC(i, 2); ch := in[i]; j := 0;
384 WHILE (ch # 0X) DO in[j] := ch; INC(i); INC(j); ch := in[i] END;
385 in[j] := 0X
386 ELSE
387 RETURN
388 END;
389 tab := tabList;
390 WHILE (tab # NIL) & (tab.name # subsys) DO tab := tab.next END;
391 IF tab = NIL THEN LoadStringTab(subsys, tab) END;
392 IF tab # NIL THEN
393 i := 0;
394 IF tab.key = NIL THEN j := 0 ELSE j := LEN(tab.key^) END;
395 WHILE i < j DO (* binary search *)
396 k := (i + j) DIV 2;
397 IF tab.key[k]^ < in THEN i := k + 1 ELSE j := k END
398 END;
399 IF (tab.key # NIL) & (j < LEN(tab.key^)) & (tab.key[j]^ = in) THEN
400 k := 0; len := LEN(out)-1;
401 WHILE (k < len) & (tab.str[j][k] # 0X) DO
402 out[k] := tab.str[j][k]; INC(k)
403 END;
404 out[k] := 0X
405 END
406 END
407 END
408 END SearchString;
411 PROCEDURE Init (VAR l: StrList);
412 BEGIN
413 l.len := 0; l.max := 0; l.end := 0; l.scnt := 0
414 END Init;
416 PROCEDURE Compact (VAR l: StrList);
417 VAR i, j, k: INTEGER; ibuf, jbuf: Buf; ch: CHAR;
418 BEGIN
419 i := 1; ibuf := l.strings; j := 1; jbuf := l.strings;
420 WHILE j < l.end DO
421 (* find index entry k pointing to position j *)
422 k := 0; WHILE (k < l.len) & (l.items[k] # j) DO INC(k) END;
423 IF k < l.len THEN (* copy string *)
424 l.items[k] := i;
425 REPEAT
426 ch := jbuf.s[j MOD bufLen]; INC(j);
427 IF j MOD bufLen = 0 THEN jbuf := jbuf.next END;
428 ibuf.s[i MOD bufLen] := ch; INC(i);
429 IF i MOD bufLen = 0 THEN ibuf := ibuf.next END
430 UNTIL ch = 0X
431 ELSE (* skip next string *)
432 REPEAT
433 ch := jbuf.s[j MOD bufLen]; INC(j);
434 IF j MOD bufLen = 0 THEN jbuf := jbuf.next END
435 UNTIL ch = 0X
436 END
437 END;
438 ibuf.next := NIL; (* release superfluous buffers *)
439 l.end := i; l.scnt := l.len
440 END Compact;
442 PROCEDURE SetLen (VAR l: StrList; len: INTEGER);
443 CONST D = 32;
444 VAR i, newmax: INTEGER;
445 items: POINTER TO ARRAY OF INTEGER;
446 BEGIN
447 IF l.items = NIL THEN Init(l) END;
448 IF (l.max - D < len) & (len <= l.max) THEN
449 (* we do not reallocate anything *)
450 ELSE
451 newmax := (len + D-1) DIV D * D;
452 IF newmax > 0 THEN
453 IF l.strings = NIL THEN NEW(l.strings); (* l.strings[0] := 0X; *) l.end := 1 END;
454 NEW(items, newmax);
455 IF len < l.len THEN i := len ELSE i := l.len END;
456 WHILE i > 0 DO DEC(i); items[i] := l.items[i] END;
457 l.items := items
458 END;
459 l.max := newmax
460 END;
461 l.len := len;
462 IF (l.scnt > 32) & (l.scnt > 2 * l.len) THEN Compact(l) END
463 END SetLen;
465 PROCEDURE GetItem (VAR l: StrList; index: INTEGER; VAR item: String);
466 VAR i, j, k: INTEGER; b: Buf; ch: CHAR;
467 BEGIN
468 IF l.items = NIL THEN Init(l) END;
469 IF (index >= 0) & (index < l.len) THEN
470 i := l.items[index]; j := i MOD bufLen; i := i DIV bufLen;
471 b := l.strings; WHILE i # 0 DO b := b.next; DEC(i) END;
472 k := 0;
473 REPEAT
474 ch := b.s[j]; INC(j); IF j = bufLen THEN j := 0; b := b.next END;
475 item[k] := ch; INC(k)
476 UNTIL ch = 0X
477 ELSE
478 item := ""
479 END
480 END GetItem;
482 PROCEDURE SetItem (VAR l: StrList; index: INTEGER; item: ARRAY OF CHAR);
483 VAR len, i, j, k: INTEGER; b: Buf; ch: CHAR;
484 BEGIN
485 IF l.items = NIL THEN Init(l) END;
486 IF index >= l.len THEN SetLen(l, index + 1) END;
487 IF (l.scnt > 32) & (l.scnt > 2 * l.len) THEN Compact(l) END;
488 len := 0; WHILE item[len] # 0X DO INC(len) END;
489 IF len >= stringLen THEN len := stringLen - 1; item[len] := 0X END; (* clip long strings *)
490 l.items[index] := l.end;
491 i := l.end; j := i MOD bufLen; i := i DIV bufLen;
492 b := l.strings; WHILE i # 0 DO b := b.next; DEC(i) END;
493 k := 0;
494 REPEAT
495 ch := item[k]; INC(k); INC(l.end);
496 b.s[j] := ch; INC(j); IF j = bufLen THEN j := 0; NEW(b.next); b := b.next END
497 UNTIL ch = 0X;
498 INC(l.scnt)
499 END SetItem;
501 PROCEDURE SetResources (VAR l: StrList; IN key: ARRAY OF CHAR);
502 VAR i, k, j, x: INTEGER; ch: CHAR; s, a: ARRAY 16 OF CHAR; h, item: ARRAY 256 OF CHAR;
503 BEGIN
504 IF l.items = NIL THEN Init(l) END;
505 i := 0;
506 REPEAT
507 x := i;
508 j := 0; REPEAT a[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0;
509 k := 0; REPEAT DEC(j); ch := a[j]; s[k] := ch; INC(k) UNTIL j = 0;
510 s[k] := 0X;
511 h := key + "[" + s + "]";
512 SearchString(h, item);
513 IF item # "" THEN SetItem(l, i, item) END;
514 INC(i)
515 UNTIL item = ""
516 END SetResources;
519 (** List **)
521 PROCEDURE (VAR l: List) SetLen* (len: INTEGER), NEW;
522 BEGIN
523 ASSERT(len >= 0, 20);
524 SetLen(l.l, len);
525 l.len := l.l.len
526 END SetLen;
528 PROCEDURE (VAR l: List) GetItem* (index: INTEGER; OUT item: String), NEW;
529 BEGIN
530 GetItem(l.l, index, item);
531 l.len := l.l.len
532 END GetItem;
534 PROCEDURE (VAR l: List) SetItem* (index: INTEGER; IN item: ARRAY OF CHAR), NEW;
535 BEGIN
536 ASSERT(index >= 0, 20); ASSERT(item # "", 21);
537 SetItem(l.l, index, item);
538 l.len := l.l.len
539 END SetItem;
541 PROCEDURE (VAR l: List) SetResources* (IN key: ARRAY OF CHAR), NEW;
542 BEGIN
543 ASSERT(key # "", 20);
544 SetResources(l.l, key);
545 l.len := l.l.len
546 END SetResources;
549 (** Selection **)
551 PROCEDURE (VAR s: Selection) SetLen* (len: INTEGER), NEW;
552 VAR sel: POINTER TO ARRAY OF SET; i: INTEGER;
553 BEGIN
554 ASSERT(len >= 0, 20);
555 SetLen(s.l, len);
556 len := len + (MAX(SET) - 1) DIV MAX(SET);
557 IF len = 0 THEN s.sel := NIL
558 ELSIF s.sel = NIL THEN NEW(s.sel, len)
559 ELSIF LEN(s.sel^) # len THEN
560 NEW(sel, len);
561 IF LEN(s.sel^) < len THEN len := LEN(s.sel^) END;
562 i := 0; WHILE i < len DO sel[i] := s.sel[i]; INC(i) END;
563 s.sel := sel
564 END;
565 s.len := s.l.len
566 END SetLen;
568 PROCEDURE (VAR s: Selection) GetItem* (index: INTEGER; OUT item: String), NEW;
569 BEGIN
570 GetItem(s.l, index, item);
571 s.len := s.l.len
572 END GetItem;
574 PROCEDURE (VAR s: Selection) SetItem* (index: INTEGER; IN item: ARRAY OF CHAR), NEW;
575 BEGIN
576 ASSERT(index >= 0, 20); (*ASSERT(index < s.l.len, 21);*) ASSERT(item # "", 21);
577 SetItem(s.l, index, item);
578 IF s.l.len > s.len THEN s.SetLen(s.l.len) END
579 END SetItem;
581 PROCEDURE (VAR s: Selection) SetResources* (IN key: ARRAY OF CHAR), NEW;
582 BEGIN
583 ASSERT(key # "", 20);
584 SetResources(s.l, key);
585 IF s.l.len > s.len THEN s.SetLen(s.l.len) END
586 END SetResources;
588 PROCEDURE (VAR s: Selection) In* (index: INTEGER): BOOLEAN, NEW;
589 BEGIN
590 IF s.l.items = NIL THEN Init(s.l); s.len := s.l.len END;
591 IF s.sel # NIL THEN RETURN (index MOD 32) IN (s.sel[index DIV 32]) ELSE RETURN FALSE END
592 END In;
594 PROCEDURE (VAR s: Selection) Excl* (from, to: INTEGER), NEW;
595 BEGIN
596 IF s.l.items = NIL THEN Init(s.l); s.len := s.l.len END;
597 IF from < 0 THEN from := 0 END;
598 IF to >= s.l.len THEN to := s.l.len - 1 END;
599 WHILE from <= to DO EXCL(s.sel[from DIV 32], from MOD 32); INC(from) END
600 END Excl;
602 PROCEDURE (VAR s: Selection) Incl* (from, to: INTEGER), NEW;
603 BEGIN
604 IF s.l.items = NIL THEN Init(s.l); s.len := s.l.len END;
605 IF from < 0 THEN from := 0 END;
606 IF to >= s.l.len THEN to := s.l.len - 1 END;
607 WHILE from <= to DO INCL(s.sel[from DIV 32], from MOD 32); INC(from) END
608 END Incl;
611 (** Combo **)
613 PROCEDURE (VAR c: Combo) SetLen* (len: INTEGER), NEW;
614 BEGIN
615 ASSERT(len >= 0, 20);
616 SetLen(c.l, len);
617 c.len := c.l.len
618 END SetLen;
620 PROCEDURE (VAR c: Combo) GetItem* (index: INTEGER; OUT item: String), NEW;
621 BEGIN
622 GetItem(c.l, index, item);
623 c.len := c.l.len
624 END GetItem;
626 PROCEDURE (VAR c: Combo) SetItem* (index: INTEGER; IN item: ARRAY OF CHAR), NEW;
627 BEGIN
628 ASSERT(index >= 0, 20); ASSERT(item # "", 21);
629 SetItem(c.l, index, item);
630 c.len := c.l.len
631 END SetItem;
633 PROCEDURE (VAR c: Combo) SetResources* (IN key: ARRAY OF CHAR), NEW;
634 BEGIN
635 ASSERT(key # "", 20);
636 SetResources(c.l, key);
637 c.len := c.l.len
638 END SetResources;
641 (* Tree and TreeNode *)
643 PROCEDURE (tn: TreeNode) SetName* (name: String), NEW;
644 BEGIN
645 tn.name := name
646 END SetName;
648 PROCEDURE (tn: TreeNode) GetName* (OUT name: String), NEW;
649 BEGIN
650 name := tn.name
651 END GetName;
653 PROCEDURE (tn: TreeNode) SetData* (data: ANYPTR), NEW;
654 BEGIN
655 tn.data := data
656 END SetData;
658 PROCEDURE (tn: TreeNode) Data* (): ANYPTR, NEW;
659 BEGIN
660 RETURN tn.data
661 END Data;
663 PROCEDURE (tn: TreeNode) NofChildren* (): INTEGER, NEW;
664 BEGIN
665 RETURN tn.nofChildren
666 END NofChildren;
668 PROCEDURE (tn: TreeNode) SetExpansion* (expanded: BOOLEAN), NEW;
669 BEGIN
670 tn.expanded := expanded
671 END SetExpansion;
673 PROCEDURE (tn: TreeNode) IsExpanded* (): BOOLEAN, NEW;
674 BEGIN
675 RETURN tn.expanded
676 END IsExpanded;
678 PROCEDURE (tn: TreeNode) IsFolder* (): BOOLEAN, NEW;
679 BEGIN
680 IF (~tn.viewAsFolder) & (tn.firstChild = NIL) THEN
681 RETURN FALSE
682 ELSE
683 RETURN TRUE
684 END
685 END IsFolder;
687 PROCEDURE (tn: TreeNode) ViewAsFolder* (isFolder: BOOLEAN), NEW;
688 BEGIN
689 tn.viewAsFolder := isFolder
690 END ViewAsFolder;
692 PROCEDURE (VAR t: Tree) NofNodes* (): INTEGER, NEW;
693 BEGIN
694 IF t.firstRoot = NIL THEN
695 RETURN 0
696 ELSE
697 RETURN MAX(0, t.nofNodes)
698 END
699 END NofNodes;
701 PROCEDURE (VAR t: Tree) NofRoots* (): INTEGER, NEW;
702 BEGIN
703 IF t.firstRoot = NIL THEN
704 RETURN 0
705 ELSE
706 RETURN MAX(0, t.nofRoots)
707 END
708 END NofRoots;
710 PROCEDURE (VAR t: Tree) Parent* (node: TreeNode): TreeNode, NEW;
711 BEGIN
712 ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 21);
713 RETURN node.parent
714 END Parent;
716 PROCEDURE (VAR t: Tree) Next* (node: TreeNode): TreeNode, NEW;
717 BEGIN
718 ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 21);
719 RETURN node.next
720 END Next;
722 PROCEDURE (VAR t: Tree) Prev* (node: TreeNode): TreeNode, NEW;
723 BEGIN
724 ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 21);
725 RETURN node.prev
726 END Prev;
728 PROCEDURE (VAR t: Tree) Child* (node: TreeNode; pos: INTEGER): TreeNode, NEW;
729 VAR cur: TreeNode;
730 BEGIN
731 ASSERT(pos >= lastPos, 20); ASSERT((node = NIL) OR (node.tree = SYSTEM.ADR(t)), 21);
732 IF node = NIL THEN cur := t.firstRoot
733 ELSE cur := node.firstChild END;
734 IF pos = lastPos THEN
735 WHILE (cur # NIL) & (cur.next # NIL) DO cur := cur.next END
736 ELSE
737 WHILE (cur # NIL) & (pos > 0) DO cur := cur.next; DEC(pos) END
738 END;
739 RETURN cur
740 END Child;
742 PROCEDURE (VAR t: Tree) Selected* (): TreeNode, NEW;
743 BEGIN
744 RETURN t.selected
745 END Selected;
747 PROCEDURE (VAR t: Tree) Select* (node: TreeNode), NEW;
748 BEGIN
749 ASSERT((node = NIL) OR (node.tree = SYSTEM.ADR(t)), 20);
750 IF (node # NIL) OR (t.nofRoots = 0) THEN
751 t.selected := node
752 ELSE
753 t.selected := t.Child(NIL, 0)
754 END
755 END Select;
757 PROCEDURE Include (IN t: Tree; node: TreeNode);
758 VAR c: TreeNode;
759 BEGIN
760 ASSERT(node # NIL, 20); ASSERT(node.tree = 0, 100);
761 node.tree := SYSTEM.ADR(t);
762 c := node.firstChild;
763 WHILE c # NIL DO Include(t, c); c := c.next END
764 END Include;
766 PROCEDURE (VAR t: Tree) InsertAt (parent: TreeNode; pos: INTEGER; node: TreeNode), NEW;
767 VAR
768 cur, prev: TreeNode;
769 BEGIN
770 ASSERT(node # NIL, 20); ASSERT(pos >= lastPos, 21);
771 ASSERT((parent = NIL) OR (parent.tree = SYSTEM.ADR(t)), 22); ASSERT(node.tree = 0, 23);
772 Include(t, node);
773 IF parent = NIL THEN (* Add new root *)
774 IF (t.firstRoot = NIL) OR (pos = 0) THEN
775 node.next := t.firstRoot; node.prev := NIL;
776 IF t.firstRoot # NIL THEN t.firstRoot.prev := node END;
777 t.firstRoot := node
778 ELSE
779 cur := t.firstRoot;
780 IF pos = lastPos THEN pos := t.nofRoots END;
781 WHILE (cur # NIL) & (pos > 0) DO
782 prev := cur; cur := t.Next(cur); DEC(pos)
783 END;
784 IF cur = NIL THEN
785 prev.next := node; node.prev := prev
786 ELSE
787 node.next := cur; node.prev := cur.prev; cur.prev := node; prev.next := node
788 END
789 END;
790 INC(t.nofRoots)
791 ELSE (* Add child *)
792 IF pos = lastPos THEN pos := parent.nofChildren END;
793 IF (parent.firstChild = NIL) OR (pos = 0) THEN
794 IF parent.firstChild # NIL THEN parent.firstChild.prev := node END;
795 node.prev := NIL; node.next := parent.firstChild; parent.firstChild := node
796 ELSE
797 cur := parent.firstChild;
798 WHILE (cur # NIL) & (pos > 0) DO
799 prev := cur; cur := t.Next(cur); DEC(pos)
800 END;
801 IF cur = NIL THEN
802 prev.next := node; node.prev := prev
803 ELSE
804 node.next := cur; node.prev := cur.prev; cur.prev := node; prev.next := node
805 END
806 END;
807 INC(parent.nofChildren)
808 END;
809 node.parent := parent;
810 INC(t.nofNodes)
811 END InsertAt;
813 PROCEDURE (VAR t: Tree) NewChild* (parent: TreeNode; pos: INTEGER; name: String): TreeNode, NEW;
814 VAR
815 new: TreeNode;
816 BEGIN
817 NEW(new); new.tree := 0;
818 new.SetName(name); new.expanded := FALSE; new.nofChildren := 0;
819 new.viewAsFolder := FALSE;
820 t.InsertAt(parent, pos, new);
821 RETURN new
822 END NewChild;
824 PROCEDURE (VAR t: Tree) CountChildren (node: TreeNode): INTEGER, NEW;
825 VAR tot, nofc, i: INTEGER;
826 BEGIN
827 tot := 0;
828 IF node # NIL THEN
829 nofc := node.nofChildren; tot := nofc;
830 FOR i := 0 TO nofc -1 DO
831 tot := tot + t.CountChildren(t.Child(node, i))
832 END
833 END;
834 RETURN tot
835 END CountChildren;
837 PROCEDURE Exclude (IN t: Tree; node: TreeNode);
838 VAR c: TreeNode;
839 BEGIN
840 ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 100);
841 IF t.Selected() = node THEN t.Select(NIL) END;
842 node.tree := 0;
843 c := node.firstChild;
844 WHILE c # NIL DO Exclude(t, c); c := c.next END
845 END Exclude;
847 PROCEDURE (VAR t: Tree) Delete* (node: TreeNode): INTEGER, NEW;
848 VAR
849 ndel: INTEGER;
850 BEGIN
851 ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 21);
852 ndel := t.CountChildren(node);
853 IF node.parent = NIL THEN (* root node *)
854 IF node.prev = NIL THEN
855 IF node.next # NIL THEN
856 t.firstRoot := node.next;
857 node.next.prev := NIL
858 ELSE
859 t.firstRoot := NIL
860 END
861 ELSE
862 node.prev.next := node.next;
863 IF node.next # NIL THEN node.next.prev := node.prev END
864 END;
865 DEC(t.nofRoots)
866 ELSE
867 IF node.prev = NIL THEN
868 IF node.next # NIL THEN
869 node.parent.firstChild := node.next;
870 node.next.prev := NIL
871 ELSE
872 node.parent.firstChild := NIL
873 END
874 ELSE
875 node.prev.next := node.next;
876 IF node.next # NIL THEN node.next.prev := node.prev END
877 END;
878 DEC(node.parent.nofChildren)
879 END;
880 node.parent := NIL; node.next := NIL; node.prev := NIL;
881 Exclude(t, node);
882 ndel := ndel + 1;
883 t.nofNodes := t.nofNodes - ndel;
884 RETURN ndel
885 END Delete;
887 PROCEDURE (VAR t: Tree) Move* (node, parent: TreeNode; pos: INTEGER), NEW;
888 VAR ndel, nofn: INTEGER; s: TreeNode;
889 BEGIN
890 ASSERT(node # NIL, 20); ASSERT(pos >= lastPos, 21);
891 ASSERT(node.tree = SYSTEM.ADR(t), 22);
892 nofn := t.NofNodes();
893 s := t.Selected();
894 ndel := t.Delete(node); t.InsertAt(parent, pos, node);
895 t.nofNodes := t.nofNodes + ndel - 1;
896 IF (s # NIL) & (t.Selected() # s) THEN t.Select(s) END;
897 ASSERT(nofn = t.NofNodes(), 60)
898 END Move;
900 PROCEDURE (VAR t: Tree) DeleteAll*, NEW;
901 BEGIN
902 t.nofRoots := 0; t.nofNodes := 0; t.firstRoot := NIL; t.selected := NIL
903 END DeleteAll;
906 PROCEDURE Notify* (id0, id1: INTEGER; opts: SET);
907 BEGIN
908 ASSERT(notifyHook # NIL, 100);
909 notifyHook.Notify(id0, id1, opts)
910 END Notify;
912 PROCEDURE Update* (IN x: ANYREC);
913 VAR type: Kernel.Type; adr, size: INTEGER;
914 BEGIN
915 adr := SYSTEM.ADR(x);
916 type := Kernel.TypeOf(x);
917 size := type.size;
918 IF size = 0 THEN size := 1 END;
919 Notify(adr, adr + size, {update, guardCheck})
920 END Update;
922 PROCEDURE UpdateBool* (VAR x: BOOLEAN);
923 VAR adr: INTEGER;
924 BEGIN
925 adr := SYSTEM.ADR(x);
926 Notify(adr, adr + SIZE(BOOLEAN), {update, guardCheck})
927 END UpdateBool;
929 PROCEDURE UpdateSChar* (VAR x: SHORTCHAR);
930 VAR adr: INTEGER;
931 BEGIN
932 adr := SYSTEM.ADR(x);
933 Notify(adr, adr + SIZE(SHORTCHAR), {update, guardCheck})
934 END UpdateSChar;
936 PROCEDURE UpdateChar* (VAR x: CHAR);
937 VAR adr: INTEGER;
938 BEGIN
939 adr := SYSTEM.ADR(x);
940 Notify(adr, adr + SIZE(CHAR), {update, guardCheck})
941 END UpdateChar;
943 PROCEDURE UpdateByte* (VAR x: BYTE);
944 VAR adr: INTEGER;
945 BEGIN
946 adr := SYSTEM.ADR(x);
947 Notify(adr, adr + SIZE(BYTE), {update, guardCheck})
948 END UpdateByte;
950 PROCEDURE UpdateSInt* (VAR x: SHORTINT);
951 VAR adr: INTEGER;
952 BEGIN
953 adr := SYSTEM.ADR(x);
954 Notify(adr, adr + SIZE(SHORTINT), {update, guardCheck})
955 END UpdateSInt;
957 PROCEDURE UpdateInt* (VAR x: INTEGER);
958 VAR adr: INTEGER;
959 BEGIN
960 adr := SYSTEM.ADR(x);
961 Notify(adr, adr + SIZE(INTEGER), {update, guardCheck})
962 END UpdateInt;
964 PROCEDURE UpdateLInt* (VAR x: LONGINT);
965 VAR adr: INTEGER;
966 BEGIN
967 adr := SYSTEM.ADR(x);
968 Notify(adr, adr + SIZE(LONGINT), {update, guardCheck})
969 END UpdateLInt;
971 PROCEDURE UpdateSReal* (VAR x: SHORTREAL);
972 VAR adr: INTEGER;
973 BEGIN
974 adr := SYSTEM.ADR(x);
975 Notify(adr, adr + SIZE(SHORTREAL), {update, guardCheck})
976 END UpdateSReal;
978 PROCEDURE UpdateReal* (VAR x: REAL);
979 VAR adr: INTEGER;
980 BEGIN
981 adr := SYSTEM.ADR(x);
982 Notify(adr, adr + SIZE(REAL), {update, guardCheck})
983 END UpdateReal;
985 PROCEDURE UpdateSet* (VAR x: SET);
986 VAR adr: INTEGER;
987 BEGIN
988 adr := SYSTEM.ADR(x);
989 Notify(adr, adr + SIZE(SET), {update, guardCheck})
990 END UpdateSet;
992 PROCEDURE UpdateSString* (IN x: ARRAY OF SHORTCHAR);
993 VAR adr: INTEGER;
994 BEGIN
995 adr := SYSTEM.ADR(x);
996 Notify(adr, adr + LEN(x) * SIZE(SHORTCHAR), {update, guardCheck})
997 END UpdateSString;
999 PROCEDURE UpdateString* (IN x: ARRAY OF CHAR);
1000 VAR adr: INTEGER;
1001 BEGIN
1002 adr := SYSTEM.ADR(x);
1003 Notify(adr, adr + LEN(x) * SIZE(CHAR), {update, guardCheck})
1004 END UpdateString;
1006 PROCEDURE UpdateList* (IN x: ANYREC);
1007 VAR type: Kernel.Type; adr, size: INTEGER;
1008 BEGIN
1009 adr := SYSTEM.ADR(x);
1010 type := Kernel.TypeOf(x);
1011 size := type.size;
1012 IF size = 0 THEN size := 1 END;
1013 Notify(adr, adr + size, {listUpdate, guardCheck})
1014 END UpdateList;
1017 PROCEDURE GetOK* (IN str, p0, p1, p2: ARRAY OF CHAR; form: SET; OUT res: INTEGER);
1018 BEGIN
1019 ASSERT(((yes IN form) = (no IN form)) & ((yes IN form) # (ok IN form)), 20);
1020 ASSERT(gethook # NIL, 100);
1021 gethook.GetOK(str, p0, p1, p2, form, res)
1022 END GetOK;
1024 PROCEDURE GetIntSpec* (defType: Files.Type; VAR loc: Files.Locator; OUT name: Files.Name);
1025 BEGIN
1026 ASSERT(gethook # NIL, 100);
1027 gethook.GetIntSpec(defType, loc, name)
1028 END GetIntSpec;
1030 PROCEDURE GetExtSpec* (defName: Files.Name; defType: Files.Type; VAR loc: Files.Locator;
1031 OUT name: Files.Name);
1032 BEGIN
1033 ASSERT(gethook # NIL, 100);
1034 gethook.GetExtSpec(defName, defType, loc, name)
1035 END GetExtSpec;
1037 PROCEDURE GetColor* (in: INTEGER; OUT out: INTEGER; OUT set: BOOLEAN);
1038 BEGIN
1039 ASSERT(gethook # NIL, 100);
1040 gethook.GetColor(in, out, set)
1041 END GetColor;
1044 PROCEDURE Subst (in: ARRAY OF CHAR; IN p0, p1, p2: ARRAY OF CHAR; VAR out: ARRAY OF CHAR);
1045 VAR len, i, j, k: INTEGER; ch, c: CHAR;
1046 BEGIN
1047 i := 0; ch := in[i]; j := 0; len := LEN(out) - 1;
1048 WHILE (ch # 0X) & (j < len) DO
1049 IF ch = "^" THEN
1050 INC(i); ch := in[i];
1051 IF ch = "0" THEN
1052 k := 0; c := p0[0];
1053 WHILE (c # 0X) & (j < len) DO out[j] := c; INC(j); INC(k); c := p0[k] END;
1054 INC(i); ch := in[i]
1055 ELSIF ch = "1" THEN
1056 k := 0; c := p1[0];
1057 WHILE (c # 0X) & (j < len) DO out[j] := c; INC(j); INC(k); c := p1[k] END;
1058 INC(i); ch := in[i]
1059 ELSIF ch = "2" THEN
1060 k := 0; c := p2[0];
1061 WHILE (c # 0X) & (j < len) DO out[j] := c; INC(j); INC(k); c := p2[k] END;
1062 INC(i); ch := in[i]
1063 ELSE out[j] := "^"; INC(j)
1064 END
1065 ELSE out[j] := ch; INC(j); INC(i); ch := in[i]
1066 END
1067 END;
1068 out[j] := 0X
1069 END Subst;
1071 PROCEDURE FlushMappings*;
1072 BEGIN
1073 tabList := NIL
1074 END FlushMappings;
1076 PROCEDURE MapParamString* (in, p0, p1, p2: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
1077 (* use in as key in string table file, and return corresponding string in out.
1078 If the resource lookup fails, return in in out *)
1079 BEGIN
1080 SearchString(in, out);
1081 IF out # "" THEN Subst(out, p0, p1, p2, out)
1082 ELSE Subst(in, p0, p1, p2, out)
1083 END
1084 END MapParamString;
1086 PROCEDURE MapString* (in: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
1087 VAR len, k: INTEGER;
1088 BEGIN
1089 SearchString(in, out);
1090 IF out = "" THEN
1091 k := 0; len := LEN(out)-1;
1092 WHILE (k < len) & (in[k] # 0X) DO out[k] := in[k]; INC(k) END;
1093 out[k] := 0X
1094 END
1095 END MapString;
1097 PROCEDURE ShowMsg* (IN str: ARRAY OF CHAR);
1098 BEGIN
1099 ASSERT(str # "", 20);
1100 ASSERT(showHook # NIL, 100);
1101 showHook.ShowParamMsg(str, "", "", "")
1102 END ShowMsg;
1104 PROCEDURE ShowParamMsg* (IN str, p0, p1, p2: ARRAY OF CHAR);
1105 BEGIN
1106 ASSERT(str # "", 20);
1107 ASSERT(showHook # NIL, 100);
1108 showHook.ShowParamMsg(str,p0, p1, p2)
1109 END ShowParamMsg;
1111 PROCEDURE ShowStatus* (IN str: ARRAY OF CHAR);
1112 BEGIN
1113 ASSERT(showHook # NIL, 100);
1114 showHook.ShowParamStatus(str, "", "", "")
1115 END ShowStatus;
1117 PROCEDURE ShowParamStatus* (IN str, p0, p1, p2: ARRAY OF CHAR);
1118 BEGIN
1119 ASSERT(showHook # NIL, 100);
1120 showHook.ShowParamStatus(str, p0, p1, p2)
1121 END ShowParamStatus;
1124 PROCEDURE Call* (IN proc, errorMsg: ARRAY OF CHAR; OUT res: INTEGER);
1125 BEGIN
1126 ASSERT(callHook # NIL, 100);
1127 callHook.Call(proc, errorMsg, res)
1128 END Call;
1130 PROCEDURE Beep*;
1131 BEGIN
1132 Kernel.Beep
1133 END Beep;
1135 PROCEDURE (n: LangNotifier) Notify-(), NEW, ABSTRACT;
1137 PROCEDURE RegisterLangNotifier* (notifier: LangNotifier);
1138 VAR nl: LangNotifier;
1139 BEGIN
1140 ASSERT(notifier # NIL, 20);
1141 nl := langNotifiers;
1142 WHILE (nl # NIL) & (nl # notifier) DO nl := nl.next END;
1143 IF nl = NIL THEN
1144 notifier.next := langNotifiers; langNotifiers := notifier
1145 END
1146 END RegisterLangNotifier;
1148 PROCEDURE RemoveLangNotifier* (notifier: LangNotifier);
1149 VAR nl, prev: LangNotifier;
1150 BEGIN
1151 ASSERT(notifier # NIL, 20);
1152 nl := langNotifiers; prev := NIL;
1153 WHILE (nl # NIL) & (nl # notifier) DO prev := nl; nl := nl.next END;
1154 IF nl # NIL THEN
1155 IF prev = NIL THEN langNotifiers := langNotifiers.next ELSE prev.next := nl.next END;
1156 nl.next := NIL
1157 END
1158 END RemoveLangNotifier;
1160 PROCEDURE Exec (a, b, c: INTEGER);
1161 VAR nl: LangNotifier;
1162 BEGIN
1163 nl := currentNotifier; currentNotifier := NIL;
1164 nl.Notify;
1165 currentNotifier := nl
1166 END Exec;
1168 PROCEDURE SetLanguage* (lang: Language; persistent: BOOLEAN);
1169 VAR nl, t: LangNotifier; ok: BOOLEAN;
1170 BEGIN
1171 ASSERT((lang = "") OR (LEN(lang$) = 2), 20);
1172 ASSERT(languageHook # NIL, 100);
1173 IF lang # language THEN
1174 languageHook.SetLanguage(lang, persistent, ok);
1175 IF ok THEN
1176 language := lang; FlushMappings;
1177 nl := langNotifiers;
1178 WHILE nl # NIL DO
1179 currentNotifier := nl;
1180 Kernel.Try(Exec, 0, 0, 0);
1181 IF currentNotifier = NIL THEN
1182 t := nl; nl := nl.next; RemoveLangNotifier(t) (* Notifier trapped, remove it *)
1183 ELSE
1184 nl := nl.next
1185 END
1186 END
1187 END;
1188 currentNotifier := NIL
1189 END
1190 END SetLanguage;
1192 PROCEDURE ResetLanguage*;
1193 VAR lang: Language;
1194 BEGIN
1195 ASSERT(languageHook # NIL, 100);
1196 languageHook.GetPersistentLanguage(lang);
1197 SetLanguage(lang, nonPersistent)
1198 END ResetLanguage;
1200 BEGIN
1201 appName := "BlackBox"; showsStatus := FALSE; caretPeriod := 500; thickCaret := FALSE; user := ""
1202 END Dialog.