grid/lib/browser.b

implement Browser;

#
# Copyright © 2003 Vita Nuova Holdings Limited.  All rights reserved.
#

include "sys.m";
	sys : Sys;
include "draw.m";
	draw: Draw;
	Rect: import draw;
include "tk.m";
	tk: Tk;
include "tkclient.m";
	tkclient: Tkclient;
include "./pathreader.m";
include "./browser.m";

entryheight := "";

init()
{
	sys = load Sys Sys->PATH;
	if (sys == nil)
		badmod(Sys->PATH);
	draw = load Draw Draw->PATH;
	if (draw == nil)
		badmod(Draw->PATH);
	tk = load Tk Tk->PATH;
	if (tk == nil)
		badmod(Tk->PATH);
	tkclient = load Tkclient Tkclient->PATH;
	if (tkclient == nil)
		badmod(Tkclient->PATH);
	tkclient->init();
}

Browse.new(top: ref Tk->Toplevel, tkchanname, root, rlabel: string, nopanes: int, reader: PathReader): ref Browse
{
	b : Browse;
	b.top = top;
	b.tkchan = tkchanname;
	if (nopanes < 1 || nopanes > 2)
		return nil;
	b.nopanes = 2;
	b.bgnorm = bgnorm;
	b.bgselect = bgselect;
	b.selected = array[2] of { * => Selected (File(nil, nil), nil) };
	b.opened = (root, nil) :: nil;
	if (root == nil)
		return nil;
	if (root[len root - 1] != '/')
		root[len root] = '/';
	b.pane0width = "2 3";
	b.root = root;
	b.rlabel = rlabel;
	b.reader = reader;
	b.pane1 = File (nil, "-123");
	b.released = 1;
	tkcmds(top, pane0scr);

	tkcmds(top, pane1scr);
	tkcmd(top, "bind .fbrowse.lmov <Button-1> {send "+b.tkchan+" movdiv %X}");

	tkcmd(top, "label .fbrowse.l -text { }  -anchor w -width 0" +
		" -font /fonts/charon/plain.normal.font");
	tkcmd(top, ".fbrowse.l configure -height "+tkcmd(top, ".fbrowse.l cget -height"));
	tkcmd(top, "grid .fbrowse.l -row 0 -column 0 -sticky ew -pady 2 -columnspan 4");
	rb := ref b;
	rb.newroot(b.root, b.rlabel);
	rb.changeview(nopanes);
	setbrowsescrollr(rb);
	return rb;
}

Browse.refresh(b: self ref Browse)
{
	scrval := tkcmd(b.top, ".fbrowse.sy1 get");
	p := isat(scrval, " ");
	p1 := b.pane1;
	b.newroot(b.root, b.rlabel);
	setbrowsescrollr(b);
	if (b.nopanes == 2)
		popdirpane1(b, p1);
	b.selectfile(1,DESELECT, File (nil, nil), nil);
	b.selectfile(0,DESELECT, File (nil, nil), nil);
	tkcmd(b.top, ".fbrowse.c1 yview moveto "+scrval[:p]+"; update");
}

bgnorm := "white";
bgselect := "#5555FF";

ft := " -font /fonts/charon/plain.normal.font";
fts := " -font /fonts/charon/plain.tiny.font";
ftb := " -font /fonts/charon/bold.normal.font";

Browse.gotoselectfile(b: self ref Browse, file: File): string
{
	(dir, tkpath) := b.gotopath(file, 0);
	if (tkpath == nil)
		return nil;
	# Select dir
	tkpath += ".l";
	if (dir.qid != nil)
		tkpath += "Q" + dir.qid;
	b.selectfile(0, SELECT, dir, tkpath);

	# If it is a file, select the file too
	if (!File.eq(file, dir)) {
		slaves := tkcmd(b.top, "grid slaves .fbrowse.fl2");
		(nil, lst) := sys->tokenize(slaves, " ");
		for (; lst != nil; lst = tl lst) {
			if (File.eq(file, *b.getpath(hd lst))) {
				b.selectfile(1, SELECT, file, hd lst);
				tkpath = hd lst;
				break;
			}
		}
		pane1see(b);
	}
	return tkpath;
}

pane1see(b: ref Browse)
{
	f := b.selected[1].tkpath;
	if (f == "")
		return;
	x1 := int tkcmd(b.top, f+" cget -actx") - int tkcmd(b.top, ".fbrowse.fl2 cget -actx");
	y1 := int tkcmd(b.top, f+" cget -acty") - int tkcmd(b.top, ".fbrowse.fl2 cget -acty");
	x2 := x1 + int tkcmd(b.top, f+" cget -actwidth");
	y2 := y1 + int tkcmd(b.top, f+" cget -actheight");
	tkcmd(b.top, sys->sprint(".fbrowse.c2 see %d %d %d %d", x1,y1,x2,y2));
}

Browse.opendir(b: self ref Browse, file: File, tkpath: string, action: int): int
{
	curr := tkcmd(b.top, tkpath+".lp cget -text");
	if ((action == OPEN || action == TOGGLE) && curr == "+") {
		tkcmd(b.top, tkpath+".lp configure -text {-} -relief sunken");
		popdirpane0(b, file, tkpath);
		seeframe(b.top, tkpath);
		b.addopened(file, 1);
		setbrowsescrollr(b);
		return 1;
	}
	else if ((action == CLOSE || action == TOGGLE) && curr == "-") {
		tkcmd(b.top, tkpath+".lp configure -text {+} -relief raised");
		slaves := tkcmd(b.top, "grid slaves "+tkpath+" -column 1");
		p := isat(slaves, " ");
		if (p != -1)
			tkcmd(b.top, "destroy "+slaves[p:]);
		slaves = tkcmd(b.top, "grid slaves "+tkpath+" -column 2");
		if (slaves != "")
			tkcmd(b.top, "destroy "+slaves);
		b.addopened(file, 0);
		setbrowsescrollr(b);
		return 1;
	}
	return 0;
}

