MODULE InfoCheckLinks;

	(* Helmut Zinn *)

	IMPORT
		Converters, Dialog, DosKeyboard, (* DosSort, *)
		Files, Fonts, InfoDialog, InfoMissingLinks, Kernel, Ports, StdCmds, StdFolds, StdLinks,
		Strings, TextCmds, TextControllers, TextMappers, TextModels, TextViews, Views;

	CONST
(*
		maxLength = 256;
		linkcommand = 'InfoCmds.Start'; (* Alternativ: linkcommand = 'LibMisc.ShellExecute'; *)
		underline = FALSE;
*)
		linkCommand = "InfoCheckLinks.Open('";
		org = TRUE; (* source *)
		ref = FALSE; (* link to source *)

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

	VAR
		default, link: TextModels.Attributes;
		docList: InfoMissingLinks.DocList;
		count: INTEGER;

	PROCEDURE MakeDocName (VAR name: Files.Name);
	BEGIN
		Kernel.MakeFileName(name, ""); 	(* Append Extension *)
	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);
		(* DosSort.LocList(i.locs); *)
		(* DosSort.FileList(i.files); *)
		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; OUT type: Files.Type);
	BEGIN
		IF i.files # NIL THEN
			name := i.files.name$;
			type := i.files.type$;
			i.files := i.files.next
		ELSE
			name := "";
			type := ""
		END
	END ReadFile;

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

	PROCEDURE Stale (IN s: ARRAY OF CHAR): BOOLEAN;
		VAR i, j, p: INTEGER; ch: CHAR; loc: Files.Locator; name: Files.Name; t: ARRAY 1024 OF CHAR;
			path: ARRAY 256 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;
			IF (t = "InfoCmds.Start") OR (t = "InfoCmds.Start2") OR (t = "LibMisc.ShellExecute") 
			OR (t = "Dialog.RunExternal") OR (t = "Dialog.OpenExternal") THEN
				p := i;
				INC(i); ch := s[i]; WHILE (ch # 0X) & (ch # "'") & (ch # '"') DO INC(i); ch := s[i] END;
				FOR j := 0 TO 6 DO
					INC(i);
					t[j] := s[i];
				END;
				t[7] := 0X; IF t = "mailto:" THEN RETURN FALSE END; 	(* use ok *)
				t[6] := 0X; IF t = "https:" THEN RETURN FALSE END; 	(* use ok *)
				t[6] := 0X; IF t = "shell:" THEN RETURN FALSE END; 	(* use ok *)
				t[5] := 0X; IF t = "http:" THEN RETURN FALSE END; 	(* use ok *)
				t[4] := 0X; IF t = "ftp:" THEN RETURN FALSE END; 	(* use ok *)
				t[4] := 0X; IF t = "www." THEN RETURN FALSE END; 	(* use ok *)
				IF t[0] = "'" THEN RETURN TRUE END; 	(* wrong use *)
				i := p;
				t := s$; t[i] := 0X;
			END;
			IF (t = "StdCmds.OpenBrowser") OR (t = "StdCmds.OpenDoc") OR (t = "StdCmds.OpenAuxDialog")
			OR (t = "InfoCmds.OpenDoc")
			OR (t = "StdCmds.OpenDoc")
			OR (t = "InfoCmds.Start") OR (t = "InfoCmds.Start2") OR (t = "LibMisc.ShellExecute")
			OR (t = "Dialog.RunExternal") OR (t = "Dialog.OpenExternal") 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("");
					path := "";
					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 = "/") OR (ch = "\") THEN loc := loc.This(t); path := path + t + '/' END
					UNTIL (ch # "/") & (ch # "\");
					IF t$ = "" THEN RETURN Files.dir.FileList(loc) = NIL END; (* directory only - no filename *)
					t[255] := 0X; (* truncate string *)
					name := t$; MakeDocName(name);
					IF Files.dir.Old(loc, name, Files.shared) = NIL THEN	(* file not found *)
						RETURN TRUE	(* file not found *)
					ELSE
						InfoMissingLinks.Insert(docList, path, name, ref); 	(* --> out = link to source *)
						RETURN FALSE	(* file found *)
					END
				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 CheckCmd (IN s: ARRAY OF CHAR): BOOLEAN;
		VAR pos: INTEGER;
	BEGIN
		IF TextCmds.find.find$ = "" THEN RETURN TRUE END;
		Strings.Find(s, TextCmds.find.find$, 0, pos);
		RETURN pos >= 0;
	END CheckCmd;

	PROCEDURE CheckDoc (IN path, file: Files.Name; t: TextModels.Model; VAR f: TextMappers.Formatter;
	check: BOOLEAN; VAR hit: BOOLEAN);
		VAR r: TextModels.Reader; v: Views.View; cmd, cmd0: ARRAY 1024 OF CHAR;
	BEGIN
		IF InfoDialog.param.expand THEN StdFolds.ExpandFolds(t, TRUE, '') END;
		INC(count);
		InfoDialog.ShowStatus(count, path$ + file$);
		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)) (* & CheckCmd(cmd) *) THEN
						hit := TRUE;
						f.WriteTab; f.WriteTab;
						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;
	VAR f: TextMappers.Formatter; check: BOOLEAN);
		VAR i: Iterator; fpath, fname: Files.Name; ftype: Files.Type;
			v: Views.View; conv: Converters.Converter;
			label, label0: INTEGER; hit, hit0: BOOLEAN;
	BEGIN
		label := f.Pos(); hit := FALSE;
		i := New(loc);
		ReadFile(i, fname, ftype);
		IF fname # "" THEN f.WriteString(path); f.WriteLn END;
		hit := FALSE;
		WHILE ~DosKeyboard.Break() & (fname # "") DO
			MakeDocName(fname);
			IF check THEN InfoMissingLinks.Insert(docList, path, fname, org) END; 	(* --> in = source *)
			IF ftype$ = 'odc' THEN
				label0 := f.Pos(); hit0 := FALSE;
				conv := NIL;
				v := Views.Old(Views.dontAsk, loc, fname, conv);
				IF (v # NIL) & (v IS TextViews.View) THEN
					f.WriteTab; f.WriteString(fname); f.WriteLn;
					CheckDoc(path, fname, v(TextViews.View).ThisModel(), f, check, hit0);
					IF ~hit0 THEN f.SetPos(label0) END;
					hit := hit OR hit0;
				END;
			END;
			ReadFile(i, fname, ftype)
		END;
		IF ~hit THEN f.SetPos(label) END;
		IF InfoDialog.param.include THEN
			ReadLoc(i, loc, fname);
			WHILE ~DosKeyboard.Break() & (loc # NIL) DO
				fpath := path + fname + "/";
				CheckLoc(fpath, loc, f, check);
				ReadLoc(i, loc, fname)
			END;
		END;
	END CheckLoc;

	PROCEDURE Check* (check: BOOLEAN);
		VAR root: Files.Locator;
			out: TextModels.Model; f: TextMappers.Formatter; title: Views.Title;
			v: TextViews.View; path: Files.Name;
	BEGIN
		InfoDialog.ProofParam;
		count := 0;
		out := TextModels.dir.New(); f.ConnectTo(out);
		IF check THEN
			Dialog.MapString("#Info:InconsistentLinks", title);
			InfoMissingLinks.New(docList)
		ELSE
			Dialog.MapString("#Info:Links", title)
		END;
		v := TextViews.dir.New(out);
		Views.OpenAux(v, title); (* set Browser mode: *)
		IF check THEN f.WriteString('Link failed:'); f.WriteLn; f.WriteLn END;
		default := TextModels.dir.attr;
		link := TextModels.NewColor(default, Ports.blue); link := TextModels.NewStyle(link, {Fonts.underline});
		path := InfoDialog.param.source$;
		root := Files.dir.This(path);
		CheckLoc(path, root, f, check);
		IF check THEN
			f.WriteLn; InfoMissingLinks.Display(f, docList); f.WriteLn; f.WriteString('Ende.'); f.WriteLn
		END;
		out.Delete(f.Pos(), out.Length());
		default := NIL; link := NIL; docList := NIL;
		IF DosKeyboard.Break() THEN
			DosKeyboard.ResetBreak;
		ELSE
			Dialog.ShowStatus("");
		END;
	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(FALSE)
	END ListLinks;

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

END InfoCheckLinks.
