ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
dir: /appl/wm/calendar.b/
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; }