implement Mashbuiltin;

#
#	"tk" builtin.
#
#	tk clear		- clears the text frame
#	tk def button name value
#	tk def ibutton name value image
#	tk def menu name
#	tk def item menu name value
#	tk dialog title mesg default label ...
#	tk dump			- print commands to reconstruct toolbar
#	tk dump name ...
#	tk env			- update tk execution env
#	tk file title dir pattern ...
#	tk geom
#	tk layout name ...
#	tk notice message
#	tk sel			- print selection
#	tk sget			- print snarf
#	tk sput string		- put snarf
#	tk string mesg		- get string
#	tk taskbar string
#	tk text			- print window text
#

include	"mash.m";
include	"mashparse.m";
include	"wmlib.m";
include	"dialog.m";
include	"selectfile.m";

mashlib:	Mashlib;
wmlib:		Wmlib;
dialog:	Dialog;
selectfile:	Selectfile;

Env, Stab, Symb:	import mashlib;
sys, bufio, tk:		import mashlib;
gtop, gctxt, ident:	import mashlib;

Iobuf:	import bufio;

tkitems:	ref Stab;
tklayout:	list of string;
tkenv:	ref Env;
tkserving:	int = 0;

Cbutton, Cibutton, Cmenu:	con Cprivate + iota;

Cmark:	con 3;
BUTT:	con ".b.";

#
#	Interface to catch the use as a command.
#
init(nil: ref Draw->Context, args: list of string)
{
	raise "fail: " + hd args + " not loaded";
}

#
#	Used by whatis.
#
name(): string
{
	return "tk";
}

#
#	Install command and initialize state.
#
mashinit(nil: list of string, lib: Mashlib, this: Mashbuiltin, e: ref Env)
{
	mashlib = lib;
	if (gctxt == nil) {
		e.report("tk: no graphics context");
		return;
	}
	if (gtop == nil) {
		e.report("tk: not run from wmsh");
		return;
	}
	wmlib = load Wmlib Wmlib->PATH;
	if (wmlib == nil) {
		e.report(sys->sprint("tk: could not load %s: %r", Wmlib->PATH));
		return;
	}
	dialog = load Dialog Dialog->PATH;
	if (dialog == nil) {
		e.report(sys->sprint("tk: could not load %s: %r", Dialog->PATH));
		return;
	}
	selectfile = load Selectfile Selectfile->PATH;
	if (selectfile == nil) {
		e.report(sys->sprint("tk: could not load %s: %r", Selectfile->PATH));
		return;
	}
	wmlib->init();
	dialog->init();
	selectfile->init();
	e.defbuiltin("tk", this);
	tkitems = Stab.new();
}

#
#	Execute the "tk" builtin.
#
mashcmd(e: ref Env, l: list of string)
{
	# must lock
	l = tl l;
	if (l == nil)
		return;
	s := hd l;
	l = tl l;
	case s {
	"clear" =>
		if (l != nil) {
			e.usage("tk clear");
			return;
		}
		clear(e);
	"def" =>
		define(e, l);
	"dialog" =>
		if (len l < 4) {
			e.usage("tk dialog title mesg default label ...");
			return;
		}
		dodialog(e, l);
	"dump" =>
		dump(e, l);
	"env" =>
		if (l != nil) {
			e.usage("tk env");
			return;
		}
		tkenv = e.clone();
		tkenv.flags |= mashlib->ETop;
	"file" =>
		if (len l < 3) {
			e.usage("tk file title dir pattern ...");
			return;
		}
		dofile(e, hd l, hd tl l, tl tl l);
	"geom" =>
		if (l != nil) {
			e.usage("tk geom");
			return;
		}
		e.output(wmlib->geom(gtop));
	"layout" =>
		layout(e, l);
	"notice" =>
		if (len l != 1) {
			e.usage("tk notice message");
			return;
		}
		notice(hd l);
	"sel" =>
		if (l != nil) {
			e.usage("tk sel");
			return;
		}
		sel(e);
	"sget" =>
		if (l != nil) {
			e.usage("tk sget");
			return;
		}
		e.output(wmlib->snarfget());
	"sput" =>
		if (len l != 1) {
			e.usage("tk sput string");
			return;
		}
		wmlib->snarfput(hd l);
	"string" =>
		if (len l != 1) {
			e.usage("tk string mesg");
			return;
		}
		e.output(dialog->getstring(gctxt, gtop.image, hd l));
		focus(e);
	"taskbar" =>
		if (len l != 1) {
			e.usage("tk taskbar string");
			return;
		}
		e.output(wmlib->taskbar(gtop, hd l));
	"text" =>
		if (l != nil) {
			e.usage("tk text");
			return;
		}
		text(e);
	* =>
		e.report(sys->sprint("tk: unknown command: %s", s));
	}
}

#
#	Execute tk command and check for error.
#
tkcmd(e: ref Env, s: string): string
{
	if (e != nil && (e.flags & mashlib->EDumping))
		sys->fprint(e.stderr, "+ %s\n", s);
	r := tk->cmd(gtop, s);
	if (r != nil && r[0] == '!' && e != nil)
		sys->fprint(e.stderr, "tk: %s\n\tcommand was %s\n", r[1:], s);
	return r;
}