Browse.addopened(b: self ref Browse, file: File, add: int)
{
	tmp : list of File = nil;
	for (; b.opened != nil; b.opened = tl b.opened) {
		dir := hd b.opened;
		if (!File.eq(file, dir))
			tmp = dir :: tmp;
	}
	if (add)
		tmp = file :: tmp;
	b.opened = tmp;
}

Browse.changeview(b: self ref Browse, nopanes: int)
{
	if (b.nopanes == nopanes)
		return;
#	w := int tkcmd(b.top, ".fbrowse cget -actwidth");
#	ws := int tkcmd(b.top, ".fbrowse.sy1 cget -width");
	if (nopanes == 1) {
		b.pane0width = tkcmd(b.top, ".fbrowse.c1 cget -actwidth") + " " +
						tkcmd(b.top, ".fbrowse.c2 cget -actwidth");
		tkcmd(b.top, "grid forget .fbrowse.sx2 .fbrowse.c2 .fbrowse.lmov");
		tkcmd(b.top, "grid columnconfigure .fbrowse 3 -weight 0");
	}
	else {
		(nil, wlist) := sys->tokenize(b.pane0width, " ");
		tkcmd(b.top, "grid columnconfigure .fbrowse 1 -weight "+hd wlist);
		tkcmd(b.top, "grid columnconfigure .fbrowse 3 -weight "+hd tl wlist);

		tkcmd(b.top, "grid .fbrowse.sx2 -row 3 -column 3 -sticky ew");
		tkcmd(b.top, "grid .fbrowse.c2 -row 2 -column 3 -sticky nsew");
		tkcmd(b.top, "grid .fbrowse.lmov -row 2 -column 2 -rowspan 2 -sticky ns");
	}
	b.nopanes = nopanes;
}

Browse.selectfile(b: self ref Browse, pane, action: int, file: File, tkpath: string)
{
	if (action == SELECT && b.selected[pane].tkpath == tkpath)
		return;
	if (b.selected[pane].tkpath != nil)
		tk->cmd(b.top, b.selected[pane].tkpath+" configure -bg "+bgnorm);
	if ((action == TOGGLE && b.selected[pane].tkpath == tkpath) || action == DESELECT) {
		if (pane == 0)
			popdirpane1(b, File (nil,nil));
		b.selected[pane] = (File(nil, nil), nil);
		return;
	}
	b.selected[pane] = (file, tkpath);
	tkcmd(b.top, tkpath+" configure -bg "+bgselect);
	if (pane == 0)
		popdirpane1(b, file);
}

Browse.resize(b: self ref Browse)
{
 	p1 := b.pane1;
 	b.pane1 = File (nil, nil);

 	if (p1.path != "")
 		popdirpane1(b, p1);

	if (b.selected[1].tkpath != nil) {
		s := b.selected[1];
		b.selectfile(1, DESELECT, s.file, s.tkpath);
		b.selectfile(1, SELECT, s.file, s.tkpath);
	}
}

setbrowsescrollr(b: ref Browse)
{
	h := tkcmd(b.top, ".fbrowse.fl cget -height");
	w := tkcmd(b.top, ".fbrowse.fl cget -width");
	tkcmd(b.top, ".fbrowse.c1 configure -scrollregion {0 0 "+w+" "+h+"}");
	if (b.nopanes == 2) {
		h = tkcmd(b.top, ".fbrowse.fl2 cget -height");
		w = tkcmd(b.top, ".fbrowse.fl2 cget -width");
		tkcmd(b.top, ".fbrowse.c2 configure -scrollregion {0 0 "+w+" "+h+"}");
	}
}

seeframe(top: ref Tk->Toplevel, frame: string)
{
	x := int tkcmd(top, frame+" cget -actx") - int tkcmd(top, ".fbrowse.fl cget -actx");
	y := int tkcmd(top, frame+" cget -acty")  - int tkcmd(top, ".fbrowse.fl cget -acty");
	w := int tkcmd(top, frame+" cget -width");
	h := int tkcmd(top, frame+" cget -height");
	wc := int tkcmd(top, ".fbrowse.c1 cget -width");
	hc := int tkcmd(top, ".fbrowse.c1 cget -height");
	if (w > wc)
		w = wc;
	if (h > hc)
		h = hc;
	tkcmd(top, sys->sprint(".fbrowse.c1 see %d %d %d %d",x,y,x+w,y+h));
}

