implement WmMan;

include "draw.m";
include "sys.m";
include "tk.m";
include "wmlib.m";
include "parseman.m";
include "plumbmsg.m";
include "man.m";

WmMan : module {
	init : fn (ctxt : ref Draw->Context, argv : list of string);

	# Viewman signature...
	textwidth : fn (text : Parseman->Text) : int;
};

sys : Sys;
draw : Draw;
tk : Tk;
wmlib : Wmlib;
man : Man;

window : ref Tk->Toplevel;

ROMAN : con "/fonts/lucidasans/unicode.7.font";
BOLD : con "/fonts/lucidasans/typelatin1.7.font";
ITALIC : con "/fonts/lucidasans/italiclatin1.7.font";
HEADING1 : con "/fonts/lucidasans/boldlatin1.7.font";
HEADING2 : con "/fonts/lucidasans/italiclatin1.7.font";
rfont, bfont, ifont, h1font, h2font : ref Draw->Font;

GOATTR : con Parseman->ATTR_LAST << iota;
MANPATH : con "/man/1/man";
INDENT : con 40;

metrics : Parseman->Metrics;
parser : Parseman;


tkconfig := array [] of {
	"frame .input",
	"frame .view",
	"text .view.t -state disabled -width 500 -height 400 -bg white -wrap none -yscrollcommand {.view.scroll set}",
	"scrollbar .view.scroll -command {.view.t yview}",
	"entry .input.e -bg white",
	"button .input.back -state disabled -bitmap small_color_left.bit -command {send nav b}",
	"button .input.forward -state disabled -bitmap small_color_right.bit -command {send nav f}",

	"pack .input.back .input.forward -side left -anchor w",
	"pack .input.e -expand 1 -fill x",
	"pack .title.t -expand 1 -fill x",
	"pack .view.scroll -fill y -side left",
	"pack .view.t -expand 1 -fill both",

	"bind .input.e <Key-\n> {send nav e}",
	"bind .input.e <Button-1> +{grab set .input.e}",
	"bind .input.e <ButtonRelease-1> +{grab release .input.e}",
	"bind .view.t <Button-1> +{grab set .view.t}",
	"bind .view.t <ButtonRelease-1> +{grab release .view.t}",
	"bind .view.t <ButtonRelease-3> {send plumb %x %y}",

	"pack .input -fill x",
	"pack .view -expand 1 -fill both",
	"pack propagate . 0",
	"update",
};

History : adt {
	prev : cyclic ref History;
	next : cyclic ref History;
	topline : string;
	searchstart : string;
	searchend : string;
	pick {
	Search =>
		search : list of string;
	Go =>
		path : string;
	}
};

history : ref History;


