MODULE DevSearch;
(**
	project	= "BlackBox 2.0, diffs vs 1.7.2 are marked by green"
	organizations	= "Oberon microsystems, BBWFC, OberonCore, BBCP Team"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "The 2-Clause BSD License"
	changes	= "
	- 20070307, bh, caseSens handling in Find corrected
	- 20150403, center #37, fixing traps with long search patterns in DevSearch
	- 20151201, center #88, support for localizable documentation
	- 20170309, center #150, improvements in DevSearch
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		Kernel, Files, Fonts, Ports, Models, Views, Containers, Dialog, Windows, Strings, 
		TextModels, TextRulers, TextViews, TextControllers, TextMappers, TextCmds, StdLinks;

	CONST
		N = 32; T = 10;
		maxPat = LEN(TextCmds.find.find);
		noMatchFoundKey = "#Dev:NoMatchFound";
		locationKey = "#Dev:Location";
		countKey = "#Dev:Count";
		searchingKey = "#Dev:Searching";
		searchForKey = "#Dev:SearchFor";

	TYPE
		Pattern = ARRAY maxPat OF CHAR;
		Text = POINTER TO RECORD
			next: Text;
			num: INTEGER;
			title: Files.Name
		END;
		
	VAR
		w: TextMappers.Formatter;
		ignoreCase*: BOOLEAN;

	PROCEDURE Find (t: TextModels.Model; pat: Pattern; title: Files.Name; VAR list: Text; caseSens: BOOLEAN);
		VAR r: TextModels.Reader; num: INTEGER; i, j, b, e, n: INTEGER; ch: CHAR; ref: Pattern; l: Text;
	BEGIN
		n := 0; num := 0;
		WHILE pat[n] # 0X DO
			IF ~caseSens THEN pat[n] := Strings.Upper(pat[n]) END ;
			INC(n)
		END;
		r := t.NewReader(NIL);
		r.SetPos(0); r.ReadChar(ch);
		IF ~caseSens THEN ch := Strings.Upper(ch) END ;
		WHILE ~r.eot DO
			ref[0] := ch; i := 0; j := 0; b := 0; e := 1;
			WHILE ~r.eot & (i < n) DO
				IF ch = pat[i] THEN
					INC(i); j := (j + 1) MOD maxPat
				ELSE
					i := 0; b := (b + 1) MOD maxPat; j := b
				END;
				IF j # e THEN ch := ref[j]
				ELSE r.ReadChar(ch);
					IF ~caseSens THEN ch := Strings.Upper(ch) END ;
					ref[j] := ch; e := (e + 1) MOD maxPat
				END
			END;
			IF i = n THEN INC(num) END
		END;
		IF num > 0 THEN
			NEW(l); l.num := num; l.title := title; l.next := list; list := l
		END
	END Find;

	PROCEDURE List (list: Text; pat: Pattern; source, caseSens: BOOLEAN);
		VAR a0: TextModels.Attributes; this, t: Text; max: INTEGER;
			cmd: ARRAY maxPat + LEN(t.title) + 50  OF CHAR;
	BEGIN
		IF list = NIL THEN
			Dialog.MapString(noMatchFoundKey, cmd);
			w.WriteString(cmd)
		ELSE
			a0 := w.rider.attr;
			w.rider.SetAttr(TextModels.NewStyle(w.rider.attr, {Fonts.italic}));
			Dialog.MapString(locationKey, cmd);
			w.WriteString(cmd); w.WriteTab;
			Dialog.MapString(countKey, cmd);
			w.WriteString(cmd); w.WriteLn;
			w.rider.SetAttr(a0);
			REPEAT
				t := list; max := 1; this := NIL;
				WHILE t # NIL DO
					IF t.num >= max THEN max := t.num; this := t END;
					t := t.next
				END;
				IF this # NIL THEN
					w.rider.SetAttr(TextModels.NewStyle(w.rider.attr, {Fonts.underline}));
					w.rider.SetAttr(TextModels.NewColor(w.rider.attr, Ports.blue));
					IF source THEN 
						cmd := "StdCmds.OpenDoc('" + this.title + "'); DevSearch.SelectCaseSens('" + pat + "')"
					ELSE
						IF caseSens THEN
							cmd := "StdCmds.OpenBrowser('" + this.title + "', '" + this.title + "'); " +
								"DevSearch.SelectCaseSens('" + pat + "')"
						ELSE
							cmd := "StdCmds.OpenBrowser('" + this.title + "', '" + this.title + "'); " +
								"DevSearch.SelectCaseInSens('" + pat + "')"
						END
					END;
					w.WriteView(StdLinks.dir.NewLink(cmd));
					w.WriteString(this.title);
					w.WriteView(StdLinks.dir.NewLink(""));
					w.rider.SetAttr(a0);
					w.WriteTab; w.WriteInt(this.num); w.WriteLn;
					this.num := 0
				END
			UNTIL this = NIL
		END
	END List;

	PROCEDURE NewRuler (): TextRulers.Ruler;
		CONST mm = Ports.mm;
		VAR p: TextRulers.Prop;
	BEGIN
		NEW(p);
		p.valid := {TextRulers.right, TextRulers.tabs, TextRulers.opts};
		p.opts.val := {TextRulers.rightFixed}; p.opts.mask := p.opts.val;
		p.right := 100 * mm;
		p.tabs.len := 1;
		p.tabs.tab[0].stop := 70 * mm;
		RETURN TextRulers.dir.NewFromProp(p)
	END NewRuler;

	PROCEDURE ThisText (loc: Files.Locator; VAR name: Files.Name; useLang: BOOLEAN): TextModels.Model;
		VAR v: Views.View; m: Models.Model;
	BEGIN
		IF useLang & (Dialog.language # "") & (Dialog.language # Dialog.defaultLanguage) THEN
			v := Views.OldView(loc.This(Dialog.language), name)
		ELSE v := NIL
		END;
		IF v = NIL THEN v := Views.OldView(loc, name) END;
		IF v # NIL THEN
			m := v.ThisModel();
			IF m # NIL THEN
				WITH m: TextModels.Model DO RETURN m ELSE END
			END
		END;
		RETURN NIL
	END ThisText;

	PROCEDURE GetTitle(IN pat: ARRAY OF CHAR; OUT title: Views.Title);
		VAR pos: INTEGER; i, j: INTEGER; ch: CHAR;
	BEGIN
		Dialog.MapString(searchForKey, title);
		title := title + ' "'; i := LEN(title$); j := 0; ch := pat[0];
		WHILE (ch # 0X) & (i < LEN(title) - 2) DO
			IF ch < " " THEN title[i] := " " ELSE title[i] := ch END ; (* replace tabs and line feeds by spaces *)
			INC(i); INC(j); ch := pat[j]
		END ;
		IF ch # 0X THEN title[i - 3] := "."; title[i - 2] := "."; title[i - 1] := "." END ;
		title[i] := '"'; title[i + 1] := 0X
	END GetTitle;

	PROCEDURE Search (source, caseSens: BOOLEAN);
		VAR pat: Pattern; t, log: TextModels.Model; v: Views.View;
			title: Views.Title; c: Containers.Controller;
			files: Files.FileInfo; dirs: Files.LocInfo;
			loc: Files.Locator; path, p: Files.Name; list: Text;
	BEGIN
		(*TextCmds.InitFindDialog; *)
		pat := TextCmds.find.find$;
		IF pat # "" THEN
			Dialog.ShowStatus(searchingKey);
			TextCmds.find.find := pat$;
			log := TextModels.dir.New();
			w.ConnectTo(log); w.SetPos(0);
			IF source THEN loc := Files.dir.This("Mod"); path := "Mod"
			ELSE loc := Files.dir.This("Docu"); path := "Docu"
			END;
			files := Files.dir.FileList(loc); list := NIL;
			WHILE files # NIL DO
				IF files.type = Files.docType THEN
					p := path + "/" + files.name;
					Find(ThisText(loc, files.name, ~source), pat, p, list, caseSens)
				END;
				files := files.next
			END;
			loc := Files.dir.This("");
			dirs := Files.dir.LocList(loc);
			WHILE dirs # NIL DO
				loc := Files.dir.This(dirs.name); path := dirs.name + "/";
				IF source THEN loc := loc.This("Mod"); path := path + "Mod"
				ELSE loc := loc.This("Docu"); path := path +"Docu"
				END;
				files := Files.dir.FileList(loc);
				WHILE files # NIL DO
					IF files.type = Files.docType THEN
						p := path + "/" + files.name;
						t := ThisText(loc, files.name, ~source);
						IF t # NIL THEN
							Find(t, pat, p, list, caseSens)
						END
					END;
					files := files.next
				END;
				dirs := dirs.next
			END;
			List(list, pat, source, caseSens);
			v := TextViews.dir.New(log);
			GetTitle(pat, title);
			v(TextViews.View).SetDefaults(NewRuler(), TextViews.dir.defAttr);
			Views.OpenAux(v, title);
			c := v(Containers.View).ThisController();
			c.SetOpts(c.opts + {Containers.noCaret});
			w.ConnectTo(NIL);
			Dialog.ShowStatus("")
		END
	END Search;
	
	PROCEDURE SearchInSources*;
	BEGIN
		Search(TRUE, TRUE)
	END SearchInSources;

	PROCEDURE SearchInDocu* (opts: ARRAY OF CHAR);
		VAR caseSens: BOOLEAN;
	BEGIN
		caseSens := ~ignoreCase;
		IF LEN(opts$) > 0 THEN
			IF CAP(opts[0]) = 'S' THEN
				caseSens := TRUE
			ELSIF CAP(opts[0]) = 'I' THEN
				caseSens := FALSE
			END
		END;
		Search(FALSE, caseSens)
	END SearchInDocu;
	
	PROCEDURE SelectFirst (IN pat: ARRAY OF CHAR; ignoreCase: BOOLEAN);
	BEGIN 
		TextCmds.ResetFindDialog;
		TextCmds.find.find := pat$;
		TextCmds.find.ignoreCase := ignoreCase;
		Dialog.Update(TextCmds.find);
		TextCmds.FindFirst("")
	END SelectFirst;
	
	PROCEDURE SelectCaseSens* (pat: ARRAY OF CHAR);
	BEGIN
		SelectFirst(pat, FALSE);
	END SelectCaseSens;

	PROCEDURE SelectCaseInSens* (pat: ARRAY OF CHAR);
		VAR res: INTEGER; cmd: Dialog.String;
	BEGIN
		SelectFirst(pat, TRUE);
	END SelectCaseInSens;


	PROCEDURE NextChar (r: TextModels.Reader): CHAR;
		VAR ch: CHAR;
	BEGIN
		REPEAT r.ReadChar(ch) UNTIL (ch > " ") OR r.eot;
		RETURN ch
	END NextChar;

	PROCEDURE CompTexts (ta, tb: TextModels.Model; VAR sa, sb, ea, eb: INTEGER);
		VAR da, db, d, i, j, p: INTEGER; t: LONGINT; ra, rb: TextModels.Reader;
			cha, chb: CHAR; s: ARRAY N OF CHAR;
	BEGIN
		ra := ta.NewReader(NIL); ra.SetPos(ea);
		rb := tb.NewReader(NIL); rb.SetPos(eb);
		REPEAT
			cha := NextChar(ra); chb := NextChar(rb)
		UNTIL (cha # chb) OR ra.eot OR rb.eot;
		IF ra.eot THEN sa := ra.Pos() ELSE sa := ra.Pos() - 1 END;
		IF rb.eot THEN sb := rb.Pos() ELSE sb := rb.Pos() - 1 END;
		t := Kernel.Time() + T * Kernel.timeResolution;
		da := sa + 1; db := sb + 1; d := 1; j := 0;
		REPEAT
			ea := da;
			IF ea < ta.Length() THEN
				ra.SetPos(ea); s[0] := NextChar(ra);
				da := ra.Pos(); i := 1;
				WHILE i < N DO s[i] := NextChar(ra); INC(i) END;
				i := 0; rb.SetPos(sb);
				REPEAT
					eb := rb.Pos(); chb := NextChar(rb);
					IF chb = s[0] THEN
						p := rb.Pos(); j := 0;
						WHILE (j < N) & (chb = s[j]) DO chb := NextChar(rb); INC(j) END;
						rb.SetPos(p)
					END;
					INC(i)
				UNTIL (j = N) OR (i = d) OR rb.eot
			END;
			INC(d);
			IF j < N THEN
				eb := db;
				IF eb < tb.Length() THEN
					rb.SetPos(eb); s[0] := NextChar(rb);
					db := rb.Pos(); i := 1;
					WHILE i < N DO s[i] := NextChar(rb); INC(i) END;
					i := 0; ra.SetPos(sa);
					REPEAT
						ea := ra.Pos(); cha := NextChar(ra);
						IF cha = s[0] THEN
							p := ra.Pos(); j := 0;
							WHILE (j < N) & (cha = s[j]) DO cha := NextChar(ra); INC(j) END;
							ra.SetPos(p)
						END;
						INC(i)
					UNTIL (j = N) OR (i = d) OR ra.eot
				END
			END
		UNTIL (j = N) OR (ea >= ta.Length()) & (eb >= tb.Length()) OR (Kernel.Time() > t);
		IF j < N THEN ea := ta.Length(); eb := tb.Length() END
	END CompTexts;

	PROCEDURE Compare*;
		VAR wa, wb: Windows.Window; va, vb: Views.View;
			ca, cb: Containers.Controller; sa, sb, ea, eb: INTEGER;
	BEGIN
		wa := Windows.dir.First();
		IF wa # NIL THEN
			wb := Windows.dir.Next(wa);
			IF wb # NIL THEN
				va := wa.doc.ThisView();
				WITH va: TextViews.View DO
					vb := wb.doc.ThisView();
					WITH vb: TextViews.View DO
						ca := va.ThisController();
						WITH ca: TextControllers.Controller DO
							cb := vb.ThisController();
							WITH cb: TextControllers.Controller DO
								ca.GetSelection(sa, ea);
								IF (* ea = -1 *) sa = ea THEN ea := MAX(0, ca.CaretPos()) END;
								cb.GetSelection(sb, eb);
								IF (* eb = -1 *) sb = eb THEN eb := MAX(0, cb.CaretPos()) END;
								CompTexts(va.ThisModel(), vb.ThisModel(), sa, sb, ea, eb);
								IF ea > sa THEN ca.SetSelection(sa, ea) ELSE ca.SetCaret(sa) END;
								IF eb > sb THEN cb.SetSelection(sb, eb) ELSE cb.SetCaret(sb) END;
								va.ShowRangeIn(Views.ThisFrame(wa.frame, va), sa, ea);
								vb.ShowRangeIn(Views.ThisFrame(wb.frame, vb), sb, eb)
							END
						END
					ELSE
					END
				ELSE
				END
			END
		END
	END Compare;
	
BEGIN
	ignoreCase := TRUE

END DevSearch.