# Goes to selected dir OR dir containing selected file
Browse.gotopath(b: self ref Browse, file: File, openfinal: int): (File, string)
{
	tkpath := ".fbrowse.fl.f0";
	path := b.root;
	testqid := "";
	testpath := "";
	close : list of string;
	trackbacklist : list of (string, list of string, list of string) = nil;
	trackback := 0;
	enddir := "";
	if (file.path[len file.path - 1] != '/') {
		# i.e. is not a directory
		p := isatback(file.path, "/");
		enddir = file.path[:p + 1];
	}
	if (enddir == path) {
		if (!dircontainsfile(b, File (path, nil), file))
			return (File (nil, nil), nil);
	}
	else {
		for(;;) {
			lst : list of string;
			if (trackback) {
				(path, lst, close) = hd trackbacklist;
				trackbacklist = tl trackbacklist;
				if (close != nil)
					b.opendir(File (hd close, hd tl close), hd tl tl close, CLOSE);
				trackback = 0;
			}
			else {
				frames := tkcmd(b.top, "grid slaves "+tkpath+" -column 1");
				(nil, lst) = sys->tokenize(frames, " ");
				if (lst != nil)
					lst = tl lst; # ignore first frame (name of parent dir);
			}
			found := 0;
			hasdups := 1;
			for (; lst != nil; lst = tl lst) {
				testpath = path;
				if (hasdups) {
					labels := tkcmd(b.top, "grid slaves "+hd lst+" -row 0");
					(nil, lst2) := sys->tokenize(labels, " ");
					testpath += tkcmd(b.top, hd tl lst2+" cget -text") + "/";
					testqid = getqidfromlabel(hd tl lst2);
					if (testqid == nil)
						hasdups = 0;
				}
				else
					testpath += tkcmd(b.top, hd lst+".l cget -text") + "/";
				if (len testpath <= len file.path && file.path[:len testpath] == testpath) {
					opened := 0;
					close = nil;
					if (openfinal || testpath != file.path)
						opened = b.opendir(File(testpath, testqid), hd lst, OPEN);
					if (opened)
						close = testpath :: testqid :: hd lst :: nil;
					if (tl lst != nil && hasdups)
						trackbacklist = (path, tl lst, close) :: trackbacklist;
					tkpath = hd lst;
					path = testpath;
					found = 1;
					break;
				}
			}
			if (enddir != nil && path == enddir)
				if (dircontainsfile(b, File(testpath, testqid), file))
					break;
			if (!found) {
				if (trackbacklist == nil)
					return (File (nil, nil), nil);
				trackback = 1;
			}
			else if (testpath == file.path && testqid == file.qid)
				break;
		}
	}
	seeframe(b.top, tkpath);
	dir := File (path, testqid);
	popdirpane1(b, dir);
	return (dir, tkpath);
}

dircontainsfile(b: ref Browse, dir, file: File): int
{
	(files, hasdups) := b.reader->readpath(dir);
	for (j := 0; j < len files; j++) {
		if (files[j].name == file.path[len dir.path:] &&
				(!hasdups || files[j].qid.path == big file.qid))
			return 1;
	}
	return 0;
}

Browse.getpath(b: self ref Browse, f: string): ref File
{
	if (len f < 11 || f[:11] != ".fbrowse.fl")
		return nil;
	(nil, lst) := sys->tokenize(f, ".");
	lst = tl lst;
	if (hd lst == "fl2") {
		# i.e. is in pane 1
		qid := getqidfromlabel(f);
		return ref File (b.pane1.path + tk->cmd(b.top, f+" cget -text"), qid);
	}
	tkpath := ".fbrowse.fl.f0";
	path := b.root;
	lst = tl tl lst;
#	sys->print("getpath: %s %s\n",tkpath, path);
	qid := "";
	for (; lst != nil; lst = tl lst) {
		tkpath += "."+hd lst;
		if ((hd lst)[0] == 'l') {
			qid = getqidfromlabel(tkpath);
			if (qid != nil)
				qid = "Q" + qid;
			if (len hd lst - len qid > 1)
				path += tk->cmd(b.top, tkpath+" cget -text");
		}
		else if ((hd lst)[0] == 'f') {
			qid = getqidfromframe(b,tkpath);
			if (qid != nil)
				qid = "Q"+qid;
			path += tk->cmd(b.top, tkpath+".l"+qid+" cget -text") + "/";
		}
#		sys->print("getpath: %s %s\n",tkpath, path);
	}
	# Temporary hack!
	if (qid != nil)
		qid = qid[1:];
	return ref File (path, qid);
}

setroot(b: ref Browse, rlabel, root: string)
{
	b.root = root;
	b.rlabel = rlabel;
	makedir(b, File (root, nil), ".fbrowse.fl.f0", rlabel, "0");
	tkcmd(b.top, "grid forget .fbrowse.fl.f0.lp");
}

getqidfromframe(b: ref Browse, frame: string): string
{
	tmp := tkcmd(b.top, "grid slaves "+frame+" -row 0");
	(nil, lst) := sys->tokenize(tmp, " \t\n");
	if (lst == nil)
		return nil;
	return getqidfromlabel(hd tl lst);
}

getqidfromlabel(label: string): string
{
	p := isatback(label, "Q");
	if (p != -1)
		return label[p+1:];
	return nil;
}

popdirpane0(b: ref Browse, dir : File, frame: string)
{
	(dirs, hasdups) := b.reader->readpath(dir);
	for (i := 0; i < len dirs; i++) {
		si := string i;
		f : string;
		dirqid := string dirs[i].qid.path;
		if (!hasdups)
			dirqid = nil;
		if (dirs[i].mode & sys->DMDIR) {
			f = frame + ".f"+si;
			makedir(b, File (dir.path+dirs[i].name, dirqid), f, dirs[i].name, string (i+1));
		}
		else {
			if (b.nopanes == 1) {
				f = frame + ".l"+si;
				makefile(b, f, dirs[i].name, string (i+1), dirqid);
			}
		}
	}
	dirs = nil;
}

isopened(b: ref Browse, dir: File): int
{
	for (tmp := b.opened; tmp != nil; tmp = tl tmp) {
		if (File.eq(hd tmp, dir))
			return 1;
	}
	return 0;
}