init(ctxt : ref Draw->Context, argv : list of string)
{
	doplumb := 0;

	sys = load Sys Sys->PATH;
	sys->pctl(Sys->NEWPGRP, nil);

	draw = load Draw Draw->PATH;
	if (draw == nil)
		loaderr("Draw");

	tk = load Tk Tk->PATH;
	if (tk == nil)
		loaderr(Tk->PATH);

	man = load Man Man->PATH;
	if (man == nil)
		loaderr(Man->PATH);

	wmlib = load Wmlib Wmlib->PATH;
	if (wmlib == nil)
		loaderr(Wmlib->PATH);

	parser = load Parseman Parseman->PATH;
	if (parser == nil)
		loaderr(Parseman->PATH);
	parser->init();

	plumber := load Plumbmsg Plumbmsg->PATH;
	if (plumber != nil) {
		if (plumber->init(1, nil, 0) >= 0)
			doplumb = 1;
	}

	argv = tl argv;

	rfont = draw->(Draw->Font).open(ctxt.display, ROMAN);
	bfont = draw->(Draw->Font).open(ctxt.display, BOLD);
	ifont = draw->(Draw->Font).open(ctxt.display, ITALIC);
	h1font = draw->(Draw->Font).open(ctxt.display, HEADING1);
	h2font = draw->(Draw->Font).open(ctxt.display, HEADING2);

	em := draw->rfont.width("m");
	en := draw->rfont.width("n");
	metrics = Parseman->Metrics(490, 80, em, en, 14, 40, 20);

	wmlib->init();
	buts := Wmlib->Resize | Wmlib->Hide;
	winctl : chan of string;
	(window, winctl) = wmlib->titlebar(ctxt.screen, nil, "Man", buts);
	nav := chan of string;
	plumb := chan of string;
	tk->namechan(window, nav, "nav");
	tk->namechan(window, plumb, "plumb");
	wmlib->tkcmds(window, tkconfig);
	mktags();

	actionchan := chan of ref History;
	linechan := chan of list of (int, Parseman->Text);
	man->loadsections(nil);

	pidc := chan of int;

	if (argv != nil) {
		if (hd argv == "-f") {
			first : ref History;
			for (argv = tl argv; argv != nil; argv = tl argv) {
				hnode := ref History.Go(history, nil, "", "", "", hd argv);
				if (history != nil)
					history.next = hnode;
				history = hnode;
				if (first == nil)
					first = history;
			}
			history = first;
		} else
			history = ref History.Search(nil, nil, "", "", "", argv);
	}

	if (history == nil)
		history = ref History.Go(nil, nil, "", "", "", MANPATH);

	setbuttons();
	spawn printman(pidc, linechan, history);
	layoutpid := <- pidc;

	for (;;) alt {
	cmd := <- winctl =>
		wmlib->titlectl(window, cmd);
		if (cmd[0] == 's') {
			topline := tk->cmd(window, ".view.t yview");
			(nil, toptoks) := sys->tokenize(topline, " ");
			if (toptoks != nil)
				history.topline = hd toptoks;
			w := int tk->cmd(window, ".view.t cget -actwidth") - 10;
			if (w < 150)
				w = 150;
			if (w != metrics.pagew) {
				if (layoutpid != -1)
					kill(layoutpid);
				metrics.pagew = w;
				tk->cmd(window, ".view.t delete 1.0 end");
				tk->cmd(window, "update");
				spawn printman(pidc, linechan, history);
				layoutpid = <- pidc;
			}
		}
	line := <- linechan =>
		if (line == nil) {
			# layout done
			if (history.topline != "") {
				topline := tk->cmd(window, ".view.t yview");
				(nil, toptoks) := sys->tokenize(topline, " ");
				if (toptoks != nil)
					if (hd toptoks == "0")
						tk->cmd(window, ".view.t yview moveto " + history.topline);
			}
			tk->cmd(window, "update");
		} else
			setline(line);
	go := <- nav =>
		topline := tk->cmd(window, ".view.t yview");
		(nil, toptoks) := sys->tokenize(topline, " ");
		if (toptoks != nil)
			history.topline = hd toptoks;
		case go[0] {
		'f' =>
			# forward
			history = history.next;
			setbuttons();
			if (layoutpid != -1)
				kill(layoutpid);
			tk->cmd(window, ".view.t delete 1.0 end");
			tk->cmd(window, "update");
			spawn printman(pidc, linechan, history);
			layoutpid = <- pidc;
		'b' =>
			# back
			history = history.prev;
			setbuttons();
			if (layoutpid != -1)
				kill(layoutpid);
			tk->cmd(window, ".view.t delete 1.0 end");
			tk->cmd(window, "update");
			spawn printman(pidc, linechan, history);
			layoutpid = <- pidc;
		'e' or 'l' =>
			t := "";
			if (go[0] == 'l') {
				# link
				t = go[1:];
			} else {
				# entry
				t = tk->cmd(window, ".input.e get");
				for (i := 0; i < len t; i++)
					if (!(t[i] == ' ' || t[i] == '\t'))
						break;
				if (i == len t)
					break;
				t = t[i:];
				if (t[0] == '/' || t[0] == '?') {
					search(t);
					break;
				}
			}
			(n, toks) := sys->tokenize(t, " \t");
			if (n == 0)
				continue;
			h := ref History.Search(history, nil, "", "", "", toks);
			history.next = h;
			history = h;
			setbuttons();
			if (layoutpid != -1)
				kill(layoutpid);
			tk->cmd(window, ".view.t delete 1.0 end");
			tk->cmd(window, "update");
			spawn printman(pidc, linechan, history);
			layoutpid = <- pidc;
		'g' =>
			# goto file
			h := ref History.Go(history, nil, "", "", "", go[1:]);
			history.next = h;
			history = h;
			setbuttons();
			if (layoutpid != 0)
				kill(layoutpid);
			tk->cmd(window, ".view.t delete 1.0 end");
			tk->cmd(window, "update");
			spawn printman(pidc, linechan, history);
			layoutpid = <- pidc;
		}
	p := <- plumb =>
		if (!doplumb)
			break;
		(nil, l) := sys->tokenize(p, " ");
		x := int hd l;
		y := int hd tl l;
		index := tk->cmd(window, ".view.t index @"+string x+","+string y);		
		selindex := tk->cmd(window, ".view.t tag ranges sel");
		insel := 0;
		if(selindex != "")
			insel = tk->cmd(window, ".view.t compare sel.first <= "+index)=="1" &&
				tk->cmd(window, ".view.t compare sel.last >= "+index)=="1";
		text := "";
		attr := "";
		if (insel)
			text = tk->cmd(window, ".view.t get sel.first sel.last");
		else{
			# have line with text in it
			# now extract whitespace-bounded string around click
			(nil, w) := sys->tokenize(index, ".");
			charno := int hd tl w;
			left := tk->cmd(window, ".view.t index {"+index+" linestart}");
			right := tk->cmd(window, ".view.t index {"+index+" lineend}");
			line := tk->cmd(window, ".view.t get "+left+" "+right);
			for(i:=charno; i>0; --i)
				if(line[i-1]==' ' || line[i-1]=='\t')
					break;
			for(j:=charno; j<len line; j++)
				if(line[j]==' ' || line[j]=='\t')
					break;
			text = line[i:j];
			attr = "click="+string (charno-i);
		}
		msg := ref Plumbmsg->Msg(
			"WmMan",
			"",
			"",
			"text",
			attr,
			array of byte text);
		plumber->msg.send();

	layoutpid = <- pidc =>
		;
	}
}