focus(e: ref Env)
{
	tkcmd(e, "focus .ft.t");
}

#
#	Serve loop.
#
tkserve(mash: chan of string)
{
	mashlib->reap();
	for (;;) {
		cmd := <-mash;
		if (mashlib->servechan != nil && len cmd > 1) {
			cmd[len cmd - 1] = '\n';
			mashlib->servechan <-= array of byte cmd[1:];
		}
	}
}

notname(e: ref Env, s: string)
{
	e.report(sys->sprint("tk: %s: malformed name", s));
}

#
#	Define a button, menu or item.
#
define(e: ref Env, l: list of string)
{
	if (l == nil) {
		e.usage("tk def definition");
		return;
	}
	s := hd l;
	l = tl l;
	case s {
	"button" =>
		if (len l != 2) {
			e.usage("tk def button name value");
			return;
		}
		s = hd l;
		if (!ident(s)) {
			notname(e, s);
			return;
		}
		i := tkitems.update(s, Svalue, tl l, nil, nil);
		i.tag = Cbutton;
	"ibutton" =>
		if (len l != 3) {
			e.usage("tk def ibutton name value path");
			return;
		}
		s = hd l;
		if (!ident(s)) {
			notname(e, s);
			return;
		}
		i := tkitems.update(s, Svalue, tl l, nil, nil);
		i.tag = Cibutton;
	"menu" =>
		if (len l != 1) {
			e.usage("tk def menu name");
			return;
		}
		s = hd l;
		if (!ident(s)) {
			notname(e, s);
			return;
		}
		i := tkitems.update(s, Svalue, nil, nil, nil);
		i.tag = Cmenu;
	"item" =>
		if (len l != 3) {
			e.usage("tk def item menu name value");
			return;
		}
		s = hd l;
		i := tkitems.find(s);
		if (i == nil || i.tag != Cmenu) {
			e.report(s + ": not a menu");
			return;
		}
		l = tl l;
		i.value = updateitem(i.value, hd l, hd tl l);
	* =>
		e.report("tk: " + s + ": unknown command");
	}
}

#
#	Update a menu item.
#
updateitem(l: list of string, c, v: string): list of string
{
	r: list of string;
	while (l != nil) {
		w := hd l;
		l = tl l;
		d := hd l;
		l = tl l;
		if (d == c) {
			r = c :: v :: r;
			c = nil;
		} else
			r = d :: w :: r;
	}
	if (c != nil)
		r = c :: v :: r;
	return mashlib->revstrs(r);
}

items(e: ref Env, l: list of string): list of ref Symb
{
	r: list of ref Symb;
	while (l != nil) {
		i := tkitems.find(hd l);
		if (i == nil) {
			e.report(hd l + ": not an item");
			return nil;
		}
		r = i :: r;
		l = tl l;
	}
	return r;
}

deleteall(e: ref Env, l: list of string)
{
	while (l != nil) {
		tkcmd(e, "destroy " + BUTT + hd l);
		l = tl l;
	}
}

sendcmd(c: string): string
{
	return tk->quote("send mash " + tk->quote(c));
}

addbutton(e: ref Env, w, t, c: string)
{
	tkcmd(e, sys->sprint("button %s%s -%s %s -command %s", BUTT, t, w, t, sendcmd(c)));
}

addimage(e: ref Env, t, f: string)
{
	r := tkcmd(nil, sys->sprint("image create bitmap %s -file %s.bit -maskfile %s.mask", t, f, f));
	if (r != nil && r[0] == '!')
		tkcmd(e, sys->sprint("image create bitmap %s -file %s.bit", t, f));
}

additem(e: ref Env, s: ref Symb)
{
	case s.tag {
	Cbutton =>
		addbutton(e, "text", s.name, hd s.value);
	Cibutton =>
		addimage(e, s.name, hd tl s.value);
		addbutton(e, "image", s.name, hd s.value);
	Cmenu =>
		t := s.name;
		tkcmd(e, sys->sprint("menubutton %s%s -text %s -menu %s%s.menu -underline -1", BUTT, t, t, BUTT,t));
		t += ".menu";
		tkcmd(e, "menu " + BUTT + t);
		t = BUTT + t;
		l := s.value;
		while (l != nil) {
			v := sendcmd(hd l);
			l = tl l;
			c := tk->quote(hd l);
			l = tl l;
			tkcmd(e, sys->sprint("%s add command -label %s -command %s", t, c, v));
		}
	}
}

pack(e: ref Env, l: list of string)
{
	s := "pack";
	while (l != nil) {
		s += sys->sprint(" %s%s", BUTT, hd l);
		l = tl l;
	}
	s += " -side left";
	tkcmd(e, s);
}

propagate(e: ref Env)
{
	tkcmd(e, "pack propagate . 0");
	tkcmd(e, "update");
}

unmark(r: list of ref Symb)
{
	while (r != nil) {
		s := hd r;
		case s.tag {
		Cbutton + Cmark or Cibutton + Cmark or Cmenu + Cmark =>
			s.tag -= Cmark;
		}
		r = tl r;
	}
}