makefile(b: ref Browse, f, name, row, qid: string)
{
	if (qid != nil)
		f += "Q" + qid;
	bgcol := bgnorm;
#	if (f == selected[0].t1)
#		bgcol = bgselect;
	p := isat(name, "\0");
	if (p != -1) {
		tkcmd(b.top, "label "+f+" -text {"+name[:p]+"} -bg "+bgcol+ft);
		tkcmd(b.top, "label "+f+"b -text {"+name[p+1:]+"} -bg "+bgcol+ft);
		tkcmd(b.top, "grid "+f+" -row "+row+" -column 1 -sticky w -padx 5 -pady 2");
		tkcmd(b.top, "grid "+f+"b -row "+row+" -column 2 -sticky w -pady 2");
		tkcmd(b.top, "bind "+f+" <Button-2> {send "+b.tkchan+" but2pane1 "+f+"}");
		tkcmd(b.top, "bind "+f+" <ButtonRelease-2> {send "+b.tkchan+" release}");
	}
	else {
		tkcmd(b.top, "label "+f+" -text {"+name+"} -bg "+bgcol+ft);
		tkcmd(b.top, "grid "+f+" -row "+row+" -column 1 -sticky w -padx 5 -pady 2");
	}
	tkcmd(b.top, "bind "+f+" <Button-1> {send "+b.tkchan+" but1pane0 "+f+"}");
	tkcmd(b.top, "bind "+f+" <ButtonRelease-1> {send "+b.tkchan+" release}");
	tkcmd(b.top, "bind "+f+" <Button-2> {send "+b.tkchan+" but2pane0 "+f+"}");
	tkcmd(b.top, "bind "+f+" <ButtonRelease-2> {send "+b.tkchan+" release}");
	tkcmd(b.top, "bind "+f+" <Button-3> {send "+b.tkchan+" but3pane0 "+f+"}");
	tkcmd(b.top, "bind "+f+" <ButtonRelease-3> {send "+b.tkchan+" release}");
}

Browse.defaultaction(b: self ref Browse, lst: list of string, rfile: ref File)
{
	tkpath: string;
	file: File;
	if (len lst > 1) {
		tkpath = hd tl lst;
		if (len tkpath > 11 && tkpath[:11] == ".fbrowse.fl") {
			if (rfile == nil)
				file = *b.getpath(tkpath);
			else
				file = *rfile;
		}
	}
	case hd lst {
		"release" =>
			b.released = 1;
		"open" or "double1pane0" =>
			if (file.path == b.root)
				break;
			if (b.released) {
				b.selectfile(0, DESELECT, File(nil, nil), nil);
				b.selectfile(1, DESELECT, File(nil, nil), nil);
				b.opendir(file, prevframe(tkpath), TOGGLE);
				b.selectfile(0, SELECT, file, tkpath);
				b.released = 0;
			}
		"double1pane1" =>
			b.gotoselectfile(file);
		"but1pane0" =>
			if (b.released) {
				b.selectfile(1, DESELECT, File(nil, nil), nil);
				b.selectfile(0, TOGGLE, file, tkpath);
				b.released = 0;
			}
 		"but1pane1" =>
			if (b.released) {
				b.selectfile(1, TOGGLE, file, tkpath);
				b.released = 0;
			}
 		"movdiv" =>
			movdiv(b, int hd tl lst);
	}
}

prevframe(tkpath: string): string
{
	end := len tkpath;
	for (;;) {
		p := isatback(tkpath[:end], ".");
		if (tkpath[p+1] == 'f')
			return tkpath[:end];
		end = p;
	}
	return nil;
}

makedir(b: ref Browse, dir: File, f, name, row: string)
{
	bgcol := bgnorm;
	if (f == ".fbrowse.fl.f0")
		dir = File (b.root, nil);
#	if (name == "")
#		name = path;
	if (dir.path[len dir.path - 1] != '/')
		dir.path[len dir.path] = '/';
	if (File.eq(dir, b.selected[0].file))
		bgcol = bgselect;
	tkcmd(b.top, "frame "+f+" -bg white");
	label := f+".l";
	if (dir.qid != nil)
		label += "Q" + dir.qid;
	tkcmd(b.top, "label "+label+" -text {"+name+"} -bg "+bgcol+ftb);
	if (isopened(b, dir)) {
		popdirpane0(b, dir, f);
		tkcmd(b.top, "label "+f+".lp -text {-} -borderwidth 1 -relief sunken -height 8 -width 8"+fts);
	}
	else tkcmd(b.top, "label "+f+".lp -text {+} -borderwidth 1 -relief raised -height 8 -width 8"+fts);
	tkcmd(b.top, "bind "+label+" <Button-1> {send "+b.tkchan+" but1pane0 "+label+"}");
	tkcmd(b.top, "bind "+label+" <Double-Button-1> {send "+b.tkchan+" double1pane0 "+label+"}");
	tkcmd(b.top, "bind "+label+" <ButtonRelease-1> {send "+b.tkchan+" release}");
	tkcmd(b.top, "bind "+label+" <Button-3> {send "+b.tkchan+" but3pane0 "+label+"}");
	tkcmd(b.top, "bind "+label+" <ButtonRelease-3> {send "+b.tkchan+" release}");
	tkcmd(b.top, "bind "+label+" <Button-2> {send "+b.tkchan+" but2pane0 "+label+"}");
	tkcmd(b.top, "bind "+label+" <ButtonRelease-2> {send "+b.tkchan+" release}");

	tkcmd(b.top, "bind "+f+".lp <Button-1> {send "+b.tkchan+" open "+label+"}");
	tkcmd(b.top, "bind "+f+".lp <ButtonRelease-1> {send "+b.tkchan+" release}");
	tkcmd(b.top, "grid "+f+".lp -row 0 -column 0");
	tkcmd(b.top, "grid "+label+" -row 0 -column 1 -sticky w -padx 5 -pady 2 -columnspan 2");
	tkcmd(b.top, "grid "+f+" -row "+row+" -column 1 -sticky w -padx 5 -columnspan 2");
}