search(pat : string)
{
	dir : string;
	start : string;
	if (pat[0] == '/') {
		dir = "-forwards";
		start = history.searchend;
	} else {
		dir = "-backwards";
		start = history.searchstart;
	}
	pat = pat[1:];
	if (start == "")
		start = "1.0";
	r := tk->cmd(window, ".view.t search " + dir + " -- " + wmlib->tkquote(pat) + " " + start);
	if (r != nil) {
		history.searchstart = r;
		history.searchend = r + "+" + string len pat + "c";
		tk->cmd(window, ".view.t tag remove sel 1.0 end");
		tk->cmd(window, ".view.t tag add sel " + history.searchstart + " " + history.searchend);
		tk->cmd(window, ".view.t see " + r);
		tk->cmd(window, "update");
	}
}

setbuttons()
{
	if (history.prev == nil)
		tk->cmd(window, ".input.back configure -state disabled");
	else
		tk->cmd(window, ".input.back configure -state active");
	if (history.next == nil)
		tk->cmd(window, ".input.forward configure -state disabled");
	else
		tk->cmd(window, ".input.forward configure -state active");
}

dolayout(linechan : chan of list of (int, Parseman->Text), path : string)
{
	fd := sys->open(path, Sys->OREAD);
	if (fd == nil) {
		layouterror(linechan, sys->sprint("cannot open file %s: %r", path));
		return;
	}
	viewman := load Viewman SELF;
	parser->parseman(fd, metrics, 0, viewman, linechan);
}

