/appl/cmd/sh/tk.b
Brainfuck | 438 lines | 392 code | 46 blank | 0 comment | 37 complexity | 69180f9c824f0d1c3162f232c7191536 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.1, MPL-2.0-no-copyleft-exception
- 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;
- }
- }