popdirpane1(b: ref Browse, dir: File)
{
#	if (path == b.pane1.path && qid == b.pane1.qid)
#		return;
	b.pane1 = dir;
	labelset(b, ".fbrowse.l", prevpath(dir.path+"/"));
	if (b.nopanes == 1)
		return;
	tkcmd(b.top, "destroy .fbrowse.fl2; frame .fbrowse.fl2 -bg white");
	tkcmd(b.top, ".fbrowse.c2 create window 0 0 -window .fbrowse.fl2 -anchor nw");
	if (dir.path == nil) {
		setbrowsescrollr(b);
		return;
	}
	(dirs, hasdups) := b.reader->readpath(dir);
#	if (path[len path - 1] == '/')
#		path = path[:len path - 1];
#	tkcmd(b.top, "label .fbrowse.fl2.l -text {"+path+"}");
	row := 0;
	col := 0;
	tkcmd(b.top, ".fbrowse.c2 see 0 0");
	ni := 0;
	n := (int tkcmd(b.top, ".fbrowse.c2 cget -actheight")) / 21;
	for (i := 0; i < len dirs; i++) {

		f := ".fbrowse.fl2.l"+string ni;
		if (hasdups)
			f += "Q" + string dirs[i].qid.path;
		name := dirs[i].name;
		isdir := dirs[i].mode & sys->DMDIR;
		if (isdir)
			name[len name]= '/';
		bgcol := bgnorm;
		# Sort this out later
		# if (path+"/"+name == selected[1].t0) {
		#	bgcol = bgselect;
		#	selected[1].t1 = f;
		#}
		tkcmd(b.top, "label "+f+" -text {"+name+"} -bg "+bgcol+ft);
		tkcmd(b.top, "bind "+f+" <Double-Button-1> {send "+b.tkchan+" double1pane1 "+f+"}");
		tkcmd(b.top, "bind "+f+" <Button-1> {send "+b.tkchan+" but1pane1 "+f+"}");
		tkcmd(b.top, "bind "+f+" <ButtonRelease-1> {send "+b.tkchan+" release}");
		tkcmd(b.top, "bind "+f+" <Button-3> {send "+b.tkchan+" but3pane1 "+f+" %X %Y}");
		tkcmd(b.top, "bind "+f+" <ButtonRelease-3> {send "+b.tkchan+" release}");
		tkcmd(b.top, "grid "+f+" -row "+string row+" -column "+string col+
					" -sticky w -padx 10 -pady 2");
		row++;
		if (row >= n) {
			row = 0;
			col++;
		}
		ni++;
	}

	dirs = nil;
	setbrowsescrollr(b);
}

pane0scr := array[] of {
	"frame .fbrowse",

	"scrollbar .fbrowse.sy1 -command {.fbrowse.c1 yview}",
	"scrollbar .fbrowse.sx1 -command {.fbrowse.c1 xview} -orient horizontal",
	"canvas .fbrowse.c1 -yscrollcommand {.fbrowse.sy1 set} -xscrollcommand {.fbrowse.sx1 set} -bg white -width 50 -height 20 -borderwidth 2 -relief sunken -xscrollincrement 10 -yscrollincrement 21",
	"grid .fbrowse.sy1 -row 2 -column 0 -sticky ns -rowspan 2",
	"grid .fbrowse.sx1 -row 3 -column 1 -sticky ew",
	"grid .fbrowse.c1 -row 2 -column 1 -sticky nsew",
	"grid rowconfigure .fbrowse 2 -weight 1",
	"grid columnconfigure .fbrowse 1 -weight 2",

};

pane1scr := array[] of {
#	".fbrowse.c1 configure -width 146",
	"frame .fbrowse.fl2 -bg white",
	"label .fbrowse.fl2.l -text {}",
	"scrollbar .fbrowse.sx2 -command {.fbrowse.c2 xview} -orient horizontal",
	"label .fbrowse.lmov -text { } -relief sunken -borderwidth 2 -width 5",

	"canvas .fbrowse.c2 -xscrollcommand {.fbrowse.sx2 set} -bg white -width 50 -height 20 -borderwidth 2 -relief sunken -xscrollincrement 10 -yscrollincrement 21",
	".fbrowse.c2 create window 0 0 -window .fbrowse.fl2 -anchor nw",
	"grid .fbrowse.sx2 -row 3 -column 3 -sticky ew",
	"grid .fbrowse.c2 -row 2 -column 3 -sticky nsew",
	"grid .fbrowse.lmov -row 2 -column 2 -rowspan 2 -sticky ns",
	"grid columnconfigure .fbrowse 3 -weight 3",
};

Browse.newroot(b: self ref Browse, root, rlabel: string)
{
	tk->cmd(b.top, "destroy .fbrowse.fl");
	tkcmd(b.top, "frame .fbrowse.fl -bg white");
	tkcmd(b.top, ".fbrowse.c1 create window 0 0 -window .fbrowse.fl -anchor nw");
	b.pane1 = File (root, nil);
	setroot(b, rlabel, root);
	setbrowsescrollr(b);
}

Browse.showpath(b: self ref Browse, on: int)
{
	if (on == b.showpathlabel)
		return;
	if (on) {
		b.showpathlabel = 1;
		if (b.pane1.path != nil)
			labelset(b, ".fbrowse.l", prevpath(b.pane1.path+"/"));
	}
	else {
		b.showpathlabel = 0;
		tkcmd(b.top, ".fbrowse.l configure -text {}");
	}
}

Browse.getselected(b: self ref Browse, pane: int): File
{
	return b.selected[pane].file;
}

labelset(b: ref Browse, label, text: string)
{
	if (!b.showpathlabel)
		return;
	if (text != nil) {
		tmp := b.rlabel;
		if (tmp[len tmp - 1] != '/')
			tmp[len tmp] = '/';
		text = tmp + text[len b.root:];
	}
	tkcmd(b.top, label + " configure -text {"+text+"}");
}