printman(pidc : chan of int, linechan : chan of list of (int, Parseman->Text), h : ref History)
{
	pidc <- = sys->pctl(0, nil);
	args : list of string;
	pick hp := h {
		Search =>
			args = hp.search;
		Go =>
			dolayout(linechan, hp.path);
			pidc <- = -1;
			return;
	}
	sections : list of int;
	argstext := "";
	addsections := 1;
	keywords : list of string;
	for (; args != nil; args = tl args) {
		arg := hd args;
		if (arg == nil)
			continue;
		if (addsections && !isint(arg)) {
			addsections = 0;
			keywords = args;
		}
		if (addsections)
			sections = int arg :: sections;
		argstext = argstext + " " + arg;
	}
	manpages := man->getfiles(sections, keywords);
	pagelist := sortpages(manpages);
	if (len pagelist == 1) {
		(nil, path, nil) := hd pagelist;
		dolayout(linechan, path);
		pidc <- = -1;
		return;
	}

	tt := Parseman->Text(Parseman->FONT_ROMAN, 0, "Search:", 1, nil);
	at := Parseman->Text(Parseman->FONT_BOLD, 0, argstext, 0, nil);
	linechan <- = (0, tt)::(0, at)::nil;
	tt.text = "";
	linechan <- = (0, tt)::nil;

	if (pagelist == nil) {
		donet := Parseman->Text(Parseman->FONT_ROMAN, 0, "No matches", 0, nil);
		linechan <- = (INDENT, donet) :: nil;
		linechan <- = nil;
		pidc <- = -1;
		return;
	}

	linelist : list of list of Parseman->Text;
	pathlist : list of Parseman->Text;
	
	maxkwlen := 0;
	comma := Parseman->Text(Parseman->FONT_ROMAN, 0, ", ", 0, "");
	for (; pagelist != nil; pagelist = tl pagelist) {
		(n, p, kwl) := hd pagelist;
		l := 0;
		keywords : list of Parseman->Text = nil;
		for (; kwl != nil; kwl = tl kwl) {
			kw := hd kwl;
			kwt := Parseman->Text(Parseman->FONT_ITALIC, GOATTR, kw, 0, p);
			nt := Parseman->Text(Parseman->FONT_ROMAN, GOATTR, "(" + string n + ")", 0, p);
			l += textwidth(kwt) + textwidth(nt);
			if (keywords != nil) {
				l += textwidth(comma);
				keywords = nt :: kwt :: comma :: keywords;
			} else
				keywords = nt :: kwt :: nil;
		}
		if (l > maxkwlen)
			maxkwlen = l;
		linelist = keywords :: linelist;
		ptext := Parseman->Text(Parseman->FONT_ROMAN, GOATTR, p, 0, "");
		pathlist = ptext :: pathlist;
	}

	for (; pathlist != nil; (pathlist, linelist) = (tl pathlist, tl linelist)) {
		line := (10 + INDENT + maxkwlen, hd pathlist) :: nil;
		for (ll := hd linelist; ll != nil; ll = tl ll) {
			litem := hd ll;
			if (tl ll == nil)
				line = (INDENT, litem) :: line;
			else
				line = (0, litem) :: line;
		}
		linechan <- = line;
	}
	linechan <- = nil;
	pidc <- = -1;
}

layouterror(linechan : chan of list of (int, Parseman->Text), msg : string)
{
	text := "ERROR: " + msg;
	t := Parseman->Text(Parseman->FONT_ROMAN, 0, text, 0, nil);
	linechan <- = (0, t)::nil;
	linechan <- = nil;
}

loaderr(modname : string)
{
	sys->print("cannot load %s module: %r\n", modname);
	sys->raise("fail:init");
}

textwidth(text : Parseman->Text) : int
{
	f : ref Draw->Font;
	if (text.heading == 1)
		f = h1font;
	else if (text.heading == 2)
		f = h2font;
	else {
		case text.font {
		Parseman->FONT_ROMAN =>
			f = rfont;
		Parseman->FONT_BOLD =>
			f = bfont;
		Parseman->FONT_ITALIC =>
			f = ifont;
		* =>
			return 8 * len text.text;
		}
	}
	return draw->f.width(text.text);
}

lnum := 0;

setline(line : list of (int, Parseman->Text))
{
	tabstr := "";
	linestr := "";
	lastoff := 0;
	curfont := Parseman->FONT_ROMAN;
	curlink := "";
	curgtag := "";
	curheading := 0;
	fonttext := "";

	for (l := line; l != nil; l = tl l) {
		(offset, nil) := hd l;
		if (offset != 0) {
			lastoff = offset;
			if (tabstr != "")
				tabstr[len tabstr] = ' ';
			tabstr = tabstr + string offset;
		}
	}
	# fudge up tabs for rest of line
	if (lastoff != 0)
		tabstr = tabstr + " " + string lastoff + " " + string (lastoff + INDENT);
	ttag := "";
	gtag := "";
	lastgtag := "";
	if (tabstr != nil)
		ttag = tabtag(tabstr) + " ";

	for (l = line; l != nil; l = tl l) {
		(offset, text) := hd l;
		gtag = "";
		if (text.link != nil) {
			if (text.attr & GOATTR)
				gtag = gotag(text.link) + " ";
			else {
				gtag = linktag(text.link) + " ";
			}
		}
		if (offset != 0)
			fonttext[len fonttext] = '\t';
		if (text.font != curfont || text.link != curlink || text.heading != curheading || gtag != curgtag) {
			# need to change tags
			linestr = linestr + " " + wmlib->tkquote(fonttext) + " {" + ttag + curgtag + fonttag(curfont, curheading) + "}";
			ttag = "";
			curgtag = gtag;
			fonttext = "";
			curfont = text.font;
			curlink = text.link;
			curheading = text.heading;
		}
		fonttext = fonttext + text.text;
	}
	if (fonttext != nil)
		linestr = linestr + " " + wmlib->tkquote(fonttext) + " {" + ttag + curgtag + fonttag(curfont, curheading) + "}";
	tk->cmd(window, ".view.t insert end " + linestr);
	tk->cmd(window, ".view.t insert end {\n}");
	# only update on every other line
	if (lnum++ & 1)
		tk->cmd(window, "update");
}

