Dev/Mod/LinkChk.odc

MODULE DevLinkChk;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		Kernel, Strings, Dialog, Files, Fonts, Ports, Converters, Views, Containers,
		TextModels, TextMappers, TextViews, TextControllers, StdLinks, StdCmds;

	CONST
		oneSubsystem* = 0; globalSubsystem* = 1; allSubsystems* = 2;
		linkCommand = "DevLinkChk.Open('";

	VAR
		par*: RECORD
			scope*: INTEGER;	(* IN {oneSubsystem, globalSubsystem, allSubsystems} *)
			subsystem*: ARRAY 9 OF CHAR;
			legal: BOOLEAN	(* legal => correct syntax for a subsystem name # "" *)
		END;


	TYPE
		Iterator = POINTER TO IteratorDesc;
		IteratorDesc = RECORD
			root: Files.Locator;
			locs: Files.LocInfo;
			files: Files.FileInfo
		END;

	VAR default, link: TextModels.Attributes;

	PROCEDURE MakeDocName (VAR name: Files.Name);
	BEGIN
		Kernel.MakeFileName(name, "")
	END MakeDocName;

	PROCEDURE New (root: Files.Locator): Iterator;
		VAR i: Iterator;
	BEGIN
		NEW(i); i.root := root; i.locs := Files.dir.LocList(root); i.files := Files.dir.FileList(root);
		(* could sort by name *)
		RETURN i
	END New;

	PROCEDURE ReadLoc (i: Iterator; VAR loc: Files.Locator; VAR name: Files.Name);
	BEGIN
		IF i.locs # NIL THEN
			loc := i.root.This(i.locs.name); ASSERT(loc # NIL, 60);
			name := i.locs.name$;
			i.locs := i.locs.next
		ELSE
			loc := NIL; name := ""
		END
	END ReadLoc;

	PROCEDURE ReadFile (i: Iterator; OUT name: Files.Name);
	BEGIN
		IF i.files # NIL THEN
			name := i.files.name$;
			i.files := i.files.next
		ELSE
			name := ""
		END
	END ReadFile;

	PROCEDURE Delimiter (ch: CHAR): BOOLEAN;
	BEGIN
		RETURN (ch = "'") OR (ch = '"') OR (ch = "/")
	END Delimiter;

	PROCEDURE Stale (IN s: ARRAY OF CHAR): BOOLEAN;
		VAR i, j: INTEGER; ch: CHAR; loc: Files.Locator; name: Files.Name; t: ARRAY 1024 OF CHAR;
	BEGIN
		i := 0; ch := s[0]; WHILE (ch # 0X) & (ch # "(") DO INC(i); ch := s[i] END;
		IF ch = "(" THEN
			t := s$; t[i] := 0X;
			(* StdCmds.OpenMask doesn't exist anymore *)
			IF (t = "StdCmds.OpenMask") OR (t = "StdCmds.OpenBrowser") OR (t = "StdCmds.OpenDoc") OR
				(t = "StdCmds.OpenAuxDialog") THEN
				INC(i); ch := s[i]; WHILE (ch # 0X) & (ch # "'") & (ch # '"') DO INC(i); ch := s[i] END;
				IF ch # 0X THEN
					loc := Files.dir.This("");
					REPEAT
						j := 0;
						INC(i); ch := s[i]; WHILE ~Delimiter(ch) DO t[j] := ch; INC(j); INC(i); ch := s[i] END;
						t[j] := 0X;
						IF ch = "/" THEN loc := loc.This(t) END
					UNTIL ch # "/";
					name := t$; MakeDocName(name);
					RETURN Files.dir.Old(loc, name, Files.shared) = NIL	(* file not found *)
				ELSE RETURN TRUE	(* wrong syntax *)
				END
			ELSE RETURN FALSE	(* unknown kind of command *)
			END
		ELSE RETURN FALSE	(* unknown kind of command *)
		END
	END Stale;

	PROCEDURE GetCmd (IN path, file: Files.Name; pos: INTEGER; OUT cmd: ARRAY OF CHAR);
		VAR p, bug0, bug1, bug2: ARRAY 128 OF CHAR;
	BEGIN
		Strings.IntToString(pos, p);
		bug0 :=  linkCommand + path + "', '";
		bug1 :=  bug0 + file + "', ";
		bug2 := bug1 + p + ")";
		cmd := bug2$
	END GetCmd;

	PROCEDURE CheckDoc (IN path, file: Files.Name; t: TextModels.Model; VAR f: TextMappers.Formatter;
										tabs: INTEGER; check: BOOLEAN; VAR hit: BOOLEAN);
		VAR r: TextModels.Reader; v: Views.View; leftSide, done: BOOLEAN; cmd, cmd0: ARRAY 1024 OF CHAR;
			i: INTEGER;
	BEGIN
		r := t.NewReader(NIL);
		r.ReadView(v);
		WHILE v # NIL DO
			WITH v: StdLinks.Link DO
				IF v.leftSide THEN
					v.GetCmd(cmd);
					IF (cmd # "") & (~check OR Stale(cmd)) THEN
						hit := TRUE;
						i := 0; WHILE i # tabs DO f.WriteTab; INC(i) END;
						GetCmd(path, file, r.Pos() - 1, cmd0);
						f.WriteView(StdLinks.dir.NewLink(cmd0));
						f.rider.SetAttr(link);
						f.WriteString(cmd);
						f.rider.SetAttr(default);
						f.WriteView(StdLinks.dir.NewLink(""));
						f.WriteLn
					END
				END
			ELSE
			END;
			r.ReadView(v)
		END
	END CheckDoc;

	PROCEDURE CheckLoc (
		IN path: Files.Name; loc: Files.Locator; name: Files.Name; VAR f: TextMappers.Formatter;
		check: BOOLEAN; OUT hit: BOOLEAN
	);
		VAR i: Iterator; fname: Files.Name; v: Views.View; conv: Converters.Converter;
			label, label0: INTEGER; hit0: BOOLEAN;
	BEGIN
		label := f.Pos(); hit := FALSE;
		loc := loc.This(name);
		i := New(loc);
		ReadFile(i, fname);
		IF fname # "" THEN f.WriteTab; f.WriteString(name); f.WriteLn END;
		hit := FALSE;
		WHILE fname # "" DO
			label0 := f.Pos(); hit0 := FALSE;
			MakeDocName(fname);
			v := Views.Old(Views.dontAsk, loc, fname, conv);
			IF (v # NIL) & (v IS TextViews.View) THEN
				f.WriteTab; f.WriteTab; f.WriteString(fname); f.WriteLn;
				CheckDoc(path, fname, v(TextViews.View).ThisModel(), f, 3, check, hit0);
				IF ~hit0 THEN f.SetPos(label0) END;
				hit := hit OR hit0
			END;
			ReadFile(i, fname)
		END;
		IF ~hit THEN f.SetPos(label) END
	END CheckLoc;

	PROCEDURE Equal (IN a, b: ARRAY OF CHAR): BOOLEAN;
		VAR i: INTEGER; ai, bi: CHAR;

		PROCEDURE Eq (a, b: CHAR): BOOLEAN;
		BEGIN
			RETURN (a = b) OR (a >= "A") & (a <= "Z") & (a = CAP(b)) OR (b >= "A") & (b <= "Z") & (b = CAP(a))
		END Eq;

	BEGIN
		i := 0; ai := a[0]; bi := b[0];
		WHILE Eq(ai, bi) & (ai # 0X) DO INC(i); ai := a[i]; bi := b[i] END;
		RETURN ai = bi
	END Equal;

	PROCEDURE Check* (subsystem: ARRAY OF CHAR; scope: INTEGER; check: BOOLEAN);
		VAR i: Iterator; root, loc: Files.Locator; name: Files.Name; hit0, hit1: BOOLEAN;
			out: TextModels.Model; f: TextMappers.Formatter; label: INTEGER; title: Views.Title;
			v: TextViews.View; c: Containers.Controller; path: Files.Name;
	BEGIN
		out := TextModels.dir.New(); f.ConnectTo(out);
		IF check THEN
			Dialog.MapString("#Dev:InconsistentLinks", title)
		ELSE
			Dialog.MapString("#Dev:Links", title)
		END;
		v := TextViews.dir.New(out);
		(* set Browser mode: *)
		c := v.ThisController();
		c.SetOpts(c.opts + {Containers.noCaret} - {Containers.noSelection, Containers.noFocus});
		Views.OpenAux(v, title);
		default := TextModels.dir.attr;
		link := TextModels.NewColor(default, Ports.blue); link := TextModels.NewStyle(link, {Fonts.underline});
		root := Files.dir.This("");
		IF scope IN {globalSubsystem, allSubsystems} THEN
			label := f.Pos();
			Dialog.ShowStatus(".");
			f.WriteString("."); f.WriteLn;
			path := "Docu";
			CheckLoc(path, root, "Docu", f, check, hit0);
			path := "Mod";
			CheckLoc(path, root, "Mod", f, check, hit1);
			IF ~hit0 & ~hit1 THEN f.SetPos(label) END
		END;
		i := New(root);
		ReadLoc(i, loc, name);
		WHILE loc # NIL DO
			IF (scope = allSubsystems) OR (scope = oneSubsystem) & Equal(name, subsystem) THEN
				label := f.Pos();
				Dialog.ShowStatus(name);
				f.WriteString(name); f.WriteLn;
				path := name + "/" + "Docu";
				CheckLoc(path, loc, "Docu", f, check, hit0);
				path := name + "/" + "Mod";
				CheckLoc(path, loc, "Mod", f, check, hit1);
				IF ~hit0 & ~hit1 THEN f.SetPos(label) END
			END;
			ReadLoc(i, loc, name)
		END;
		out.Delete(f.Pos(), out.Length());
		Dialog.ShowStatus(""); default := NIL; link := NIL
	END Check;

	PROCEDURE PathToLoc (IN path: ARRAY OF CHAR; OUT loc: Files.Locator);
		VAR i, j: INTEGER; ch: CHAR; name: ARRAY 256 OF CHAR;
	BEGIN
		loc := Files.dir.This("");
		IF path # "" THEN
			i := 0; j := 0;
			REPEAT
				ch := path[i]; INC(i);
				IF (ch = "/") OR (ch = 0X) THEN name[j] := 0X; j := 0; loc := loc.This(name)
				ELSE name[j] := ch; INC(j)
				END
			UNTIL (ch = 0X) OR (loc.res # 0)
		END
	END PathToLoc;

	PROCEDURE Open* (path, file: ARRAY OF CHAR; pos: INTEGER);
		VAR loc: Files.Locator; v: Views.View; bug: Files.Name; c: TextControllers.Controller;
	BEGIN
		ASSERT(file # "", 20); ASSERT(pos >= 0, 21);
		PathToLoc(path, loc); ASSERT(loc # NIL, 22);
		bug := file$;
		v := Views.OldView(loc, bug);
		IF v # NIL THEN
			WITH v: TextViews.View DO
(*
				v.DisplayMarks(TextViews.show);
*)
				Views.Open(v, loc, bug, NIL);
				c := v.ThisController()(TextControllers.Controller);
				c.SetCaret(pos);
				v.ShowRange(pos, pos + 1, TextViews.focusOnly)
			ELSE
				HALT(23)
			END
		END
	END Open;

	PROCEDURE ListLinks*;
	(** Guard: CommandGuard **)
	BEGIN
		StdCmds.CloseDialog; Check(par.subsystem, par.scope, FALSE)
	END ListLinks;

	PROCEDURE CheckLinks*;
	(** Guard: CommandGuard **)
	BEGIN
		StdCmds.CloseDialog; Check(par.subsystem, par.scope, TRUE)
	END CheckLinks;

	PROCEDURE SubsystemGuard* (VAR p: Dialog.Par);
	BEGIN
		p.readOnly := par.scope # oneSubsystem
	END SubsystemGuard;

	PROCEDURE CommandGuard* (VAR p: Dialog.Par);
	BEGIN
		p.disabled := (par.scope = oneSubsystem) & ~par.legal
	END CommandGuard;

	PROCEDURE SyntaxOK (VAR s: ARRAY OF CHAR): BOOLEAN;
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; ch := s[0];
		WHILE (ch >= "A") & (ch <= "Z") DO INC(i); ch := s[i] END;
		WHILE (i # 0) & (ch >= "a") & (ch <= "z") OR (ch >= "0") & (ch <= "9") DO INC(i); ch := s[i] END;
		RETURN (i >= 3) & (i <= 8) & (ch = 0X)
	END SyntaxOK;

	PROCEDURE SubsystemNotifier* (op, from, to: INTEGER);
	BEGIN
		IF par.scope = oneSubsystem THEN
			par.legal := SyntaxOK(par.subsystem)
		ELSE
			par.subsystem := ""; par.legal := FALSE
		END
	END SubsystemNotifier;

END DevLinkChk.