movdiv(b: ref Browse, x: int)
{
	x1 := int tkcmd(b.top, ".fbrowse.lmov cget -actx");
	x2 := x1 + int tkcmd(b.top, ".fbrowse.lmov cget -width");
	diff := 0;
	if (x < x1)
		diff = x - x1;
	if (x > x2)
		diff = x - x2;
	if (abs(diff) > 5) {
		w1 := int tkcmd(b.top, ".fbrowse.c1 cget -actwidth");
		w2 := int tkcmd(b.top, ".fbrowse.c2 cget -actwidth");
		if (w1 + diff < 36)
			diff = 36 - w1;
		if (w2 - diff < 36)
			diff = w2 - 36;
		w1 += diff;
		w2 -= diff;
		# sys->print("w1: %d w2: %d\n",w1,w2);
		tkcmd(b.top, "grid columnconfigure .fbrowse 1 -weight "+string w1);
		tkcmd(b.top, "grid columnconfigure .fbrowse 3 -weight "+string w2);
	}
}


dialog(ctxt: ref draw->Context, oldtop: ref Tk->Toplevel, butlist: list of string, title, msg: string): int
{
	(top, titlebar) := tkclient->toplevel(ctxt, "", title, tkclient->Popup);
	butchan := chan of string;
	tk->namechan(top, butchan, "butchan");
	tkcmd(top, "frame .f");
	tkcmd(top, "label .f.l -text {"+msg+"} -font /fonts/charon/plain.normal.font");
	tkcmd(top, "bind .Wm_t <Button-1> +{focus .}");
	tkcmd(top, "bind .Wm_t.title <Button-1> +{focus .}");

	l := len butlist;
	tkcmd(top, "grid .f.l -row 0 -column 0 -columnspan "+string l+" -sticky w -padx 10 -pady 5");
	i := 0;
	for(; butlist != nil; butlist = tl butlist) {
		si := string i;
		tkcmd(top, "button .f.b"+si+" -text {"+hd butlist+"} "+
			"-font /fonts/charon/plain.normal.font -command {send butchan "+si+"}");
		tkcmd(top, "grid .f.b"+si+" -row 1 -column "+si+" -padx 5 -pady 5");
		i++;
	}
	placement := "";
	if (oldtop != nil) {
		setcentre(oldtop, top);
		placement = "exact";
	}
	tkcmd(top, "pack .f; update; focus .");
	tkclient->onscreen(top, placement);
	tkclient->startinput(top, "kbd"::"ptr"::nil);
	for (;;) {
		alt {
		s := <-top.ctxt.kbd =>
			tk->keyboard(top, s);
		s := <-top.ctxt.ptr =>
			tk->pointer(top, *s);
		inp := <- butchan =>
			tkcmd(oldtop, "focus .");
			return int inp;
		title = <-top.ctxt.ctl or
		title = <-top.wreq or
		title = <-titlebar =>
			if (title == "exit") {
				tkcmd(oldtop, "focus .");
				return -1;
			}
			tkclient->wmctl(top, title);
		}
	}
}
######################## Select Functions #########################


setselectscrollr(s: ref Select, f: string)
{
	h := tkcmd(s.top, f+" cget -height");
	w := tkcmd(s.top, f+" cget -width");
	tkcmd(s.top, ".fselect.c configure -scrollregion {0 0 "+w+" "+h+"}");
}

Select.setscrollr(s: self ref Select, fname: string)
{
	frame := getframe(s, fname);
	if (frame != nil)
		setselectscrollr(s,frame.path);
}

Select.new(top: ref Tk->Toplevel, tkchanname: string): ref Select
{
	s: Select;
	s.top = top;
	s.tkchan = tkchanname;
	s.frames = nil;
	s.currfname = nil;
	s.currfid = nil;
	tkcmds(top, selectscr);
	if (entryheight == nil) {
		tkcmd(top, "entry .fselect.test");
		entryheight = " -height " + tkcmd(top, ".fselect.test cget -height");
		tkcmd(top, "destroy .fselect.test");
	}
	for (i := 1; i < 4; i++)
		tkcmd(top, "bind .fselect.c <ButtonRelease-"+string i+"> {send "+s.tkchan+" release}");
	return ref s;
}

selectscr := array[] of {
	"frame .fselect",
	"scrollbar .fselect.sy -command {.fselect.c yview}",
	"scrollbar .fselect.sx -command {.fselect.c xview} -orient horizontal",
	"canvas .fselect.c -yscrollcommand {.fselect.sy set} -xscrollcommand {.fselect.sx set} -bg white -width 414 -borderwidth 2 -relief sunken -height 180 -xscrollincrement 10 -yscrollincrement 19",

	"grid .fselect.sy -row 0 -column 0 -sticky ns -rowspan 2",
	"grid .fselect.sx -row 1 -column 1 -sticky ew",
	"grid .fselect.c -row 0 -column 1",
};

Select.addframe(s: self ref Select, fname, title: string)
{
	if (isat(fname, " ") != -1)
		return;
	f := ".fselect.f"+fname;
	tkcmd(s.top, "frame "+f+" -bg white");
	if (title != nil){
		tkcmd(s.top, "label "+f+".l -text {"+title+"} -bg white "+
			"-font /fonts/charon/bold.normal.font; "+
			"grid "+f+".l -row 0 -column 0 -columnspan 3 -sticky w");
	}
	fr: Frame;
	fr.name = fname;
	fr.path = f;
	fr.selected = nil;
	s.frames = ref fr :: s.frames;
}

getframe(s: ref Select, fname: string): ref Frame
{
	for (tmp := s.frames; tmp != nil; tmp = tl tmp)
		if ((hd tmp).name == fname)
			return hd tmp;
	return nil;
}

