Dev/Mod/Search.odc

MODULE DevSearch;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- 20091016, FVT for multilanguage support modified: Search, added: SearchInDocuLang
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

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

	CONST
		N = 32; T = 10;
		maxPat = 64;
		noMatchFoundKey = "#Std:NoMatchFound";
		locationKey = "#Std:Location";
		countKey = "#Std:Count";
		searchingKey = "#Std:Searching";
		openFindCmdKey = "#Dev:OpenFindCmd";
		openFindCmdNotFoundKey = "#Dev:OpenFindCmdNotFound";

	TYPE
		Pattern = ARRAY maxPat OF CHAR;
		Text = POINTER TO RECORD
			next: Text;
			num: INTEGER;
			title: Files.Name
		END;

	VAR
		w: TextMappers.Formatter;
		key: ARRAY 256 OF INTEGER;

	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 INC(n) END;
		r := t.NewReader(NIL);
		r.SetPos(0); r.ReadChar(ch);
		WHILE ~r.eot DO
			ref[0] := ch; i := 0; j := 0; b := 0; e := 1;
			WHILE ~r.eot & (i < n) DO
(*
				IF key[ORD(pat[i])] = key[ORD(ch)] THEN INC(i); j := (j + 1) MOD maxPat
*)
				IF caseSens & (pat[i]=ch) OR ~caseSens & (CAP(pat[i]) = CAP(ch)) 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); 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; cmd: ARRAY 256 OF CHAR; this, t: Text; max: INTEGER;
	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): TextModels.Model;
		VAR v: Views.View; m: Models.Model;
	BEGIN
		v := Views.OldView(loc, name);
		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 Search (source, caseSens: BOOLEAN; lang: ARRAY OF CHAR);
		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";
				IF  lang # ''  THEN
					loc := loc.This( lang );  ASSERT( loc.res = 0 );
					path := path + '/' + lang;
				END;
			END;
			files := Files.dir.FileList(loc); list := NIL;
			WHILE files # NIL DO
				IF files.type = Kernel.docType THEN
					p := path + "/" + files.name;
					Find(ThisText(loc, files.name), 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";
					IF  lang # ''  THEN
						loc := loc.This( lang );  ASSERT( loc.res = 0 );
						path := path + '/' + lang;
					END;
				END;
				files := Files.dir.FileList(loc);
				WHILE files # NIL DO
					IF files.type = Kernel.docType THEN
						p := path + "/" + files.name;
						t := ThisText(loc, files.name);
						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);
			title := 'Search for "' + pat + '"';
			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 := ~TextCmds.find.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 SearchInDocuLang* (opts, lang: ARRAY OF CHAR); 
	(*cf. DevReferences.ShowDocuLang*)
		VAR caseSens: BOOLEAN;
	BEGIN
		caseSens := ~TextCmds.find.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, lang)
	END SearchInDocuLang;
	
	PROCEDURE SelectCaseSens* (pat: ARRAY OF CHAR);
	BEGIN
		TextCmds.find.find := pat$;
		TextCmds.find.ignoreCase := FALSE;
		Dialog.Update(TextCmds.find);
		TextCmds.FindFirst("")
	END SelectCaseSens;

	PROCEDURE SelectCaseInSens* (pat: ARRAY OF CHAR);
		VAR res: INTEGER; cmd: Dialog.String;
	BEGIN
		TextCmds.find.find := pat$;
		TextCmds.find.ignoreCase := TRUE;
		Dialog.Update(TextCmds.find);
		Dialog.MapString(openFindCmdKey, cmd);
		Dialog.Call(cmd, openFindCmdNotFoundKey, res);
		TextCmds.FindFirst("")
	END SelectCaseInSens;

	PROCEDURE InitKey;
		VAR i: INTEGER;
	BEGIN
		i := 0; WHILE i < 256 DO key[i] := SHORT(i); INC(i) END;
		i := ORD("a"); WHILE i <= ORD("z") DO key[i] := ORD(CAP(CHR(i))); INC(i) END;
		i := 192; WHILE i <= 255 DO key[i] := ORD(CAP(CHR(i))); INC(i) END
	END InitKey;


	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
	InitKey
END DevSearch.