MODULE DevInspector;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- 20151027, center #80, bug fix in GetTypeName/MapLabel for System resources
	- 20160129, center #101, source link buttons added
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		Kernel, Services, Stores, Views, Controllers, Properties, Containers, Dialog,
		Controls, Librarian,
		TextModels, Files, Models, StdDialog, TextViews, TextControllers, Strings;
	
	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);
			Librarian.lib.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
		Librarian.lib.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;
	
	PROCEDURE SearchIdent(t: TextModels.Model; startPos: INTEGER; ident: ARRAY OF CHAR; exp: BOOLEAN;
											VAR beg, end: INTEGER);
		VAR r: TextModels.Reader; found: BOOLEAN; ch: CHAR; len, i: INTEGER;
	BEGIN
		end := 0;
		IF ident # "" THEN
			r := t.NewReader(NIL); found := FALSE;
			beg := startPos; r.SetPos(startPos); r.ReadChar(ch);
			WHILE ~r.eot & ~found DO
				(* search legal start symbol *)
				WHILE ~r.eot & ~Strings.IsIdentStart(ch) DO
					INC(beg); r.ReadChar(ch)
				END;
				i := 0; len := LEN(ident$);
				WHILE ~r.eot & (i # len) & (ch = ident[i]) DO
					r.ReadChar(ch); INC(i)
				END;
				found := (i = len) & ~Strings.IsIdent(ch);
				IF ~r.eot & ~found THEN	(* skip rest of identifier *)
					beg := r.Pos() - 1;
					WHILE ~r.eot & Strings.IsIdent(ch) DO
						INC(beg); r.ReadChar(ch)
					END
				END;
				IF found THEN
					end := r.Pos() - 1;
					IF exp THEN (* check for export mark *)
						WHILE ~r.eot & (ch <= ' ') DO
							r.ReadChar(ch);
						END;
						IF r.eot OR ((ch # '*') & (ch # '-')) THEN found := FALSE; beg := r.Pos() - 1; end := 0 END
					END
				ELSE
					end := 0
				END
			END
		END
	END SearchIdent;

	PROCEDURE OpenModule(module: ARRAY OF CHAR): TextModels.Model;
		VAR loc: Files.Locator; name: Files.Name;
			v: Views.View; m: Models.Model;
	BEGIN
		StdDialog.GetSubLoc(module, "Mod", loc, name);
		Files.dir.GetFileName(name, Files.docType, name);
		v := Views.OldView(loc, name);
		IF v # NIL THEN
			Views.Open(v, loc, name, NIL);
			m := v.ThisModel();
			IF (m # NIL) & (m IS TextModels.Model) THEN
				RETURN m(TextModels.Model);
			ELSE
				Dialog.ShowParamMsg("#Dev:NoTextFileFound", "'" + name + "'", "", "")
			END
		ELSIF module = "" THEN Dialog.ShowMsg("#Dev:NoModNameFound")
		ELSE Dialog.ShowParamMsg("#Dev:SourcefileNotFound", "'" + module + "'", "", "")
		END;
		RETURN NIL
	END OpenModule;

	PROCEDURE StartPos(t: TextModels.Model): INTEGER;
		VAR varPos, procPos, beg, end: INTEGER;
	BEGIN
		SearchIdent(t, 0, "VAR", FALSE, beg, end);
		IF end > 0 THEN varPos :=beg ELSE varPos := t.Length() END;
		SearchIdent(t, 0, "PROCEDURE", FALSE, beg, end);
		IF end > 0 THEN procPos :=beg ELSE procPos := t.Length() END;
		(* note that guards and notifiers can also be procedure variables *)
		RETURN MIN(varPos, procPos)
	END StartPos;

	PROCEDURE SearchSource(qualident: ARRAY OF CHAR);
		VAR i, j, pos, beg, end, lastBeg, lastEnd: INTEGER; ch: CHAR; module, ident: ARRAY 256 OF CHAR;
			t: TextModels.Model; found: BOOLEAN;
	BEGIN
		i := 0; ch := qualident[0];
		WHILE (ch # 0X) & (ch # '.') DO
			module[i] := ch; INC(i); ch := qualident[i]
		END;
		module[i] := 0X;
		t := OpenModule(module$);
		IF t # NIL THEN
			found := TRUE; pos := StartPos(t); lastEnd := 0; ident := "";
			WHILE found & (ch = '.') DO
				j := 0; INC(i); ch := qualident[i];
				WHILE Strings.IsIdent(ch) DO
					ident[j] := ch; INC(i); INC(j); ch := qualident[i]
				END;
				ident[j] := 0X;
				SearchIdent(t, pos, ident$, TRUE, beg, end);
				found := end > 0;
				IF found THEN lastBeg := beg; lastEnd := end; pos := end + 1
				ELSIF ident # "" THEN
					Dialog.ShowParamMsg("#Dev:NotFound", "'" + ident + "'", "", "")
				END
			END;
			IF lastEnd > 0 THEN
				TextViews.ShowRange(t, lastBeg, lastEnd, TextViews.any);
				TextControllers.SetSelection(t, lastBeg, lastEnd)
			END
		END
	END SearchSource;

	PROCEDURE SearchKey(v: Views.View; loc: Files.Locator; name: Files.Name; key: ARRAY OF CHAR; 
										OUT found: BOOLEAN);
		VAR m: Models.Model; t: TextModels.Model; R: TextModels.Reader; ch: CHAR; i, len, beg: INTEGER;
	BEGIN
		found := FALSE; m := v.ThisModel(); len := LEN(key$);
		IF (m # NIL) & (m IS TextModels.Model) THEN
			t := m(TextModels.Model);
			R := t.NewReader(NIL); R.ReadChar(ch);
			WHILE ~R.eot & ~found DO
				i := 0; beg := R.Pos() - 1;
				WHILE (~R.eot) & (i < len) & (ch = key[i]) DO INC(i); R.ReadChar(ch) END;
				IF ~R.eot & (i = len) & (ch = TextModels.tab) THEN (* found *)
					Views.Open(v, loc, name, NIL);
					TextViews.ShowRange(t, beg, R.Pos() - 1, TextViews.any); (* works only if v is open *)
					TextControllers.SetSelection(t, beg, R.Pos() - 1); (* works only if v is open *)
					found := TRUE
				ELSE (* skip rest of line *)
					WHILE ~R.eot & (ch # TextModels.line) DO R.ReadChar(ch) END;
					R.ReadChar(ch)
				END
			END
		END
	END SearchKey;

	PROCEDURE OpenStrings(subsys: Files.Name; key, language: ARRAY OF CHAR; 
								OUT v: Views.View; OUT loc: Files.Locator; OUT name: Files.Name; OUT found: BOOLEAN);
	BEGIN
		name := "Strings"; v := NIL; found := FALSE;
		loc := Files.dir.This(subsys).This("Rsrc");
		IF language # "" THEN loc := loc.This(language) END ;
		v := Views.OldView(loc, name);
		IF v # NIL THEN
			IF key # "" THEN SearchKey(v, loc, name, key, found)
			ELSE found := TRUE; Views.Open(v, loc, name, NIL)
			END
		END
	END OpenStrings;

	PROCEDURE SearchStrings(key: ARRAY OF CHAR);
		VAR subsys: Files.Name; i: INTEGER; ch: CHAR;
			 v: Views.View; loc: Files.Locator; name: Files.Name; found: BOOLEAN;
	BEGIN
		ASSERT(key[0] = "#", 20); ASSERT(key[1] # 0X, 21); ASSERT(key[1] # ":", 22);
		i := 0; ch := key[1];
		WHILE (ch # 0X) & (ch # ":") DO subsys[i] := ch; INC(i); ch := key[i + 1] END;
		subsys[i] := 0X;
		IF ch = ":" THEN Strings.Extract(key, i + 2, LEN(key$), key)
		ELSE key := ""
		END;
		IF (Dialog.language # Dialog.defaultLanguage) & (Dialog.language # "") THEN
			OpenStrings(subsys, key, Dialog.language, v, loc, name, found);
			IF ~found THEN OpenStrings(subsys, key, "", v, loc, name, found) END
		ELSE
			OpenStrings(subsys, key, "", v, loc, name, found)
		END ;
		IF v = NIL THEN
			Dialog.ShowParamMsg("#Dev:ResourceNotFound", "'" + name + "'", "'" + subsys + "'", "")
		ELSIF ~found THEN
			Views.Open(v, loc, name, NIL); Dialog.ShowParamMsg("#Dev:NotFound", "'" + key + "'", "", "")
		END
	END SearchStrings;

	PROCEDURE LinkSourceGuard* (VAR par: Dialog.Par);
	BEGIN
		IF inspect.link = "" THEN par.disabled := TRUE END
	END LinkSourceGuard;

	PROCEDURE LinkSource*;
	BEGIN
		SearchSource(inspect.link)
	END LinkSource;

	PROCEDURE LabelSourceGuard* (VAR par: Dialog.Par);
	BEGIN
		IF (inspect.label[0] # "#") OR (inspect.label[1] = 0X) OR (inspect.label[1] = ":") THEN
			par.disabled := TRUE
		END
	END LabelSourceGuard;

	PROCEDURE LabelSource*;
	BEGIN
		SearchStrings(inspect.label)
	END LabelSource;

	PROCEDURE GuardSourceGuard* (VAR par: Dialog.Par);
	BEGIN
		IF inspect.guard = "" THEN par.disabled := TRUE END
	END GuardSourceGuard;

	PROCEDURE GuardSource*;
	BEGIN
		SearchSource(inspect.guard)
	END GuardSource;

	PROCEDURE NotifierSourceGuard* (VAR par: Dialog.Par);
	BEGIN
		IF inspect.notifier = "" THEN par.disabled := TRUE END
	END NotifierSourceGuard;

	PROCEDURE NotifierSource*;
	BEGIN
		SearchSource(inspect.notifier)
	END NotifierSource;

BEGIN
	NEW(action); Services.DoLater(action, Services.now)
END DevInspector.




 DevCompiler.Compile

 " DevInspector.InitDialog; StdCmds.OpenAuxDialog('Dev/Rsrc/Inspect', '#Dev:Inspect') "

 " DevDebug.Unload; DevInspector.InitDialog; StdCmds.OpenAuxDialog('Dev/Rsrc/Inspect', '#Dev:Inspect') "
