Trurl-based/System/Mod/Controls.txt

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