MODULE DevLinkChk;
(**
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, 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.