#
#	Check that the layout tags are unique.
#
unique(e: ref Env, r: list of ref Symb): int
{
	u := 1;
loop:
	for (l := r; l != nil; l = tl l) {
		s := hd l;
		case s.tag {
		Cbutton + Cmark or Cibutton + Cmark or Cmenu + Cmark =>
			e.report(sys->sprint("layout: tag %s repeated", s.name));
			u = 0;
			break loop;
		Cbutton or Cibutton or Cmenu =>
			s.tag += Cmark;
		}
	}
	unmark(r);
	return u;
}

#
#	Update the button bar layout and the environment.
#	Maybe spawn the server.
#
layout(e: ref Env, l: list of string)
{
	r := items(e, l);
	if (r == nil && l != nil)
		return;
	if (!unique(e, r))
		return;
	if (tklayout != nil)
		deleteall(e, tklayout);
	n := len r;
	a := array[n] of ref Symb;
	while (--n >= 0) {
		a[n] = hd r;
		r = tl r;
	}
	n = len a;
	for (i := 0; i < n; i++)
		additem(e, a[i]);
	pack(e, l);
	propagate(e);
	tklayout = l;
	tkenv = e.clone();
	tkenv.flags |= mashlib->ETop;
	if (!tkserving) {
		tkserving = 1;
		mash := chan of string;
		tk->namechan(gtop, mash, "mash");
		spawn tkserve(mash);
		mashlib->startserve = 1;
	}
}

dumpbutton(out: ref Iobuf, w: string, s: ref Symb)
{
	out.puts(sys->sprint("tk def %s %s %s", w, s.name, mashlib->quote(hd s.value)));
	if (s.tag == Cibutton)
		out.puts(sys->sprint(" %s", mashlib->quote(hd tl s.value)));
	out.puts(";\n");
}

#
#	Print commands to reconstruct toolbar.
#
dump(e: ref Env, l: list of string)
{
	r: list of ref Symb;
	if (l != nil)
		r = items(e, l);
	else
		r = tkitems.all();
	out := e.outfile();
	if (out == nil)
		return;
	while (r != nil) {
		s := hd r;
		case s.tag {
		Cbutton =>
			dumpbutton(out, "button", s);
		Cibutton =>
			dumpbutton(out, "ibutton", s);
		Cmenu =>
			t := s.name;
			out.puts(sys->sprint("tk def menu %s;\n", t));
			i := s.value;
			while (i != nil) {
				v := hd i;
				i = tl i;
				c := hd i;
				i = tl i;
				out.puts(sys->sprint("tk def item %s %s %s;\n", t, c, mashlib->quote(v)));
			}
		}
		r = tl r;
	}
	if (l == nil) {
		out.puts("tk layout");
		for (l = tklayout; l != nil; l = tl l) {
			out.putc(' ');
			out.puts(hd l);
		}
		out.puts(";\n");
	}
	out.close();
}

clear(e: ref Env)
{
	tkcmd(e, ".ft.t delete 1.0 end; update");
}

dofile(e: ref Env, title, dir: string, pats: list of string)
{
	e.output(selectfile->filename(gctxt, gtop.image, title, pats, dir));
}

sel(e: ref Env)
{
	sel := tkcmd(e, ".ft.t tag ranges sel");
	if (sel != nil) {
		s := tkcmd(e, ".ft.t dump " + sel);
		e.output(s);
	}
}

text(e: ref Env)
{
	sel := tkcmd(e, ".ft.t tag ranges sel");
	if (sel != nil)
		tkcmd(e, ".ft.t tag remove sel " + sel);
	s := tkcmd(e, ".ft.t dump 1.0 end");
	if (sel != nil)
		tkcmd(e, ".ft.t tag add sel " + sel);
	e.output(s);
}

notice0 := array[] of
{
	"frame .f -borderwidth 2 -relief groove -padx 3 -pady 3",
	"frame .f.f",
	"label .f.f.l -bitmap error -foreground red",
};

notice1 := array[] of
{
	"button .f.b -text {  OK  } -command {send cmd done}",
	"pack .f.f.l .f.f.m -side left -expand 1 -padx 10 -pady 10",
	"pack .f.f .f.b -padx 10 -pady 10",
	"pack .f",
	"update; cursor -default",
};

notice(mesg: string)
{
	x := int tk->cmd(gtop, ". cget -x");
	y := int tk->cmd(gtop, ". cget -y");
	where := sys->sprint("-x %d -y %d", x + 30, y + 30);
	t := tk->toplevel(gctxt.screen, where + " -borderwidth 2 -relief raised");
	cmd := chan of string;
	tk->namechan(t, cmd, "cmd");
	wmlib->tkcmds(t, notice0);
	tk->cmd(t, "label .f.f.m -text '" + mesg);
	wmlib->tkcmds(t, notice1);
	<- cmd;
}

dodialog(e: ref Env, l: list of string)
{
	title := hd l;
	l = tl l;
	msg := hd l;
	l = tl l;
	x := dialog->prompt(gctxt, gtop.image, nil, title, msg, int hd l, tl l);
	e.output(string x);
	focus(e);
}