MODULE InfoIndex;

	(* Helmut Zinn *)
	(* Build the Cross-Referenz List *)

	(*
	InfoIndex.CreateNewIndex will scan through all files and generate an index of all words,
	except those listed as trivial.
	Trival word should be listet in Info/Rsrc/Strings following a "Tab" and a "." (Period).
	*)

	IMPORT
		Converters, Dialog, Documents, DosKeyboard, (* DosSort, *) 
		Files, Fonts, InfoDialog, InfoLook, Models, Ports, StdCmds,
		StdFolds, StdLog, Strings, TextCmds, TextMappers, TextModels, TextViews, Views;

	CONST
		minWordLen = 2;
		maxWordLen = 32;
		rootChar = "0"; (* first letter is zero *)
		fileName = "Index.odc";

	TYPE
		DocNames = POINTER TO RECORD
			path: InfoLook.DynString;
			name: InfoLook.DynString;
			next: DocNames
		END;

		RefList = POINTER TO RECORD
			docNum: INTEGER;
			count: INTEGER; 	(* word occurrences within document *)
			next: RefList
		END;

		WordTree = POINTER TO RECORD
			word: InfoLook.DynString;
			ref: RefList;
			count: INTEGER; 	(* word occurrences across documents *)
			left, right: WordTree
		END;

	VAR
		cntDir, cntFiles, cntWords, cntRefs: INTEGER;
		dName: DocNames;
		wTree: WordTree;
		label: ARRAY 8 OF CHAR;
		cmdstr: ARRAY 512 OF CHAR;
		docStr: ARRAY 512 OF CHAR;
		wordChar: ARRAY 2 OF CHAR;
		str: ARRAY 4 OF CHAR;

	PROCEDUREWriteOpenFold (VARf: TextMappers.Formatter; IN label: ARRAYOFCHAR);
		VAR
			fold: StdFolds.Fold;
			t: TextModels.Model;
	BEGIN
		t := TextModels.dir.NewFromString(' ' + label + ' '); 	(* convert label string into a text model *)
		fold := StdFolds.dir.New(StdFolds.expanded, label$, t);
		f.WriteView(fold);
		f.WriteLn;
	END WriteOpenFold;

	PROCEDUREWriteCloseFold (VAR f: TextMappers.Formatter);
		VAR
			fold: StdFolds.Fold;
			len: INTEGER;
	BEGIN
		fold := StdFolds.dir.New(StdFolds.expanded, "", NIL);
		f.WriteView(fold);
		fold.Flip; 	(* swap long-form text, now between the two fold views, with hidden short-form text *)
		len := f.rider.Base().Length(); 	(* determine the text carrier's new length *)
		f.SetPos(len)	(* position the formatter to the end of the text *)
	END WriteCloseFold;

	PROCEDURE (wTree: WordTree) Write (VAR f: TextMappers.Formatter; VAR letter: CHAR), NEW;
		(*
		-- moved to top - stack overflow at recursion - need redesign
		VAR
		label: ARRAY 8 OF CHAR;
		cmdstr: ARRAY 256 OF CHAR;
		docStr: ARRAY 512 OF CHAR;
		wordChar: ARRAY 2 OF CHAR;
		str: ARRAY 4 OF CHAR;
		*)
		PROCEDURE AppendDocLinksFiFo (doc: RefList); 	(* WriteDocLinksFiFo *)
			(* Appending encoded docNum and count to docStr.
			Due to recursion, this proc. will process the document
			at the far end of the link (d1) first. *)
		BEGIN
			IF doc.next # NIL THEN
				AppendDocLinksFiFo(doc.next)	(* dive to the bottom *)
			END;
			IF LEN(docStr$) > 200 THEN
				(* Overflow: StdLog.String (wTree.name^); StdLog.Ln; *)
				Strings.IntToString(wTree.count, label);
				cmdstr := "InfoLook.Expand('" + wTree.word^$ + "', '" + docStr + "')";
				InfoLook.WriteLink(f, label, cmdstr);
				f.WriteString(" + ");
				docStr := "";
			END;
			Strings.IntToString(doc.docNum, label);
			docStr := docStr + label + " ";
			Strings.IntToString(doc.count, label);
			docStr := docStr + label + " ";
		END AppendDocLinksFiFo;

	BEGIN
		IF ~DosKeyboard.Break() & (wTree.left # NIL) THEN wTree.left.Write(f, letter) END;
		IF ~DosKeyboard.Break() THEN 
			Strings.ToUpper(wTree.word^, wordChar);
			IF wordChar[0] # letter THEN
				(* About to start a new letter; fold the previous *)
				WriteCloseFold(f);
				f.WriteLn;
				letter := wordChar[0]; 	(* new letter *)
				str[0] := letter;
				str[1] := CHR(0);
				InfoDialog.ShowStatus(cntFiles, str$);
				WriteOpenFold(f, str$);
			END;
			f.WriteString(wTree.word^); f.WriteTab;
			(* The document numbers are linked with the first one at the far end:
			wTree.ref -> dn -> ... -> d3 -> d2 -> d1 -> NIL *)
			(* --- WriteDocLinksFiFo(wTree.ref) - Using AppendDocLinksFiFo produces a "small" index. *)
			docStr := "";
			AppendDocLinksFiFo(wTree.ref); 	(* appending to docStr *)
			Strings.IntToString(wTree.count, label);
			cmdstr := "InfoLook.Expand('" + wTree.word^$ + "', '" + docStr + "')";
			InfoLook.WriteLink(f, label, cmdstr);
			f.WriteLn;
		END;
		IF ~DosKeyboard.Break() & (wTree.right # NIL) THEN wTree.right.Write(f, letter) END
	END Write;

	PROCEDURE WriteCrossReferenceList (docList: DocNames; wTree: WordTree);
		VAR
			t: TextModels.Model;
			f: TextMappers.Formatter;
			letter: CHAR;
			lettersBeg: INTEGER;
			new, mono: TextModels.Attributes;
			v: TextViews.View;
			loc: Files.Locator;
			filename: Files.Name;
			conv: Converters.Converter;
			res: INTEGER;
			str: ARRAY 4 OF CHAR;

		PROCEDURE GetDocNamesFiFo (docPN: DocNames);
			(* Due to recursion, this proc. will process the document path/name
			at the far end of the link (d1) first. *)
		BEGIN
			IF docPN.next # NIL THEN
				GetDocNamesFiFo(docPN.next)
			ELSE
				f.WriteInt(cntFiles); f.WriteLn
			END;
			f.WriteString(docPN.path); f.WriteTab;
			f.WriteString(docPN.name); f.WriteLn;
		END GetDocNamesFiFo;

	BEGIN
		t := TextModels.dir.New(); 	(* create a new, empty text *)
		f.ConnectTo(t); 	(* connect a formatter to the text *)
		(* Write document list  *)
		WriteOpenFold(f, InfoDialog.param.source$ + "Documents");
		GetDocNamesFiFo(docList);
		WriteCloseFold(f);
		f.WriteLn;
		(* Write word list  *)
		new := f.rider.attr;
		new := TextModels.NewSize(new, 12 * Fonts.point);
		f.rider.SetAttr(new); 	(* change current attributes of formatter *)
		f.WriteLn;
		letter := rootChar;
		lettersBeg := t.Length(); 	(* we'll start applying the mono font here *)
		str[0] := letter;
		str[1] := CHR(0);
		InfoDialog.ShowStatus(cntFiles, str$);
		WriteOpenFold(f, str$);
		wTree.Write(f, letter);
		WriteCloseFold(f); 	(* Z *)
		InfoDialog.ShowStatus(cntFiles, str$);
		(* Picking a fixed-width font for the folds' capital letters *)
		mono := f.rider.attr; 	(* save plain text attributes for later use *)
		mono := TextModels.NewTypeface(mono, "Courier New");
		mono := TextModels.NewSize(mono, 16 * Fonts.point);
		mono := TextModels.NewColor(mono, Ports.red);
		t.SetAttr(lettersBeg, t.Length(), mono);
		(* Open View in BrowserMode *)
		StdCmds.CloseDialog;
		v := TextViews.dir.New(t);
		Views.OpenView(v);
		IF ~DosKeyboard.Break() THEN
			loc := Files.dir.This(InfoDialog.param.source);
			filename := fileName;
			conv := NIL;
			Views.Register(v, Views.ask, loc, filename, conv, res);
		END;
	END WriteCrossReferenceList;

	PROCEDURE NewWordTree (): WordTree;
		VAR
			wTree: WordTree;
			doc: RefList;
	BEGIN
		NEW(wTree);
		NEW(wTree.word, 2);
		wTree.word[0] := rootChar; wTree.word[1] := 0X;
		NEW(doc); doc.docNum := 0; doc.next := NIL; 	(* to please WriteDocListFiFo *)
		wTree.ref := doc;
		wTree.count := 0;
		wTree.left := NIL; wTree.right := NIL;
		RETURN wTree
	END NewWordTree;

	PROCEDURE (t: WordTree) NameHigherThan (newName: ARRAY OF CHAR): BOOLEAN, NEW;
		VAR
			oldUpper, newUpper: ARRAY 256 OF CHAR;
	BEGIN
		IF TextCmds.find.ignoreCase THEN
			RETURN t.word^ > newName;
		END;
		Strings.ToUpper(t.word^, oldUpper);
		Strings.ToUpper(newName, newUpper);
		IF oldUpper = newUpper THEN
			RETURN t.word^ > newName
		ELSE
			RETURN oldUpper > newUpper
		END
	END NameHigherThan;

	PROCEDURE (t: WordTree) Insert (newName: ARRAY OF CHAR), NEW;
		VAR
			p, father: WordTree;
			doc: RefList;
	BEGIN
		p := t;
		REPEAT
			father := p;
			IF newName = p.word^ THEN
				(* Found word in tree *)
				IF cntFiles # p.ref.docNum THEN
					(* Current document not same as where word was found last *)
					INC(cntRefs);
					NEW(doc); doc.docNum := cntFiles; doc.count := 0;
					doc.next := p.ref; p.ref := doc
				END;
				INC(p.count); INC(p.ref.count); RETURN
			END;
			IF p.NameHigherThan(newName) THEN
				p := p.left
			ELSE
				p := p.right
			END
		UNTIL p = NIL;
		INC(cntWords);
		NEW(p); p.left := NIL; p.right := NIL;
		p.word := InfoLook.MakeDynString(newName$);
		INC(cntRefs);
		NEW(doc); doc.docNum := cntFiles;
		doc.next := NIL; p.ref := doc;
		p.count := 1; doc.count := 1;
		IF father.NameHigherThan(newName) THEN
			father.left := p
		ELSE
			father.right := p
		END
	END Insert;

	PROCEDURE IsLetter (ch: CHAR): BOOLEAN;
	BEGIN
		IF ('A' <= ch) & (ch <= 'Z') THEN RETURN TRUE END;
		IF ('a' <= ch) & (ch <= 'z') THEN RETURN TRUE END;
		(*
		[192] 	[193] 	[194] 	[195] 	[196] 	[197] 	[198] 	[199] 
		[200] 	[201] 	[202] 	[203] 	[204] 	[205] 	[206] 	[207] 
		[208] 	[209] 	[210] 	[211] 	[212] 	[213] 	[214] 	[215] 
		[216] 	[217] 	[218] 	[219] 	[220] 	[221] 	[222] 	[223] 
		[224] 	[225] 	[226] 	[227] 	[228] 	[229] 	[230] 	[231] 
		[232] 	[233] 	[234] 	[235] 	[236] 	[237] 	[238] 	[239] 
		[240] 	[241] 	[242] 	[243] 	[244] 	[245] 	[246] 	[247] 
		[248] 	[249] 	[250] 	[251] 	[252] 	[253] 	[254] 	[255] 
		*)
		IF ('' <= ch) & (ch <= '') THEN RETURN TRUE END;
		IF ('' <= ch) & (ch <= '') THEN RETURN TRUE END;
		IF ('' <= ch) & (ch <= '') THEN RETURN TRUE END;
		RETURN FALSE;
	END IsLetter;

	PROCEDURE IsDigit (ch: CHAR): BOOLEAN;
	BEGIN
		RETURN (('0' <= ch) & (ch <= '9'));
	END IsDigit;

	PROCEDURE ReadWord (r: TextModels.Reader; VAR word: ARRAY OF CHAR);
		VAR
			i: INTEGER;
			ch: CHAR;
	BEGIN
		REPEAT
			i := 0;
			r.ReadChar(ch);
			WHILE ~r.eot & ~IsLetter(ch) & ~IsDigit(ch) DO	(* skip until letter *)
				r.ReadChar(ch)
			END;
			WHILE ~r.eot & (IsLetter(ch) OR IsDigit(ch) OR (ch = TextModels.softhyphen)) DO	(* scan word *)
				(*	#	$	%	&	(	)	*	+	-	/	_	.	,	[	]	*)
				IF ch # TextModels.softhyphen THEN
					IF TextCmds.find.ignoreCase THEN ch := Strings.Lower(ch); END;
					IF i < maxWordLen - 1 THEN word[i] := ch; INC(i) END;
				END;
				r.ReadChar(ch)
			END;
			word[i] := 0X;
		UNTIL r.eot OR (i >= minWordLen);
	END ReadWord;

	PROCEDURE ScanDoc (IN path: ARRAY OF CHAR; IN fname: Files.Name; m: TextModels.Model);
		VAR
			r: TextModels.Reader;
			word, lexWord, wordFromMap: ARRAY 256 OF CHAR;
	BEGIN
		r := m.NewReader(NIL);
		r.SetPos(0);
		WHILE ~r.eot DO
			ReadWord(r, word);
			IF word # "" THEN
				lexWord := "#Info:" + word$;
				Dialog.MapString(lexWord$, wordFromMap);
				IF wordFromMap # "." THEN
					(* Die Aufgabe fr das Dokument ausfhren, z.B.: HostCmds.Print *)
					wTree.Insert(word);
				END;
				(* Skip coded text *)
				IF (word = "StdCoder") OR (word = "PacCoder") OR (word = "Decode")
					OR (word = "stdcoder") OR (word = "paccoder") OR (word = "decode") THEN
					REPEAT
						ReadWord(r, word);
					UNTIL (word = "end") OR (word = "AtEndOfEncoding") OR (word = "atendofencoding") OR r.eot;
				END
			END
		END
	END ScanDoc;

	PROCEDURE InsertIntoNameList (IN path, name: ARRAY OF CHAR);
		VAR docPN: DocNames;
	BEGIN
		NEW(docPN);
		docPN.path := InfoLook.MakeDynString(path$);
		docPN.name := InfoLook.MakeDynString(name$);
		docPN.next := dName; dName := docPN;
	END InsertIntoNameList;

	PROCEDURE ScanLoc (path: ARRAY OF CHAR);
		VAR
			root: Files.Locator;
			locs: Files.LocInfo;
			files: Files.FileInfo;
			conv: Converters.Converter;
			m: Models.Model;
			vw: Views.View;
	BEGIN
		INC(cntDir);
		root := Files.dir.This(path);
		files := Files.dir.FileList(root);
		(* DosSort.FileList(files); *)
		(* for all documents in the directory do *)
		WHILE ~DosKeyboard.Break() & (files # NIL) DO
			(* The Extension files.type$ is always lower case *)
			IF (InfoDialog.param.filter$ = '') OR (InfoDialog.param.filter$ = files.type$) THEN
				INC(cntFiles);
				InfoDialog.ShowStatus(cntFiles, path$ + files.name$);
				InsertIntoNameList(path, files.name);
				conv := NIL;
				vw := Views.Old(Views.dontAsk, root, files.name, conv);
				IF vw IS Documents.Document THEN vw := vw(Documents.Document).ThisView() END;
				IF(vw # NIL) & (vw IS TextViews.View) THEN
					m := vw.ThisModel();
					WITH m: TextModels.Model DO
						IF InfoDialog.param.expand THEN StdFolds.ExpandFolds(m, TRUE, '') END;
						ScanDoc(path, files.name, m)
					END;
				END;
			END;
			files := files.next
		END;
		IF InfoDialog.param.include THEN
			locs := Files.dir.LocList(root);
			(* DosSort.LocList(locs); *)
			(* for all subdirectories in the directory do *)
			WHILE ~DosKeyboard.Break() & (locs # NIL) DO
				ScanLoc(path$ + locs.name$ + "/");
				locs := locs.next
			END;
		END;
	END ScanLoc;

	PROCEDURE CreateNewIndex*;
	BEGIN
		InfoDialog.ProofParam;
		Dialog.showsStatus := TRUE;
		cntDir := 0; cntFiles := 0; cntWords := 0; cntRefs := 0;
		dName := NIL;
		wTree := NewWordTree();
		ScanLoc(InfoDialog.param.source);
		IF ~DosKeyboard.Break() THEN
			WriteCrossReferenceList(dName, wTree);
		END;
		IF DosKeyboard.Break() THEN
			DosKeyboard.ResetBreak;
		ELSE
			StdLog.String(InfoDialog.param.source); StdLog.Ln;
			StdLog.Char(" "); StdLog.Int(cntDir); StdLog.String(" Directories"); StdLog.Ln;
			StdLog.Char(" "); StdLog.Int(cntFiles); StdLog.String(" Documents"); StdLog.Ln;
			StdLog.Char(" "); StdLog.Int(cntWords); StdLog.String(" Words"); StdLog.Ln;
			StdLog.Char(" "); StdLog.Int(cntRefs); StdLog.String(" Reference"); StdLog.Ln;
			InfoDialog.ShowStatus(cntFiles, '');
			Dialog.Beep	(* done *)
		END;
		wTree := NIL;
		dName := NIL;
	END CreateNewIndex;

END InfoIndex.