mktags()
{
	tk->cmd(window, ".view.t tag configure ROMAN -font " + ROMAN);
	tk->cmd(window, ".view.t tag configure BOLD -font " + BOLD);
	tk->cmd(window, ".view.t tag configure ITALIC -font " + ITALIC);
	tk->cmd(window, ".view.t tag configure H1 -font " + HEADING1);
	tk->cmd(window, ".view.t tag configure H2 -font " + HEADING2);
}

fonttag(font, heading : int) : string
{
	if (heading == 1)
		return "H1";
	if (heading == 2)
		return "H2";
	case font {
	Parseman->FONT_ROMAN =>
		return "ROMAN";
	Parseman->FONT_BOLD =>
		return "BOLD";
	Parseman->FONT_ITALIC =>
		return "ITALIC";
	}
	return nil;
}

nexttag := 0;
lasttabstr := "";
lasttagname := "";

tabtag(tabstr : string) : string
{
	if (tabstr == lasttabstr)
		return lasttagname;
	lasttagname = "TAB" + string nexttag++;
	lasttabstr = tabstr;
	tk->cmd(window, ".view.t tag configure " + lasttagname + " -tabs " + wmlib->tkquote(tabstr));
	return lasttagname;
}

# optimise this!
gotag(path : string) : string
{
	cmd := "{send nav g" + path + "}";
	name := "GO" + string nexttag++;
	tk->cmd(window, ".view.t tag bind " + name + " <ButtonRelease-1> +" + cmd);
	tk->cmd(window, ".view.t tag configure " + name + " -fg green");
	return name;
}

# and this!
linktag(search : string) : string
{
	cmd := wmlib->tkquote("send nav l" + search);
	name := "LN" + string nexttag++;
	tk->cmd(window, ".view.t tag bind " + name + " <ButtonRelease-1> +" + cmd);
	tk->cmd(window, ".view.t tag configure " + name + " -fg green");
	return name;
}

isint(s : string) : int
{
	for (i := 0; i < len s; i++)
		if (s[i] < '0' || s[i] > '9')
			return 0;
	return 1;
}

kill(pid : int)
{
	pctl := sys->open("/prog/" + string pid + "/ctl", Sys->OWRITE);
	if (pctl != nil) {
		poison := array of byte "kill";
		sys->write(pctl, poison, len poison);
	}
}

revsortuniq(strlist : list of string) : list of string
{
	strs := array [len strlist] of string;
	for (i := 0; strlist != nil; (i, strlist) = (i+1, tl strlist))
		strs[i] = hd strlist;

	# simple sort (ascending)
	for (i = 0; i < len strs - 1; i++) {
		for (j := i+1; j < len strs; j++)
			if (strs[i] < strs[j])
				(strs[i], strs[j]) = (strs[j], strs[i]);
	}

	# construct list (result is descending)
	r : list of string;
	prev := "";
	for (i = 0; i < len strs; i++) {
		if (strs[i] != prev) {
			r = strs[i] :: r;
			prev = strs[i];
		}
	}
	return r;
}

sortpages(pagelist : list of (int, string, string)) : list of (int, string, list of string)
{
	pages := array [len pagelist] of (int, string, string);
	for (i := 0; pagelist != nil; (i, pagelist) = (i+1, tl pagelist))
		pages[i] = hd pagelist;

	for (i = 0; i < len pages - 1; i++) {
		for (j := i+1; j < len pages; j++) {
			(nil, nil, ipath) := pages[i];
			(nil, nil, jpath) := pages[j];
			if (ipath > jpath)
				(pages[i], pages[j]) = (pages[j], pages[i]);
		}
	}

	r : list of (int, string, list of string);
	filecmds : list of string;
	lastfile := "";
	lastsect := 0;
	for (i = 0; i < len pages; i++) {
		(section, cmd, file) := pages[i];
		if (lastfile == "") {
			lastfile = file;
			lastsect = section;
		}

		if (file != lastfile) {
			r = (lastsect, lastfile, filecmds) :: r;
			lastfile = file;
			lastsect = section;
			filecmds = nil;
		}
		filecmds = cmd :: filecmds;
	}
	if (filecmds != nil)
		r = (lastsect, lastfile, revsortuniq(filecmds)) :: r;
	return r;
}