Select.delframe(s: self ref Select, fname: string)
{
	if (s.currfname == fname) {
		tkcmd(s.top, ".fselect.c delete " + s.currfid);
		s.currfid = nil;
		s.currfname = nil;
	}
	f := getframe(s,fname);
	if (f != nil) {
		tkcmd(s.top, "destroy "+f.path);
		tmp: list of ref Frame = nil;
		for (;s.frames != nil; s.frames = tl s.frames) {
			if ((hd s.frames).name != fname)
				tmp = hd s.frames :: tmp;
		}
		s.frames = tmp;
	}
}

Select.showframe(s: self ref Select, fname: string)
{
	if (s.currfid != nil)
		tkcmd(s.top, ".fselect.c delete " + s.currfid);
	f := getframe(s, fname);
	if (f != nil) {
		s.currfid = tkcmd(s.top, ".fselect.c create window 0 0 "+
				"-window "+f.path+" -anchor nw");
		s.currfname = fname;
	}
}

Select.addselection(s: self ref Select, fname, text: string, lp: list of ref Parameter, allowdups: int): string
{
	fr := getframe(s, fname);
	if (fr == nil)
		return nil;
	f := fr.path;
	if (!allowdups) {
		slv := tkcmd(s.top, "grid slaves "+f+" -column 0");
		(nil, slaves) := sys->tokenize(slv, " \t\n");
		for (; slaves != nil; slaves = tl slaves) {
			if (text == tkcmd(s.top, hd slaves+" cget -text"))
				return nil;
		}
	}
	font := " -font /fonts/charon/plain.normal.font";
	fontb := " -font /fonts/charon/bold.normal.font";
	(id, row) := newselected(s.top, f);
	sid := string id;
	label := f+".l"+sid;
	tkcmd(s.top, "label "+label+" -text {"+text+"} -bg white"+entryheight+font);
	gridpack := label+" ";
	paramno := 0;
	for (; lp != nil; lp = tl lp) {
		spn := string paramno;
		pframe := f+".f"+sid+"P"+spn;
		tkcmd(s.top, "frame "+pframe+" -bg white");
		pick p := hd lp {
		ArgIn =>
			tkp1 := pframe+".lA";
			tkp2 := pframe+".eA";

			tkcmd(s.top, "label "+tkp1+" -text {"+p.name+"} "+
					"-bg white "+entryheight+fontb);
			tkcmd(s.top, "entry "+tkp2+" -bg white -width 50 "+
					"-borderwidth 1"+entryheight+font);
			if (p.initval != nil)
				tkcmd(s.top, tkp2+" insert end {"+p.initval+"}");
			tkcmd(s.top, "grid "+tkp1+" "+tkp2+" -row 0");

		IntIn =>
			tkp1 := pframe+".sI";
			tkp2 := pframe+".lI";
			tkcmd(s.top, "scale "+tkp1+" -showvalue 0 -orient horizontal -height 20"+
				" -from "+string p.min+" -to "+string p.max+" -command {send "+
				s.tkchan+" scale "+tkp2+"}");
			tkcmd(s.top, tkp1+" set "+string p.initval);
			tkcmd(s.top, "label "+tkp2+" -text {"+string p.initval+"} "+
					"-bg white "+entryheight+fontb);
			tkcmd(s.top, "grid "+tkp1+" "+tkp2+" -row 0");

		}
		gridpack += " "+pframe;
		paramno++;
	}
	tkcmd(s.top, "grid "+gridpack+" -row "+row+" -sticky w");

	sendstr := " " + label + " %X %Y}";
	tkcmd(s.top, "bind "+label+" <Double-Button-1> {send "+s.tkchan+" double1"+sendstr);
	tkcmd(s.top, "bind "+label+" <Button-1> {send "+s.tkchan+" but1"+sendstr);
	tkcmd(s.top, "bind "+label+" <ButtonRelease-1> {send "+s.tkchan+" release}");
	tkcmd(s.top, "bind "+label+" <Button-2> {send "+s.tkchan+" but2"+sendstr);
	tkcmd(s.top, "bind "+label+" <ButtonRelease-2> {send "+s.tkchan+" release}");
	tkcmd(s.top, "bind "+label+" <Button-3> {send "+s.tkchan+" but3"+sendstr);
	tkcmd(s.top, "bind "+label+" <ButtonRelease-3> {send "+s.tkchan+" release}");
	setselectscrollr(s, f);
	if (s.currfname == fname) {
		y := int tkcmd(s.top, label+"  cget -acty") -
			int tkcmd(s.top, f+" cget -acty");
		h := int tkcmd(s.top, label+"  cget -height");
		tkcmd(s.top, ".fselect.c see 0 "+string (h+y));
	}
	return label;
}

newselected(top: ref Tk->Toplevel, frame: string): (int, string)
{
	(n, slaves) := sys->tokenize(tkcmd(top, "grid slaves "+frame+" -column 0"), " \t\n");
	id := 0;
	slaves = tl slaves; # Ignore Title
	for (;;) {
		if (isin(slaves, frame+".l"+string id))
			id++;
		else break;
	}
	return (id, string n);
}

isin(l: list of string, test: string): int
{
	for(tmpl := l; tmpl != nil; tmpl = tl tmpl)
		if (hd tmpl == test)
			return 1;
	return 0;
}

