Trurl-based/System/Mod/Dialog.txt

   1 MODULE Dialog;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Dialog.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT SYSTEM, Kernel, Files;
   7
   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 **)
  12
  13                 stringLen = 256;
  14                 bufLen = 252;
  15
  16                 rsrcDir = "Rsrc";
  17                 stringFile = "Strings";
  18                 TAB = 09X; CR = 0DX;
  19                 update = 2;     (* notify options *)
  20                 listUpdate = 3;
  21                 guardCheck = 4;
  22
  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;
  35
  36                 firstPos* = 0;
  37                 lastPos* = -1;
  38
  39         TYPE
  40                 String* = ARRAY stringLen OF CHAR;
  41
  42                 Buf = POINTER TO RECORD
  43                         next: Buf;
  44                         s: ARRAY bufLen OF CHAR
  45                 END;
  46
  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;
  54
  55                 List* = RECORD
  56                         index*: INTEGER;        (** val IN [0, n-1] **)
  57                         len-: INTEGER;
  58                         l: StrList
  59                 END;
  60
  61                 Combo* = RECORD
  62                         item*: String;
  63                         len-: INTEGER;
  64                         l: StrList
  65                 END;
  66
  67                 Selection* = RECORD
  68                         len-: INTEGER;
  69                         sel: POINTER TO ARRAY OF SET;
  70                         l: StrList
  71                 END;
  72
  73                 Currency* = RECORD      (* number = val * 10^-scale *)
  74                         val*: LONGINT;
  75                         scale*: INTEGER
  76                 END;
  77
  78                 Color* = RECORD
  79                         val*: INTEGER
  80                 END;
  81
  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;
  90
  91                 Tree* = RECORD
  92                         nofRoots, nofNodes: INTEGER;
  93                         firstRoot, selected: TreeNode
  94                 END;
  95
  96                 (** command procedure types**)
  97
  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;
 105
 106                 GuardProc* = PROCEDURE (VAR par: Par);
 107                 NotifierProc* = PROCEDURE (op, from, to: INTEGER);
 108
 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;
 117
 118                 LangNotifier* = POINTER TO ABSTRACT RECORD next: LangNotifier END;
 119                 Language* = ARRAY 3 OF CHAR;
 120
 121                 LangTrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
 122
 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;
 128
 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;
 140
 141                 tabList: StringTab;
 142                 langNotifiers: LangNotifier;
 143                 currentNotifier: LangNotifier;
 144
 145                 gethook: GetHook;
 146                 showHook: ShowHook;
 147                 callHook: CallHook;
 148                 notifyHook: NotifyHook;
 149                 languageHook: LanguageHook;
 150
 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;
 159
 160         PROCEDURE SetGetHook*(h: GetHook);
 161         BEGIN
 162                 gethook := h
 163         END SetGetHook;
 164
 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;
 167
 168         PROCEDURE SetShowHook* (h: ShowHook);
 169         BEGIN
 170                 showHook := h
 171         END SetShowHook;
 172
 173         PROCEDURE (h: CallHook) Call* (IN proc, errorMsg: ARRAY OF CHAR; VAR res: INTEGER), NEW, ABSTRACT;
 174
 175         PROCEDURE SetCallHook* (h: CallHook);
 176         BEGIN
 177                 callHook := h
 178         END SetCallHook;
 179
 180         PROCEDURE (h: NotifyHook) Notify* (id0, id1: INTEGER; opts: SET), NEW, ABSTRACT;
 181
 182         PROCEDURE SetNotifyHook* (h: NotifyHook);
 183         BEGIN
 184                 notifyHook := h
 185         END SetNotifyHook;
 186
 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;
 190
 191         PROCEDURE SetLanguageHook* (h: LanguageHook);
 192         BEGIN
 193                 languageHook := h
 194         END SetLanguageHook;
 195
 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;
 199
 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;
 208
 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;
 225
 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;
 299
 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;
 352
 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;
 373
 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;
 409
 410
 411         PROCEDURE Init (VAR l: StrList);
 412         BEGIN
 413                 l.len := 0; l.max := 0; l.end := 0; l.scnt := 0
 414         END Init;
 415
 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;
 441
 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;
 464
 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;
 481
 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;
 500
 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;
 517
 518
 519         (** List **)
 520
 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;
 527
 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;
 533
 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;
 540
 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;
 547
 548
 549         (** Selection **)
 550
 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;
 567
 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;
 573
 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;
 580
 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;
 587
 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;
 593
 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;
 601
 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;
 609
 610
 611         (** Combo **)
 612
 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;
 619
 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;
 625
 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;
 632
 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;
 639
 640
 641         (* Tree and TreeNode *)
 642
 643         PROCEDURE (tn: TreeNode) SetName* (name: String), NEW;
 644         BEGIN
 645                 tn.name := name
 646         END SetName;
 647
 648         PROCEDURE (tn: TreeNode) GetName* (OUT name: String), NEW;
 649         BEGIN
 650                 name := tn.name
 651         END GetName;
 652
 653         PROCEDURE (tn: TreeNode) SetData* (data: ANYPTR), NEW;
 654         BEGIN
 655                 tn.data := data
 656         END SetData;
 657
 658         PROCEDURE (tn: TreeNode) Data* (): ANYPTR, NEW;
 659         BEGIN
 660                 RETURN tn.data
 661         END Data;
 662
 663         PROCEDURE (tn: TreeNode) NofChildren* (): INTEGER, NEW;
 664         BEGIN
 665                 RETURN tn.nofChildren
 666         END NofChildren;
 667
 668         PROCEDURE (tn: TreeNode) SetExpansion* (expanded: BOOLEAN), NEW;
 669         BEGIN
 670                 tn.expanded := expanded
 671         END SetExpansion;
 672
 673         PROCEDURE (tn: TreeNode) IsExpanded* (): BOOLEAN, NEW;
 674         BEGIN
 675                 RETURN tn.expanded
 676         END IsExpanded;
 677
 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;
 686
 687         PROCEDURE (tn: TreeNode) ViewAsFolder* (isFolder: BOOLEAN), NEW;
 688         BEGIN
 689                 tn.viewAsFolder := isFolder
 690         END ViewAsFolder;
 691
 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;
 700
 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;
 709
 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;
 715
 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;
 721
 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;
 727
 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;
 741
 742         PROCEDURE (VAR t: Tree) Selected* (): TreeNode, NEW;
 743         BEGIN
 744                 RETURN t.selected
 745         END Selected;
 746
 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;
 756
 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;
 765
 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;
 812
 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;
 823
 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;
 836
 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;
 846
 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;
 886
 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;
 899
 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;
 904
 905
 906         PROCEDURE Notify* (id0, id1: INTEGER; opts: SET);
 907         BEGIN
 908                 ASSERT(notifyHook # NIL, 100);
 909                 notifyHook.Notify(id0, id1, opts)
 910         END Notify;
 911
 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;
 921
 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;
 928
 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;
 935
 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;
 942
 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;
 949
 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;
 956
 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;
 963
 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;
 970
 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;
 977
 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;
 984
 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;
 991
 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;
 998
 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;
1005
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;
1015
1016
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;
1023
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;
1029
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;
1036
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;
1042
1043
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;
1070
1071         PROCEDURE FlushMappings*;
1072         BEGIN
1073                 tabList := NIL
1074         END FlushMappings;
1075
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;
1085
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;
1096
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;
1103
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;
1110
1111         PROCEDURE ShowStatus* (IN str: ARRAY OF CHAR);
1112         BEGIN
1113                 ASSERT(showHook # NIL, 100);
1114                 showHook.ShowParamStatus(str, "", "", "")
1115         END ShowStatus;
1116
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;
1122
1123
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;
1129
1130         PROCEDURE Beep*;
1131         BEGIN
1132                 Kernel.Beep
1133         END Beep;
1134
1135         PROCEDURE (n: LangNotifier) Notify-(), NEW, ABSTRACT;
1136
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;
1147
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;
1159
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;
1167
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;
1191
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;
1199
1200 BEGIN
1201         appName := "BlackBox"; showsStatus := FALSE; caretPeriod := 500; thickCaret := FALSE; user := ""
1202 END Dialog.