ref: 354b56d6bfdca067a6f04a39c4ce4bc9c0160861
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; } }