Select.delselection(s: self ref Select, fname, tkpath: string)
{
	f := getframe(s, fname);
	(row, nil) := getrowcol(s.top, tkpath);
	slaves := tkcmd(s.top, "grid slaves "+f.path+" -row "+row);
	# sys->print("row %s: deleting: %s\n",row,slaves);
	tkcmd(s.top, "grid rowdelete "+f.path+" "+row);
	tkcmd(s.top, "destroy "+slaves);
	# Select the next one if the item deleted was selected
	if (f.selected == tkpath) {
		f.selected = nil;
		for (;;) {
			slaves = tkcmd(s.top, "grid slaves "+f.path+" -row "+row);
			if (slaves != nil)
				break;
			r := (int row) - 1;
			if (r < 1)
				return;
			row = string r;
		}
		(nil, lst) := sys->tokenize(slaves, " ");
		if (lst != nil)
			s.select(fname, hd lst, SELECT);
	}
}

getrowcol(top: ref Tk->Toplevel, s: string): (string, string)
{
	row := "";
	col := "";
	(nil, lst) := sys->tokenize(tkcmd(top, "grid info "+s), " \t\n");
	for (; lst != nil; lst = tl lst) {
		if (hd lst == "-row")
			row = hd tl lst;
		else if (hd lst == "-column")
			col = hd tl lst;
	}
	return (row, col);
}

Select.select(s: self ref Select, fname, tkpath: string, action: int)
{
	f := getframe(s, fname);
	if (action == SELECT && f.selected == tkpath)
		return;
	if (f.selected != nil)
		tkcmd(s.top, f.selected+" configure -bg "+bgnorm);
	if ((action == TOGGLE && f.selected == tkpath) || action == DESELECT)
		f.selected = nil;
	else {
		tkcmd(s.top, tkpath+" configure -bg "+bgselect);
		f.selected = tkpath;
	}
}

Select.defaultaction(s: self ref Select, lst: list of string)
{
	case hd lst {
		"but1" =>
			s.select(s.currfname, hd tl lst, TOGGLE);
		"scale" =>
			tkcmd(s.top, hd tl lst+" configure -text {"+hd tl tl lst+"}");
	}
}

Select.getselected(s: self ref Select, fname: string): string
{
	f := getframe(s, fname);
	return f.selected;
}

Select.getselection(s: self ref Select, fname: string): list of (string, list of ref Parameter)
{
	retlist : list of (string, list of ref Parameter) = nil;
	row := 1;
	f := getframe(s, fname);
	for (;;) {
		slaves := tkcmd(s.top, "grid slaves "+f.path+" -row "+string (row++));
		# sys->print("slaves: %s\n",slaves);
		if (slaves == nil || slaves[0] == '!')
			break;
		(nil, lst) := sys->tokenize(slaves, " ");
		tkpath := hd lst;
		lst = tl lst;
		lp : list of ref Parameter = nil;
		for (; lst != nil; lst = tl lst) {
			pslaves := tkcmd(s.top, "grid slaves "+hd lst);
			(nil, plist) := sys->tokenize(pslaves, " ");
			# sys->print("slaves of %s - hd plist: '%s'\n",hd lst, hd plist);
			case (hd plist)[len hd plist - 3:] {
				".eA" or ".lA" =>
					argname := tkcmd(s.top, hd lst+".lA cget -text");
					argval := tkcmd(s.top, hd lst+".eA get");
					lp = ref Parameter.ArgOut(argname, argval) :: lp;
				".sI" or ".lI" =>
					val := int tkcmd(s.top, hd lst+".lI cget -text");
					lp = ref Parameter.IntOut(val) :: lp;
			}
		}
		retlist = (tkpath, lp) :: retlist;
	}
	return retlist;
}

Select.resize(s: self ref Select, width, height: int)
{
	ws := int tkcmd(s.top, ".fselect.sy cget -width");
	hs := int tkcmd(s.top, ".fselect.sx cget -height");

	tkcmd(s.top, ".fselect.c configure -width "+string (width - ws - 8)+
			" -height "+string (height - hs - 8));
	f := getframe(s, s.currfname);
	if (f != nil)
		setselectscrollr(s, f.path);

	tkcmd(s.top, "update");
}

File.eq(a,b: File): int
{
	if (a.path != b.path || a.qid != b.qid)
		return 0;
	return 1;
}


######################## General Functions ########################

setcentre(top1, top2: ref Tk->Toplevel)
{
	x1 := int tkcmd(top1, ". cget -actx");
	y1 := int tkcmd(top1, ". cget -acty");
	h1 := int tkcmd(top1, ". cget -height");
	w1 := int tkcmd(top1, ". cget -width");

	h2 := int tkcmd(top2, ".f cget -height");
	w2 := int tkcmd(top2, ".f cget -width");

	newx := (x1 + (w1 / 2)) - (w2/2);
	newy := (y1 + (h1 / 2)) - (h2/2);
	tkcmd(top2, ". configure -x "+string newx+" -y "+string newy);
}

abs(x: int): int
{
	if (x < 0)
		return -x;
	return x;
}

prevpath(path: string): string
{
	if (path == nil)
		return nil;
	p := isatback(path[:len path - 1], "/");
	if (p == -1)
		return nil;
	return path[:p+1];
}

isat(s, test: string): int
{
	if (len test > len s)
		return -1;
	for (i := 0; i < (1 + len s - len test); i++)
		if (test == s[i:i+len test])
			return i;
	return -1;
}

isatback(s, test: string): int
{
	if (len test > len s)
		return -1;
	for (i := len s - len test; i >= 0; i--)
		if (test == s[i:i+len test])
			return i;
	return -1;
}

tkcmd(top: ref Tk->Toplevel, cmd: string): string
{
	e := tk->cmd(top, cmd);
	if (e != "" && e[0] == '!')
		sys->print("Tk error: '%s': %s\n",cmd,e);
	return e;
}

tkcmds(top: ref Tk->Toplevel, a: array of string)
{
	for (j := 0; j < len a; j++)
		tkcmd(top, a[j]);
}

badmod(path: string)
{
	sys->print("Browser: failed to load: %s\n",path);
	exit;
}