implement Calendar;

#
# Copyright © 2000 Vita Nuova Limited. All rights reserved.
#

include "sys.m";
	sys: Sys;
include "draw.m";
	draw: Draw;
	Font, Point, Rect: import draw;
include "daytime.m";
	daytime: Daytime;
	Tm: import Daytime;
include "tk.m";
	tk: Tk;
include "tkclient.m";
	tkclient: Tkclient;
include "dialog.m";
	dialog: Dialog;
include "readdir.m";
include "translate.m";
	translate: Translate;
	Dict: import translate;
include "arg.m";
	arg: Arg;
include "sh.m";

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

Cal: adt {
	w: string;
	dx, dy: int;
	onepos: int;
	top: ref Tk->Toplevel;
	sched: ref Schedule;
	date: int;
	marked: array of int;
	make: fn(top: ref Tk->Toplevel, sched: ref Schedule, w: string): (ref Cal, chan of string);
	show: fn(cal: self ref Cal, date: int);
	mark: fn(cal: self ref Cal, ent: Entry);
};

Entry: adt {
	date: int;		# YYYYMMDD
	mark: int;
};

Sentry: adt {
	ent: Entry;
	file: int;
};

Schedule: adt {
	dir: string;
	entries: array of Sentry;
	new: fn(dir: string): (ref Schedule, string);
	getentry: fn(sched: self ref Schedule, date: int): (int, Entry);
	readentry: fn(sched: self ref Schedule, date: int): (Entry, string);
	setentry: fn(sched: self ref Schedule, ent: Entry, data: string): (int, string);
};

Markset: adt {
	new: fn(top: ref Tk->Toplevel, cal: ref Cal, w: string): (ref Markset, chan of string);
	set: fn(m: self ref Markset, kind: int);
	get: fn(m: self ref Markset): int;
	ctl: fn(m: self ref Markset, c: string);

	top: ref Tk->Toplevel;
	cal: ref Cal;
	w: string;
	curr: int;
};

DBFSPATH: con "/dis/rawdbfs.dis";
SCHEDDIR: con "/mnt/schedule";

stderr: ref Sys->FD;
dict: ref Dict;
font := "/fonts/lucidasans/unicode.7.font";
days, months: array of string;

packcmds := array[] of {
"pack .ctf.show .ctf.set .ctf.date -side right",
"pack .ctf -side top -fill x",

"pack .cf.head.fwd .cf.head.bwd .cf.head.date -side right",
"pack .cf.head -side top -fill x",
"pack .cf.cal -side top",
"pack .cf -side top",

"pack .schedf.head.fwd .schedf.head.bwd .schedf.head.date .schedf.head.markset"
	+ " .schedf.head.save .schedf.head.del -side right",
"pack .schedf.head -side top -fill x",
"pack .schedf.tf.scroll -side left -fill y",
"pack .schedf.tf.t -side top -fill both -expand 1",
"pack .schedf.tf -side top -fill both -expand 1",
"pack .schedf -side top -fill both -expand 1",
};

Savebut: con ".schedf.head.save";
Delbut: con ".schedf.head.del";

usage()
{
	sys->fprint(stderr, "usage: calendar [-f font] [/mnt/schedule | schedfile]\n");
	raise "fail:usage";
}

