ref: 6d69f6fba35087686f79adb2ea0d67944a62ca7b
dir: /appl/cmd/sh/tk.b/
implement Shellbuiltin;
include "sys.m";
sys: Sys;
include "draw.m";
include "tk.m";
tk: Tk;
include "tkclient.m";
tkclient: Tkclient;
include "sh.m";
sh: Sh;
Listnode, Context: import sh;
myself: Shellbuiltin;
tklock: chan of int;
chans := array[23] of list of (string, chan of string);
wins := array[16] of list of (int, ref Tk->Toplevel);
winid := 0;
badmodule(ctxt: ref Context, p: string)
{
ctxt.fail("bad module", sys->sprint("tk: cannot load %s: %r", p));
}
initbuiltin(ctxt: ref Context, shmod: Sh): string
{
sys = load Sys Sys->PATH;
sh = shmod;
myself = load Shellbuiltin "$self";
if (myself == nil) badmodule(ctxt, "self");
tk = load Tk Tk->PATH;
if (tk == nil) badmodule(ctxt, Tk->PATH);
tkclient = load Tkclient Tkclient->PATH;
if (tkclient == nil) badmodule(ctxt, Tkclient->PATH);
tkclient->init();
tklock = chan[1] of int;
ctxt.addbuiltin("tk", myself);
ctxt.addbuiltin("chan", myself);
ctxt.addbuiltin("send", myself);
ctxt.addsbuiltin("tk", myself);
ctxt.addsbuiltin("recv", myself);
ctxt.addsbuiltin("alt", myself);
ctxt.addsbuiltin("tkquote", myself);
return nil;
}
whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
{
return nil;
}
getself(): Shellbuiltin
{
return myself;
}
runbuiltin(ctxt: ref Context, nil: Sh,
cmd: list of ref Listnode, nil: int): string
{
case (hd cmd).word {
"tk" => return builtin_tk(ctxt, cmd);
"chan" => return builtin_chan(ctxt, cmd);
"send" => return builtin_send(ctxt, cmd);
}
return nil;
}
runsbuiltin(ctxt: ref Context, nil: Sh,
cmd: list of ref Listnode): list of ref Listnode
{
case (hd cmd).word {
"tk" => return sbuiltin_tk(ctxt, cmd);
"recv" => return sbuiltin_recv(ctxt, cmd);
"alt" => return sbuiltin_alt(ctxt, cmd);
"tkquote" => return sbuiltin_tkquote(ctxt, cmd);
}
return nil;
}
builtin_tk(ctxt: ref Context, argv: list of ref Listnode): string
{
# usage: tk window _title_ _options_
# tk wintitle _winid_ _title_
# tk _winid_ _cmd_
if (tl argv == nil)
ctxt.fail("usage", "usage: tk (<winid>|window|onscreen|winctlwintitle|del|namechan) args...");
argv = tl argv;
w := (hd argv).word;
case w {
"window" =>
remark(ctxt, string makewin(ctxt, tl argv));
"wintitle" =>
argv = tl argv;
# change the title of a window
if (len argv != 2 || !isnum((hd argv).word))
ctxt.fail("usage", "usage: tk wintitle winid title");
tkclient->settitle(egetwin(ctxt, hd argv), word(hd tl argv));
"winctl" =>
argv = tl argv;
if (len argv != 2 || !isnum((hd argv).word))
ctxt.fail("usage", "usage: tk winctl winid cmd");
wid := (hd argv).word;
win := egetwin(ctxt, hd argv);
rq := word(hd tl argv);
if (rq == "exit") {
delwin(int wid);
delchan(wid);
}
tkclient->wmctl(win, rq);
"onscreen" =>
argv = tl argv;
if (len argv < 1 || !isnum((hd argv).word))
ctxt.fail("usage", "usage: tk onscreen winid [how]");
how := "";
if(tl argv != nil)
how = word(hd tl argv);
win := egetwin(ctxt, hd argv);
tkclient->startinput(win, "ptr" :: "kbd" :: nil);
tkclient->onscreen(win, how);
"namechan" =>
argv = tl argv;
n := len argv;
if (n < 2 || n > 3 || !isnum((hd argv).word))
ctxt.fail("usage", "usage: tk namechan winid chan [name]");
name: string;
if (n == 3)
name = word(hd tl tl argv);
else
name = word(hd tl argv);
tk->namechan(egetwin(ctxt, hd argv), egetchan(ctxt, hd tl argv), name);
"del" =>
if (len argv < 2)
ctxt.fail("usage", "usage: tk del id...");
for (argv = tl argv; argv != nil; argv = tl argv) {
id := (hd argv).word;
if (isnum(id))
delwin(int id);
delchan(id);
}
* =>
e := tkcmd(ctxt, argv);
if (e != nil)
remark(ctxt, e);
if (e != nil && e[0] == '!')
return e;
}
return nil;
}
remark(ctxt: ref Context, s: string)
{
if (ctxt.options() & ctxt.INTERACTIVE)
sys->print("%s\n", s);
}
# create a new window (and its associated channel)
makewin(ctxt: ref Context, argv: list of ref Listnode): int
{
if (argv == nil)
ctxt.fail("usage", "usage: tk window title options");
if (ctxt.drawcontext == nil)
ctxt.fail("no draw context", sys->sprint("tk: no graphics context available"));
(title, options) := (word(hd argv), concat(tl argv));
(top, topchan) := tkclient->toplevel(ctxt.drawcontext, options, title, Tkclient->Appl);
newid := addwin(top);
addchan(string newid, topchan);
return newid;
}
builtin_chan(ctxt: ref Context, argv: list of ref Listnode): string
{
# create a new channel
argv = tl argv;
if (argv == nil)
ctxt.fail("usage", "usage: chan name....");
for (; argv != nil; argv = tl argv) {
name := (hd argv).word;
if (name == nil || isnum(name))
ctxt.fail("bad chan", "tk: bad channel name "+q(name));
if (addchan(name, chan of string) == nil)
ctxt.fail("bad chan", "tk: channel "+q(name)+" already exists");
}
return nil;
}
builtin_send(ctxt: ref Context, argv: list of ref Listnode): string
{
if (len argv != 3)
ctxt.fail("usage", "usage: send chan arg");
argv = tl argv;
c := egetchan(ctxt, hd argv);
c <-= word(hd tl argv);
return nil;
}
sbuiltin_tk(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
{
# usage: tk _winid_ _command_
# tk window _title_ _options_
argv = tl argv;
if (argv == nil)
ctxt.fail("usage", "tk (window|wid) args");
case (hd argv).word {
"window" =>
return ref Listnode(nil, string makewin(ctxt, tl argv)) :: nil;
"winids" =>
ret: list of ref Listnode;
for (i := 0; i < len wins; i++)
for (wl := wins[i]; wl != nil; wl = tl wl)
ret = ref Listnode(nil, string (hd wl).t0) :: ret;
return ret;
* =>
return ref Listnode(nil, tkcmd(ctxt, argv)) :: nil;
}
}
sbuiltin_alt(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
{
# usage: alt chan ...
argv = tl argv;
if (argv == nil)
ctxt.fail("usage", "usage: alt chan...");
nc := len argv;
kbd := array[nc] of chan of int;
ptr := array[nc] of chan of ref Draw->Pointer;
ca := array[nc * 3] of chan of string;
win := array[nc] of ref Tk->Toplevel;
cname := array[nc] of string;
i := 0;
for (; argv != nil; argv = tl argv) {
w := (hd argv).word;
ca[i*3] = egetchan(ctxt, hd argv);
cname[i] = w;
if(isnum(w)){
win[i] = egetwin(ctxt, hd argv);
ca[i*3+1] = win[i].ctxt.ctl;
ca[i*3+2] = win[i].wreq;
ptr[i] = win[i].ctxt.ptr;
kbd[i] = win[i].ctxt.kbd;
}
i++;
}
for(;;) alt{
(n, key) := <-kbd =>
tk->keyboard(win[n], key);
(n, p) := <-ptr =>
tk->pointer(win[n], *p);
(n, v) := <-ca =>
return ref Listnode(nil, cname[n/3]) :: ref Listnode(nil, v) :: nil;
}
}
sbuiltin_recv(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
{
# usage: recv chan
if (len argv != 2)
ctxt.fail("usage", "usage: recv chan");
ch := hd tl argv;
c := egetchan(ctxt, ch);
if(!isnum(ch.word))
return ref Listnode(nil, <-c) :: nil;
win := egetwin(ctxt, ch);
for(;;)alt{
key := <-win.ctxt.kbd =>
tk->keyboard(win, key);
p := <-win.ctxt.ptr =>
tk->pointer(win, *p);
s := <-win.ctxt.ctl or
s = <-win.wreq or
s = <-c =>
return ref Listnode(nil, s) :: nil;
}
}
sbuiltin_tkquote(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
{
if (len argv != 2)
ctxt.fail("usage", "usage: tkquote arg");
return ref Listnode(nil, tk->quote(word(hd tl argv))) :: nil;
}
tkcmd(ctxt: ref Context, argv: list of ref Listnode): string
{
if (argv == nil || !isnum((hd argv).word))
ctxt.fail("usage", "usage: tk winid command");
return tk->cmd(egetwin(ctxt, hd argv), concat(tl argv));
}
hashfn(s: string, n: int): int
{
h := 0;
m := len s;
for(i:=0; i<m; i++){
h = 65599*h+s[i];
}
return (h & 16r7fffffff) % n;
}
q(s: string): string
{
return "'" + s + "'";
}
egetchan(ctxt: ref Context, n: ref Listnode): chan of string
{
if ((c := getchan(n.word)) == nil)
ctxt.fail("bad chan", "tk: bad channel name "+ q(n.word));
return c;
}
# assumes that n.word has been checked and found to be numeric.
egetwin(ctxt: ref Context, n: ref Listnode): ref Tk->Toplevel
{
wid := int n.word;
if (wid < 0 || (top := getwin(wid)) == nil)
ctxt.fail("bad win", "tk: unknown window id " + q(n.word));
return top;
}
getchan(name: string): chan of string
{
n := hashfn(name, len chans);
for (cl := chans[n]; cl != nil; cl = tl cl) {
(cname, c) := hd cl;
if (cname == name)
return c;
}
return nil;
}
addchan(name: string, c: chan of string): chan of string
{
n := hashfn(name, len chans);
tklock <-= 1;
if (getchan(name) == nil)
chans[n] = (name, c) :: chans[n];
<-tklock;
return c;
}
delchan(name: string)
{
n := hashfn(name, len chans);
tklock <-= 1;
ncl: list of (string, chan of string);
for (cl := chans[n]; cl != nil; cl = tl cl) {
(cname, nil) := hd cl;
if (cname != name)
ncl = hd cl :: ncl;
}
chans[n] = ncl;
<-tklock;
}
addwin(top: ref Tk->Toplevel): int
{
tklock <-= 1;
id := winid++;
slot := id % len wins;
wins[slot] = (id, top) :: wins[slot];
<-tklock;
return id;
}
delwin(id: int)
{
tklock <-= 1;
slot := id % len wins;
nwl: list of (int, ref Tk->Toplevel);
for (wl := wins[slot]; wl != nil; wl = tl wl) {
(wid, nil) := hd wl;
if (wid != id)
nwl = hd wl :: nwl;
}
wins[slot] = nwl;
<-tklock;
}
getwin(id: int): ref Tk->Toplevel
{
slot := id % len wins;
for (wl := wins[slot]; wl != nil; wl = tl wl) {
(wid, top) := hd wl;
if (wid == id)
return top;
}
return nil;
}
word(n: ref Listnode): string
{
if (n.word != nil)
return n.word;
if (n.cmd != nil)
n.word = sh->cmd2string(n.cmd);
return n.word;
}
isnum(s: string): int
{
for (i := 0; i < len s; i++)
if (s[i] > '9' || s[i] < '0')
return 0;
return 1;
}
concat(argv: list of ref Listnode): string
{
if (argv == nil)
return nil;
s := word(hd argv);
for (argv = tl argv; argv != nil; argv = tl argv)
s += " " + word(hd argv);
return s;
}
lockproc(c: chan of int)
{
sys->pctl(Sys->NEWFD|Sys->NEWNS, nil);
for(;;){
c <-= 1;
<-c;
}
}