MODULE DevInspector;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT Kernel, Services, Stores, Views, Controllers, Properties, Containers, Dialog, Controls;
CONST
multiView = TRUE;
TYPE
Action = POINTER TO RECORD (Services.Action) END;
VAR
inspect*: RECORD
control-: Dialog.String;
label*: Dialog.String; (* ARRAY 40 OF CHAR; *)
link*, guard*, notifier*: Dialog.String;
level*: INTEGER;
opt0*, opt1*, opt2*, opt3*, opt4*: BOOLEAN;
known, valid: SET;
type: Stores.TypeName
END;
fingerprint: INTEGER;
action: Action;
PROCEDURE GetTypeName (v: Views.View; VAR t, s: ARRAY OF CHAR);
VAR c: Containers.Controller; w: Views.View; subs, cntr: Dialog.String;
BEGIN
s := ""; t := "";
IF multiView THEN
c := Containers.Focus();
IF c # NIL THEN
c.GetFirstView(Containers.selection, v); w := v;
WHILE (w # NIL) & Services.SameType(w, v) DO c.GetNextView(Containers.selection, w) END;
IF w # NIL THEN v := NIL END
END
END;
IF v # NIL THEN
Services.GetTypeName(v, t); Kernel.SplitName(t, subs, cntr);
Dialog.MapString("#" + subs + ":" + cntr, s);
IF s = cntr THEN Dialog.MapString("#Dev:" + t, s) END
END
END GetTypeName;
PROCEDURE PollProp (v: Views.View);
VAR msg: Properties.PollMsg; q: Properties.Property; p: Controls.Prop;
BEGIN
inspect.control := ""; inspect.link := ""; inspect.label := '';
inspect.guard := ""; inspect.notifier := ""; inspect.level := 0;
inspect.opt0 := FALSE; inspect.opt1 := FALSE;
inspect.opt2 := FALSE; inspect.opt3 := FALSE; inspect.opt4 := FALSE;
inspect.known := {}; inspect.valid := {};
IF multiView OR (v # NIL) THEN
GetTypeName(v, inspect.type, inspect.control);
IF multiView THEN
Properties.CollectProp(q)
ELSE
msg.prop := NIL; Views.HandlePropMsg(v, msg); q := msg.prop
END;
WHILE (q # NIL) & ~(q IS Controls.Prop) DO q := q.next END;
IF q # NIL THEN
p := q(Controls.Prop);
inspect.known := p.known; inspect.valid := p.valid;
IF Controls.link IN p.valid THEN inspect.link := p.link$ END;
IF Controls.label IN p.valid THEN inspect.label := p.label$ END;
IF Controls.guard IN p.valid THEN inspect.guard := p.guard$ END;
IF Controls.notifier IN p.valid THEN inspect.notifier := p.notifier$ END;
IF Controls.level IN p.valid THEN inspect.level := p.level END;
IF Controls.opt0 IN p.valid THEN inspect.opt0 := p.opt[0] END;
IF Controls.opt1 IN p.valid THEN inspect.opt1 := p.opt[1] END;
IF Controls.opt2 IN p.valid THEN inspect.opt2 := p.opt[2] END;
IF Controls.opt3 IN p.valid THEN inspect.opt3 := p.opt[3] END;
IF Controls.opt4 IN p.valid THEN inspect.opt4 := p.opt[4] END
END
END;
Dialog.Update(inspect)
END PollProp;
PROCEDURE SetProp (v: Views.View);
VAR p: Controls.Prop; msg: Properties.SetMsg;
BEGIN
IF multiView OR (v # NIL) THEN
NEW(p);
p.valid := inspect.valid;
p.link := inspect.link$; p.label := inspect.label$;
p.guard := inspect.guard$; p.notifier := inspect.notifier$;
p.level := inspect.level;
p.opt[0] := inspect.opt0;
p.opt[1] := inspect.opt1;
p.opt[2] := inspect.opt2;
p.opt[3] := inspect.opt3;
p.opt[4] := inspect.opt4;
IF multiView THEN Properties.EmitProp(NIL, p)
ELSE msg.old := NIL; msg.prop := p; Views.HandlePropMsg(v, msg)
END
END
END SetProp;
PROCEDURE Singleton (): Views.View;
VAR v: Views.View;
BEGIN
v := Containers.FocusSingleton();
RETURN v
END Singleton;
PROCEDURE (a: Action) Do;
VAR c: Containers.Controller; v: Views.View; fp: INTEGER;
BEGIN
Controllers.SetCurrentPath(Controllers.targetPath);
IF multiView THEN
c := Containers.Focus(); fp := 0;
IF c # NIL THEN
c.GetFirstView(TRUE, v);
WHILE v # NIL DO fp := fp + Services.AdrOf(v); c.GetNextView(TRUE, v) END
END
ELSE
v := Singleton();
IF v = NIL THEN fp := 0 ELSE fp := Services.AdrOf(v) END
END;
IF fp # fingerprint THEN PollProp(v); fingerprint := fp END;
Controllers.ResetCurrentPath();
Services.DoLater(action, Services.Ticks() + Services.resolution DIV 2)
END Do;
PROCEDURE InitDialog*;
BEGIN
Controllers.SetCurrentPath(Controllers.targetPath);
PollProp(Singleton());
Controllers.ResetCurrentPath()
END InitDialog;
PROCEDURE GetNext*;
VAR c: Containers.Controller; v: Views.View;
BEGIN
Controllers.SetCurrentPath(Controllers.targetPath);
c := Containers.Focus();
IF c # NIL THEN
IF c.HasSelection() THEN v := c.Singleton() ELSE v := NIL END;
IF v = NIL THEN
c.GetFirstView(Containers.any, v)
ELSE
c.GetNextView(Containers.any, v);
IF v = NIL THEN c.GetFirstView(Containers.any, v) END
END;
c.SelectAll(FALSE);
IF v # NIL THEN c.SetSingleton(v); c.MakeViewVisible(v) END;
PollProp(v)
ELSE Dialog.ShowMsg("#Dev:NoTargetFocusFound")
END;
Controllers.ResetCurrentPath()
END GetNext;
PROCEDURE Set*;
VAR v: Views.View;
BEGIN
Controllers.SetCurrentPath(Controllers.targetPath);
v := Singleton();
IF multiView OR (v # NIL) THEN SetProp(v); PollProp(v) END;
Controllers.ResetCurrentPath()
END Set;
PROCEDURE MapLabel (
IN control: Stores.TypeName; IN type: Dialog.String; i: INTEGER; VAR label: Dialog.String
);
VAR l, k, subs, cntr: Dialog.String; si: ARRAY 2 OF CHAR;
BEGIN
Kernel.SplitName(control, subs, cntr);
si[0] := CHR(i + ORD("0")); si[1] := 0X;
k := cntr + "." + type + si;
Dialog.MapString("#" + subs + ":" + k, l);
IF l$ # k$ THEN label := l$ END
END MapLabel;
PROCEDURE OptGuard* (opt: INTEGER; VAR par: Dialog.Par);
VAR name: ARRAY 64 OF CHAR; num: ARRAY 2 OF CHAR;
BEGIN
ASSERT((opt >= 0) & (opt <= 9), 20);
IF ~(opt IN inspect.known) OR (inspect.type = "") THEN
par.disabled := TRUE
ELSE
num[0] := CHR(opt + ORD("0")); num[1] := 0X;
name := inspect.type + ".Opt" + num;
par.label := "#Dev:" + name;
Dialog.MapString(par.label, par.label);
IF par.label = name THEN par.label := "" END;
IF ~(opt IN inspect.valid) THEN par.undef := TRUE END;
MapLabel(inspect.type, "Opt", opt, par.label)
END
END OptGuard;
PROCEDURE LevelGuard* (VAR par: Dialog.Par);
BEGIN
IF ~(Controls.level IN inspect.known) THEN par.disabled := TRUE
ELSIF ~(Controls.level IN inspect.valid) THEN par.undef := TRUE
END;
IF inspect.type # "" THEN MapLabel(inspect.type, "Field", 5, par.label) END
END LevelGuard;
PROCEDURE NotifierGuard* (VAR par: Dialog.Par);
BEGIN
IF ~(Controls.notifier IN inspect.known) THEN par.disabled := TRUE
ELSIF ~(Controls.notifier IN inspect.valid) THEN par.undef := TRUE
END;
IF inspect.type # "" THEN MapLabel(inspect.type, "Field", 4, par.label) END
END NotifierGuard;
PROCEDURE GuardGuard* (VAR par: Dialog.Par);
BEGIN
IF ~(Controls.guard IN inspect.known) THEN par.disabled := TRUE
ELSIF ~(Controls.guard IN inspect.valid) THEN par.undef := TRUE
END;
IF inspect.type # "" THEN MapLabel(inspect.type, "Field", 3, par.label) END
END GuardGuard;
PROCEDURE LabelGuard* (VAR par: Dialog.Par);
BEGIN
IF ~(Controls.label IN inspect.known) THEN par.disabled := TRUE
ELSIF ~(Controls.label IN inspect.valid) THEN par.undef := TRUE
END;
IF inspect.type # "" THEN MapLabel(inspect.type, "Field", 2, par.label) END
END LabelGuard;
PROCEDURE LinkGuard* (VAR par: Dialog.Par);
BEGIN
IF ~(Controls.link IN inspect.known) THEN par.disabled := TRUE
ELSIF ~(Controls.link IN inspect.valid) THEN par.undef := TRUE
END;
IF inspect.type # "" THEN MapLabel(inspect.type, "Field", 1, par.label) END
END LinkGuard;
PROCEDURE ControlGuard* (VAR par: Dialog.Par);
BEGIN
IF inspect.known = {} THEN par.disabled := TRUE END
END ControlGuard;
PROCEDURE Notifier* (idx, op, from, to: INTEGER);
BEGIN
IF op = Dialog.changed THEN INCL(inspect.valid, idx) END
END Notifier;
BEGIN
NEW(action); Services.DoLater(action, Services.now)
END DevInspector.
DevCompiler.Compile
" DevInspector.InitDialog; OpenAuxDialog('#Dev:inspect', 'Inspect') "
" Unload('DevInspector'); DevInspector.InitDialog; OpenAuxDialog('DevInspector.inspect', 'Inspect') "