init(ctxt: ref Draw->Context, argv: list of string)
{
	loadmods();
	if (ctxt == nil) {
		sys->fprint(sys->fildes(2), "calendar: no window context\n");
		raise "fail:bad context";
	}
	days = Xa(array[] of {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri",  "Sat"});
	months = Xa(array[] of {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"});
	arg->init(argv);
	while ((opt := arg->opt()) != 0) {
		case opt {
		'f' =>
			if ((font = arg->arg()) == nil)
				usage();
		* =>
			usage();
		}
	}
	argv = arg->argv();
	scheddir := SCHEDDIR;
	if (argv != nil)
		scheddir = hd argv;
	(top, wmctl) := tkclient->toplevel(ctxt, "", X("Calendar"), Tkclient->Appl);
	if (top == nil) {
		sys->fprint(stderr, "cal: cannot make window: %r\n");
		raise "fail:cannot make window";
	}
	(sched, err) := Schedule.new(scheddir);
	if (sched == nil)
		sys->fprint(stderr, "cal: cannot load schedule: %s\n", err);
	currtime := daytime->local(daytime->now());
	if (currtime == nil) {
		sys->fprint(stderr, "cannot get local time: %r\n");
		raise "fail:failed to get local time";
	}
	date := tm2date(currtime);
	sys->pctl(Sys->NEWPGRP|Sys->FORKNS, nil);

	cmdch := chan of string;
	tk->namechan(top, cmdch, "cmd");
	wincmds := array[] of {
	"frame .ctf",
	"button .ctf.set -text {"+X("Set")+"} -command {send cmd settime}",
	"button .ctf.show -text {"+X("Show")+"} -command {send cmd showtime}",
	
	"frame .cf -bd 2 -relief raised",
	"frame .cf.head",
	"button .cf.head.bwd -text {<<} -command {send cmd bwdmonth}",
	"button .cf.head.fwd -text {>>} -command {send cmd fwdmonth}",
	"label .cf.head.date -text {XXX 0000}",
	
	"frame .schedf -bd 2 -relief raised",
	"frame .schedf.head",
	"button .schedf.head.save -text {"+X("Save")+"} -command {send cmd save}",
	"button .schedf.head.del -text {"+X("Del")+"} -command {send cmd del}",
	"label .schedf.head.date -text {0000/00/00}",
	"canvas .schedf.head.markset",
	"button .schedf.head.bwd -text {<<} -command {send cmd bwdday}",
	"button .schedf.head.fwd -text {>>} -command {send cmd fwdday}",
	"frame .schedf.tf",
	"scrollbar .schedf.tf.scroll -command {.schedf.tf.t yview}",
	"text .schedf.tf.t -wrap word -yscrollcommand {.schedf.tf.scroll set} -height 7h -width 20w",
	"bind .schedf.tf.t <Key> +{send cmd dirty}",
	};
	tkcmds(top, wincmds);
	(cal, calch) := Cal.make(top, sched, ".cf.cal");
	sync := chan of int;
	spawn clock(top, ".ctf.date", sync);
	clockpid := <-sync;
	(ms, msch) := Markset.new(top, cal, ".schedf.head.markset");
	tkcmds(top, packcmds);
	if (sched == nil)
		cmd(top, "pack forget .schedf");

	showdate(top, cal, ms, date);
	cmd(top, "pack propagate . 0");
	cmd(top, "update");
	if (date < 19700002)
		raisesettime(ctxt, top);

	setting := 0;
	dirty := 0;
	empty := scheduleempty(top);
	currsched := 0;

	tkclient->onscreen(top, nil);
	tkclient->startinput(top, "kbd"::"ptr"::nil);

	for (;;) {
		enable(top, Savebut, dirty);
		enable(top, Delbut, !empty);
		cmd(top, "update");
		ndate := date;
		alt {
		c := <-calch =>
			(y,m,d) := date2ymd(date);
			d = int c;
			ndate = ymd2date(y,m,d);
		c := <-msch =>
			ms.ctl(c);
			cal.mark(Entry(date, ms.get()));
			dirty = 1;
		c := <-cmdch =>
			case c {
			"dirty" =>
				dirty = 1;
				nowempty := scheduleempty(top);
				if (nowempty != empty) {
					if (nowempty) {
						ms.set(0);
						cal.mark(Entry(date, 0));
					} else {
						ms.set(1);
						cal.mark(Entry(date, ms.get()));
					}
					empty = nowempty;
				}
			"bwdmonth" =>
				ndate = decmonth(date);
			"fwdmonth" =>
				ndate = incmonth(date);
			"bwdday" =>
				ndate = adddays(date, -1);
			"fwdday" =>
				ndate = adddays(date, 1);
			"del" =>
				if (!empty) {
					cmd(top, ".schedf.tf.t delete 1.0 end");
					empty = 1;
					dirty = 1;
					cal.mark(Entry(date, 0));
				}
			"save" =>
				if (dirty && save(ctxt, top, cal, ms, date) != -1)
					dirty = 0;
			"settime" =>
				raisesettime(ctxt, top);
			"showtime" =>
				ndate = tm2date(daytime->local(daytime->now()));
			* =>
				sys->fprint(stderr, "cal: unknown command '%s'\n", c);
			}
		s := <-top.ctxt.kbd =>
			tk->keyboard(top, s);
		s := <-top.ctxt.ptr =>
			tk->pointer(top, *s);
		c := <-top.ctxt.ctl or
		c = <-top.wreq or
		c = <-wmctl =>
			if (c == "exit" && dirty)
				save(ctxt, top, cal, ms, date);
			tkclient->wmctl(top, c);
		}
		if (ndate != date) {
			e := 0;
			if (dirty)
				e = save(ctxt, top, cal, ms, date);
			if (e != -1) {
				dirty = 0;
				showdate(top, cal, ms, ndate);
				empty = scheduleempty(top);
				date = ndate;
				cmd(top, "update");
			}
		}
	}
}

Markset.new(top: ref Tk->Toplevel, cal: ref Cal, w: string): (ref Markset, chan of string)
{
	cmd(top, w+" configure -width "+string (cal.dx * 2 + 6) +
				" -height "+string (cal.dy + 4));
	ch := chan of string;
	tk->namechan(top, ch, "markcmd");
	return (ref Markset(top, cal, w, 0), ch);
}

Markset.set(m: self ref Markset, kind: int)
{
	cmd(m.top, m.w + " delete x");
	if (kind > 0) {
		(shape, col) := kind2shapecol(kind);
		id := cmd(m.top, m.w + " create " +
			shapestr(m.cal, (m.cal.dx/2+2, m.cal.dy/2+2), Square) +
			" -fill " + colours[col] + " -tags x");
		cmd(m.top, m.w + " bind " + id + " <ButtonRelease-1> {send markcmd col}");
		id = cmd(m.top, m.w + " create " +
			shapestr(m.cal, (m.cal.dx * 3 / 2+4, m.cal.dy/2+2), shape) +
			" -tags x -width 2");
		cmd(m.top, m.w + " bind " + id + " <ButtonRelease-1> {send markcmd shape}");
	}
	m.curr = kind;
}

Markset.get(m: self ref Markset): int
{
	return m.curr;
}

Markset.ctl(m: self ref Markset, c: string)
{
	(shape, col) := kind2shapecol(m.curr);
	case c {
	"col" => col = (col + 1) % len colours;
	"shape" => shape = (shape + 1) % Numshapes;
	}
	m.set(shapecol2kind((shape, col)));
}

scheduleempty(top: ref Tk->Toplevel): int
{
	return int cmd(top, ".schedf.tf.t compare 1.0 == end");
}

enable(top: ref Tk->Toplevel, but: string, enable: int)
{
	cmd(top, but + " configure -state " +
		(array[] of {"disabled", "normal"})[!!enable]);
}

save(ctxt: ref Draw->Context, top: ref Tk->Toplevel, cal: ref Cal, ms: ref Markset, date: int): int
{
	s := cmd(top, ".schedf.tf.t get 1.0 end");
	empty := scheduleempty(top);
	mark := ms.get();
	if (empty)
		mark = 0;
	ent := Entry(date, mark);
	cal.mark(ent);
	(ok, err) := cal.sched.setentry(ent, s);
	if (ok == -1) {
		notice(ctxt, top, "Cannot save entry: " + err);
		return -1;
	}
	return 0;
}

notice(ctxt: ref Draw->Context, top: ref Tk->Toplevel, s: string)
{
	dialog->prompt(ctxt, top.image, nil, "Notice", s, 0, "OK"::nil);
}

showdate(top: ref Tk->Toplevel, cal: ref Cal, ms: ref Markset, date: int)
{
	(y,m,d) := date2ymd(date);
 	cal.show(date);
	cmd(top, ".cf.head.date configure -text {" + sys->sprint("%.4d/%.2d", y, m+1) + "}");
	cmd(top, ".schedf.head.date configure -text {" + sys->sprint("%.4d/%.2d/%.2d", y, m+1, d) + "}");
	(ent, s) := cal.sched.readentry(date);
	ms.set(ent.mark);
	cmd(top, ".schedf.tf.t delete 1.0 end; .schedf.tf.t insert 1.0 '" + s);
}

nomod(s: string)
{
	sys->fprint(stderr, "cal: cannot load %s: %r\n", s);
	raise "fail:bad module";
}

loadmods()
{
	sys = load Sys Sys->PATH;
	stderr = sys->fildes(2);
	draw = load Draw Draw->PATH;
	tk = load Tk Tk->PATH;
	daytime = load Daytime Daytime->PATH;
	if (daytime == nil)
		nomod(Daytime->PATH);
	tkclient = load Tkclient Tkclient->PATH;
	if (tkclient == nil)
		nomod(Tkclient->PATH);
	translate = load Translate Translate->PATH;
	if(translate != nil){
		translate->init();
		(dict, nil) = translate->opendict(translate->mkdictname("", "calendar"));
	}
	tkclient->init();
	arg = load Arg Arg->PATH;
	if (arg == nil)
		nomod(Arg->PATH);
	dialog = load Dialog Dialog->PATH;
	if(dialog == nil)
		nomod(Dialog->PATH);
	dialog->init();
}

s2a(s: string, min, max: int, sep: string): array of int
{
	(ntoks, toks) := sys->tokenize(s, sep);
	if (ntoks < min || ntoks > max)
		return nil;
	a := array[max] of int;
	for (i := 0; toks != nil; toks = tl toks) {
		if (!isnum(hd toks))
			return nil;
		a[i++] = int hd toks;
	}
	return a[0:i];
}

validtm(t: ref Daytime->Tm): int
{
	if (t.hour < 0 || t.hour > 23
			|| t.min < 0 || t.min > 59
			|| t.sec < 0 || t.sec > 59
			|| t.mday < 1 || t.mday > 31
			|| t.mon < 0 || t.mon > 11
			|| t.year < 70 || t.year > 137)
		return 0;
	if (t.mon == 1 && dysize(t.year+1900) > 365)
		return t.mday <= 29;
	return t.mday <= dmsize[t.mon];
}

clock(top: ref Tk->Toplevel, w: string, sync: chan of int)
{
	cmd(top, "label " + w);	
	fd := sys->open("/dev/time", Sys->OREAD);
	if (fd == nil) {
		sync <-= -1;
		return;
	}
	buf := array[128] of byte;
	for (;;) {
		sys->seek(fd, big 0, Sys->SEEKSTART);
		n := sys->read(fd, buf, len buf);
		if (n < 0) {
			sys->fprint(stderr, "cal: could not read time: %r\n");
			if (sync != nil)
				sync <-= -1;
			break;
		}
		ms := big string buf[0:n] / big 1000;
		ct := ms / big 1000;
		t := daytime->local(int ct);

		s := sys->sprint("%s %s %d %.2d:%.2d.%.2d",
			days[t.wday], months[t.mon], t.mday, t.hour, t.min, t.sec);
		cmd(top, w + " configure -text {" + s + "}");
		cmd(top, "update");
		if (sync != nil) {
			sync <-= sys->pctl(0, nil);
			sync = nil;
		}
		sys->sleep(int ((ct + big 1) * big 1000 - ms));
	}
}

# "the world is the lord's and all it contains,
# save the highlands and islands, which belong to macbraynes"
Cal.make(top: ref Tk->Toplevel, sched: ref Schedule, w: string): (ref Cal, chan of string)
{
	f := Font.open(top.display, font);
	if (f == nil) {
		sys->fprint(stderr, "cal: could not open font %s: %r\n", font);
		font = cmd(top, ". cget -font");
		f = Font.open(top.display, font);
	}
	if (f == nil)
		return (nil, nil);
	maxw := 0;
	for (i := 0; i < 7; i++) {
		if ((dw := f.width(days[i] + " ")) > maxw)
			maxw = dw;
	}
	for (i = 10; i < 32; i++) {
		if ((dw := f.width(string i + " ")) > maxw)
			maxw = dw;
	}
	cal := ref Cal;
	cal.w = w;
	cal.dx = maxw;
	cal.dy = f.height;
	cal.onepos = 0;
	cal.top = top;
	cal.sched = sched;
	cal.marked = array[31] of {* => 0};
	cmd(top, "canvas " + w + " -width " + string (cal.dx * 7) + " -height " + string (cal.dy * 7));
	for (i = 0; i < 7; i++)
		cmd(top, w + " create text " + posstr(daypos(cal, i, 0))
				+ " -text " + days[i] + " -font " + font);
	ch := chan of string;
	tk->namechan(top, ch, "ch" + w);
	return (cal, ch);
}

Cal.show(cal: self ref Cal, date: int)
{
	if (date == cal.date)
		return;
	mon := (date / 100) % 100;
	year := date / 10000;
	cmd(cal.top, cal.w + " delete curr");
	if (cal.date / 100 != date / 100) {
		cmd(cal.top, cal.w + " delete date");
		cmd(cal.top, cal.w + " delete mark");
		for (i := 0; i < len cal.marked; i++)
			cal.marked[i] = 0;
		(md, wd) := monthinfo(mon, year);
		base := year * 10000 + mon * 100;
		cal.onepos = wd;
		for (i = 0; i < 6; i++) {
			for (j := 0; j < 7; j++) {
				d := i * 7 + j - wd;
				if (d >= 0 && d < md) {
					id := cmd(cal.top, cal.w + " create text " + posstr(daypos(cal, j, i+1))
						+ " -tags date -text " + string (d+1)
						+ " -font " + font);
					cmd(cal.top, cal.w + " bind " + id +
						" <ButtonRelease-1> {send ch" + cal.w + " " + string (d+1) + "}");
					(ok, ent) := cal.sched.getentry(base + d + 1);
					if (ok != -1)
						cal.mark(ent);
				}
			}
		}
	}
	if (cal.sched != nil) {
		e := date % 100 - 1 + cal.onepos;
		p := daypos(cal, e % 7, e / 7 + 1);
		cmd(cal.top, cal.w + " create " + shapestr(cal, p, Square) +
				" -tags curr -width 3");
	}
	cal.date = date;
}

Cal.mark(cal: self ref Cal, ent: Entry)
{
	if (ent.date / 100 != ent.date / 100)
		return;
	(nil, nil, d) := date2ymd(ent.date);
	d--;
	cmd(cal.top, cal.w + " delete m" + string d);
	if (ent.mark) {
		e := d + cal.onepos;
		p := daypos(cal, e % 7, e / 7 + 1);
		id := cmd(cal.top, cal.w + " create " + itemshape(cal, p, ent.mark) +
				" -tags {mark m"+string d + "}");
		cmd(cal.top, cal.w + " bind " + id +
				" <ButtonRelease-1> {send ch" + cal.w + " " + string (d+1) + "}");
		cmd(cal.top, cal.w + " lower " + id);
	}
	cal.marked[d] = ent.mark;
}

Oval, Diamond, Square, Numshapes: con iota;

colours := array[] of {
	"red",
	"yellow",
	"#00eeee",
	"white"
};

kind2shapecol(kind: int): (int, int)
{
	kind = (kind - 1) & 16rffff;
	return ((kind & 16rff) % Numshapes, (kind >> 8) % len colours);
}

shapecol2kind(shapecol: (int, int)): int
{
	(shape, colour) := shapecol;
	return (shape + (colour << 8)) + 1;
}

itemshape(cal: ref Cal, centre: Point, kind: int): string
{
	(shape, colour) := kind2shapecol(kind);
	return shapestr(cal, centre, shape) + " -fill " + colours[colour];
}

shapestr(cal: ref Cal, p: Point, kind: int): string
{
	(hdx, hdy) := (cal.dx / 2, cal.dy / 2);
	case kind {
	Oval =>
		r := Rect((p.x - hdx, p.y - hdy), (p.x + hdx, p.y + hdy));
		return "oval " + rectstr(r);
	Diamond =>
		return "polygon " + string (p.x - hdx) + " " + string p.y + " " +
					string p.x + " " + string (p.y - hdy) + " " +
					string (p.x + hdx) + " " + string p.y + " " +
					string p.x + " " + string (p.y + hdy) +
				" -outline black";
	Square =>
		r := Rect((p.x - hdx, p.y - hdy), (p.x + hdx, p.y + hdy));
		return "rectangle " + rectstr(r);
	* =>
		sys->fprint(stderr, "cal: unknown shape %d\n", kind);
		return nil;
	}
}
		
rectstr(r: Rect): string
{
	return string r.min.x + " " + string r.min.y + " " +
			string r.max.x + " " + string r.max.y;
}

posstr(p: Point): string
{
	return string p.x + " " + string p.y;
}

# return centre point of position for day.
daypos(cal: ref Cal, d, w: int): Point
{
	return Point(d * cal.dx + cal.dx / 2, w * cal.dy + cal.dy / 2);
}

body2entry(body: string): (int, Entry, string)
{
	for (i := 0; i < len body; i++)
		if (body[i] == '\n')
			break;
	if (i == len body)
		return (-1, (-1, -1), "invalid schedule header (no newline)");
	(n, toks) := sys->tokenize(body[0:i], " \t\n");
	if (n < 2)
		return (-1, (-1, -1), "invalid schedule header (too few fields)");
	date := int hd toks;
	(y, m, d) := (date / 10000, (date / 100) % 100, date%100);
	if (y < 1970 || y > 2037 || m > 12 || m < 1 || d > 31 || d < 1)
		return (-1, (-1,-1), sys->sprint("invalid date (%.8d) in schedule header", date));
	e := Entry(ymd2date(y, m-1, d), int hd tl toks);
	return (0, e, body[i+1:]);
}

startdbfs(f: string): (string, string)
{
	dbfs := load Command DBFSPATH;
	if (dbfs == nil)
		return (nil, sys->sprint("cannot load %s: %r", DBFSPATH));
	sync := chan of string;
	spawn rundbfs(sync, dbfs, f, SCHEDDIR);
	e := <-sync;
	if (e != nil)
		return (nil, e);
	return (SCHEDDIR, nil);
}

rundbfs(sync: chan of string, dbfs: Command, f, d: string)
{
	sys->pctl(Sys->FORKFD, nil);
	{
		dbfs->init(nil, "dbfs" :: "-r" :: f :: d :: nil);
		sync <-= nil;
	}exception e{
	"fail:*" =>
		sync <-= "dbfs failed: " + e[5:];
		exit;
	}
}

Schedule.new(d: string): (ref Schedule, string)
{
	(rc, info) := sys->stat(d);
	if (rc == -1)
		return (nil, sys->sprint("cannot find %s: %r", d));
	if ((info.mode & Sys->DMDIR) == 0) {
		err: string;
		(d, err) = startdbfs(d);
		if (d == nil)
			return (nil, err);
	}
	(rc, nil) = sys->stat(d + "/new");
	if (rc == -1)
		return (nil, "no dbfs mounted on " + d);
		
	readdir := load Readdir Readdir->PATH;
	if (readdir == nil)
		return (nil, sys->sprint("cannot load %s: %r", Readdir->PATH));
	sched := ref Schedule;
	sched.dir = d;
	(de, nil) := readdir->init(d, Readdir->NONE);
	if (de == nil)
		return (nil, "could not read schedule directory");
	buf := array[Sys->ATOMICIO] of byte;
	sched.entries = array[len de] of Sentry;
	ne := 0;
	for (i := 0; i < len de; i++) {
		if (!isnum(de[i].name))
			continue;
		f := d + "/" + de[i].name;
		fd := sys->open(f, Sys->OREAD);
		if (fd == nil) {
			sys->fprint(stderr, "cal: cannot open %s: %r\n", f);
		} else {
			n := sys->read(fd, buf, len buf);
			if (n == -1) {
				sys->fprint(stderr, "cal: error reading %s: %r\n", f);
			} else {
				(ok, e, err) := body2entry(string buf[0:n]);
				if (ok == -1)
					sys->fprint(stderr, "cal: error on entry %s: %s\n", f, err);
				else
					sched.entries[ne++] = (e, int de[i].name);
				err = nil;
			}
		}
	}
	sched.entries = sched.entries[0:ne];
	sortentries(sched.entries);
	return (sched, nil);
}

Schedule.getentry(sched: self ref Schedule, date: int): (int, Entry)
{
	if (sched == nil)
		return (-1, (-1, -1));
	ent := search(sched, date);
	if (ent == -1)
		return (-1, (-1,-1));
	return (0, sched.entries[ent].ent);
}

Schedule.readentry(sched: self ref Schedule, date: int): (Entry, string)
{
	if (sched == nil)
		return ((-1, -1), nil);
	ent := search(sched, date);
	if (ent == -1)
		return ((-1, -1), nil);
	(nil, fno) := sched.entries[ent];

	f := sched.dir + "/" + string fno;
	fd := sys->open(f, Sys->OREAD);
	if (fd == nil) {
		sys->fprint(stderr, "cal: cannot open %s: %r", f);
		return ((-1, -1), nil);
	}
	buf := array[Sys->ATOMICIO] of byte;
	n := sys->read(fd, buf, len buf);
	if (n == -1) {
		sys->fprint(stderr, "cal: cannot read %s: %r", f);
		return ((-1, -1), nil);
	}
	(ok, e, body) := body2entry(string buf[0:n]);
	if (ok == -1) {
		sys->fprint(stderr, "cal: couldn't get body in file %s: %s\n", f, body);
		return ((-1, -1), nil);
	}
	return (e, body);
}	

writeentry(fd: ref Sys->FD, ent: Entry, data: string): (int, string)
{
	ent.date += 100;
	b := array of byte (sys->sprint("%d %d\n", ent.date, ent.mark) + data);
	if (len b > Sys->ATOMICIO)
		return (-1, "entry is too long");
	if (sys->write(fd, b, len b) != len b)
		return (-1, sys->sprint("cannot write entry: %r"));
	return (0, nil);
}
	
Schedule.setentry(sched: self ref Schedule, ent: Entry, data: string): (int, string)
{
	if (sched == nil)
		return (-1, "no schedule");
	idx := search(sched, ent.date);
	if (idx == -1) {
		if (data == nil)
			return (0, nil);
		fd := sys->open(sched.dir + "/new", Sys->OWRITE);
		if (fd == nil)
			return (-1, sys->sprint("cannot open new: %r"));
		(ok, info) := sys->fstat(fd);
		if (ok == -1)
			return (-1, sys->sprint("cannot stat new: %r"));
		if (!isnum(info.name))
			return (-1, "new dbfs entry is not numeric");
		err: string;
		(ok, err) = writeentry(fd, ent, data);
		if (ok == -1)
			return (ok, err);
		(fd, data) = (nil, nil);
		e := sched.entries;
		for (i := 0; i < len e; i++)
			if (ent.date < e[i].ent.date)
				break;
		ne := array[len e + 1] of Sentry;
		(ne[0:],  ne[i], ne[i+1:]) = (e[0:i], (ent, int info.name), e[i:]);
		sched.entries = ne;
		return (0, nil);
	} else {
		fno := sched.entries[idx].file;
		f := sched.dir + "/" + string fno;
		if (data == nil) {
			sys->remove(f);
			sched.entries[idx:] = sched.entries[idx+1:];
			sched.entries = sched.entries[0:len sched.entries - 1];
			return (0, nil);
		} else {
			sched.entries[idx] = (ent, fno);
			fd := sys->open(f, Sys->OWRITE);
			if (fd == nil)
				return (-1, sys->sprint("cannot open %s: %r", sched.dir + "/" + string fno));
			return writeentry(fd, ent, data);
		}
	}
}

search(sched: ref Schedule, date: int): int
{
	e := sched.entries;
	lo := 0;
	hi := len e - 1;
	while (lo <= hi) {
		mid := (lo + hi) / 2;
		if (date < e[mid].ent.date)
			hi = mid - 1;
		else if (date > e[mid].ent.date)
			lo = mid + 1;
		else
			return mid;
	}
	return -1;
}

sortentries(a: array of Sentry)
{
	m: int;
	n := len a;
	for(m = n; m > 1; ) {
		if(m < 5)
			m = 1;
		else
			m = (5*m-1)/11;
		for(i := n-m-1; i >= 0; i--) {
			tmp := a[i];
			for(j := i+m; j <= n-1 && tmp.ent.date > a[j].ent.date; j += m)
				a[j-m] = a[j];
			a[j-m] = tmp;
		}
	}
}

raisesettime(ctxt: ref Draw->Context, top: ref Tk->Toplevel)
{
	panelcmds := array[] of {
	"frame .d",
	"label .d.title -text {"+X("Date (YYYY/MM/DD):")+"}",
	"entry .d.de -width 11w}",
	"frame .t",
	"label .t.title -text {"+X("Time (HH:MM.SS):")+"}",
	"entry .t.te -width 11w}",
	"frame .b",
	"button .b.set -text Set -command {send cmd set}",
	"button .b.cancel -text Cancel -command {send cmd cancel}",
	"pack .d .t .b -side top -fill x",
	"pack .d.de .d.title -side right",
	"pack .t.te .t.title -side right",
	"pack .b.set .b.cancel -side right",
	};
	fd := sys->open("/dev/time", Sys->OWRITE);
	if (fd == nil) {
		notice(ctxt, top, X("Cannot set time: ") + sys->sprint("%r"));
		return;
	}
	(panel, wmctl) := tkclient->toplevel(ctxt, "",	X("Set Time"), 0);
	tkcmds(panel, panelcmds);
	cmdch := chan of string;
	tk->namechan(panel, cmdch, "cmd");
	t := daytime->local(daytime->now());
	if (t.year < 71)
		(t.year, t.mon, t.mday) = (100, 0, 1);
	cmd(panel, ".d.de insert 0 " + sys->sprint("%.4d/%.2d/%.2d",
				t.year+1900, t.mon+1, t.mday));
	cmd(panel, ".t.te insert 0 " + sys->sprint("%.2d:%.2d.%.2d", t.hour, t.min, t.sec));
	#cmd(panel, "grab set ."); XXX should, but not a good idea with global tk.
	# wouldn't work with current dialog->prompt() either...
	cmd(panel, "update");
	tkclient->onscreen(panel, nil);
	tkclient->startinput(panel, "kbd"::"ptr"::nil);

loop: for (;;) alt {
	s := <-panel.ctxt.kbd =>
		tk->keyboard(panel, s);
	s := <-panel.ctxt.ptr =>
		tk->pointer(panel, *s);
	c := <-cmdch =>
		case c {
		"set" =>
			err := settime(fd, cmd(panel, ".d.de get"), cmd(panel, ".t.te get"));
			if (err == nil)
				break loop;
			notice(ctxt, panel, X("Cannot set time: ") + err);
		"cancel" =>
			break loop;
		* =>;
		}
	c := <-wmctl =>
		case c {
		"exit" =>
			break loop;
		* =>
			tkclient->wmctl(panel, c);
		}
	}
}

settime(tfd: ref Sys->FD, date, time: string): string
{
	da := s2a(date, 3, 3, "/");
	if (da == nil)
		return X("Invalid date syntax");
	ta := s2a(time, 2, 3, ":.");
	if (ta == nil)
		return X("Invalid time syntax");
	t := ref blanktm;
	if (da[2] > 1000)
		(da[0], da[1], da[2]) = (da[2], da[1], da[0]);
	(t.year, t.mon, t.mday) = (da[0]-1900, da[1]-1, da[2]);
	if (len ta == 3)
		(t.hour, t.min, t.sec) = (ta[0], ta[1], ta[2]);
	else
		(t.hour, t.min, t.sec) = (ta[0], ta[1], 0);
	if (!validtm(t))
		return X("Invalid time or date given");
	s := string daytime->tm2epoch(t) + "000000";
	if (sys->fprint(tfd, "%s", s) == -1)
		return X("write failed:") + sys->sprint(" %r");
	return nil;
}
	

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

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

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

tm2date(t: ref Tm): int
{
	if (t == nil)
		return 19700001;
	return ymd2date(t.year+1900, t.mon, t.mday);
}

date2ymd(date: int): (int, int, int)
{
	return (date / 10000, (date / 100) % 100, date%100);
}

ymd2date(y, m, d: int): int
{
	return d + m* 100 + y * 10000;
}

adddays(date, delta: int): int
{
	t := ref blanktm;
	t.mday = date % 100;
	t.mon = (date / 100) % 100;
	t.year = (date / 10000) - 1900;
	t.hour = 12;
	e := daytime->tm2epoch(t);
	e += delta * 24 * 60 * 60;
	t = daytime->gmt(e);
	if (!validtm(t))
		return date;
	return tm2date(t);
}

incmonth(date: int): int
{
	(y,m,d) := date2ymd(date);
	if (m < 11)
		m++;
	else if (y < 2037)
		(y, m) = (y+1, 0);
	(n, nil) := monthinfo(m, y);
	if (d > n)
		d = n;
	return ymd2date(y,m,d);
}

decmonth(date: int): int
{
	(y,m,d) := date2ymd(date);
	if (m > 0)
		m--;
	else if (y > 1970)
		(y, m) = (y-1, 11);
	(n, nil) := monthinfo(m, y);
	if (d > n)
		d = n;
	return ymd2date(y,m,d);
}

dmsize := array[] of {
	31, 28, 31, 30, 31, 30,
	31, 31, 30, 31, 30, 31
};

dysize(y: int): int
{
	if( (y%4) == 0 && (y % 100 != 0 || y % 400 == 0) )
		return 366;
	return 365;
}

blanktm: Tm;

# return number of days in month and
# starting day of month/year.
monthinfo(mon, year: int): (int, int)
{
	t  := ref blanktm;
	t.mday = 1;
	t.mon = mon;
	t.year = year - 1900;
	t = daytime->gmt(daytime->tm2epoch(t));
	md := dmsize[mon];
	if (dysize(year) == 366 && t.mon == 1)
		md++;
	return (md, t.wday);
}

X(s: string): string
{
	#sys->print("\"%s\"\n", s);
	if (dict == nil)
		return s;
	return dict.xlate(s);
}

Xa(a: array of string): array of string
{
	for (i := 0; i < len a; i++)
		a[i] = X(a[i]);
	return a;
}