ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
dir: /appl/wm/toolbar.b/
implement Toolbar; include "sys.m"; sys: Sys; include "draw.m"; draw: Draw; Screen, Display, Image, Rect, Point, Wmcontext, Pointer: import draw; include "tk.m"; tk: Tk; include "tkclient.m"; tkclient: Tkclient; include "sh.m"; shell: Sh; Listnode, Context: import shell; include "string.m"; str: String; include "arg.m"; myselfbuiltin: Shellbuiltin; Toolbar: module { init: fn(ctxt: ref Draw->Context, argv: list of string); initbuiltin: fn(c: ref Context, sh: Sh): string; runbuiltin: fn(c: ref Context, sh: Sh, cmd: list of ref Listnode, last: int): string; runsbuiltin: fn(c: ref Context, sh: Sh, cmd: list of ref Listnode): list of ref Listnode; whatis: fn(c: ref Sh->Context, sh: Sh, name: string, wtype: int): string; getself: fn(): Shellbuiltin; }; MAXCONSOLELINES: con 1024; # execute this if no menu items have been created # by the init script. defaultscript := "{menu shell " + "{{autoload=std; load $autoload; pctl newpgrp; wm/sh}&}}"; tbtop: ref Tk->Toplevel; screenr: Rect; badmodule(p: string) { sys->fprint(stderr(), "toolbar: cannot load %s: %r\n", p); raise "fail:bad module"; } init(ctxt: ref Draw->Context, argv: list of string) { sys = load Sys Sys->PATH; draw = load Draw Draw->PATH; if(draw == nil) badmodule(Draw->PATH); tk = load Tk Tk->PATH; if(tk == nil) badmodule(Tk->PATH); str = load String String->PATH; if(str == nil) badmodule(String->PATH); tkclient = load Tkclient Tkclient->PATH; if(tkclient == nil) badmodule(Tkclient->PATH); tkclient->init(); shell = load Sh Sh->PATH; if (shell == nil) badmodule(Sh->PATH); arg := load Arg Arg->PATH; if (arg == nil) badmodule(Arg->PATH); myselfbuiltin = load Shellbuiltin "$self"; if (myselfbuiltin == nil) badmodule("$self(Shellbuiltin)"); sys->pctl(Sys->NEWPGRP|Sys->FORKNS, nil); sys->bind("#p", "/prog", sys->MREPL); sys->bind("#s", "/chan", sys->MBEFORE); arg->init(argv); arg->setusage("toolbar [-s] [-p]"); startmenu := 1; # ownsnarf := (sys->open("/chan/snarf", Sys->ORDWR) == nil); ownsnarf := sys->stat("/chan/snarf").t0 < 0; while((c := arg->opt()) != 0){ case c { 's' => startmenu = 0; 'p' => ownsnarf = 1; * => arg->usage(); } } argv = arg->argv(); arg = nil; if (ctxt == nil){ sys->fprint(sys->fildes(2), "toolbar: must run under a window manager\n"); raise "fail:no wm"; } exec := chan of string; task := chan of string; tbtop = toolbar(ctxt, startmenu, exec, task); tkclient->startinput(tbtop, "ptr" :: "control" :: nil); layout(tbtop); shctxt := Context.new(ctxt); shctxt.addmodule("wm", myselfbuiltin); snarfIO: ref Sys->FileIO; if(ownsnarf){ snarfIO = sys->file2chan("/chan", "snarf"); if(snarfIO == nil) fatal(sys->sprint("cannot make /chan/snarf: %r")); }else snarfIO = ref Sys->FileIO(chan of (int, int, int, Sys->Rread), chan of (int, array of byte, int, Sys->Rwrite)); sync := chan of string; spawn consoleproc(ctxt, sync); if ((err := <-sync) != nil) fatal(err); setupfinished := chan of int; donesetup := 0; spawn setup(shctxt, setupfinished); snarf: array of byte; # write("/prog/"+string sys->pctl(0, nil)+"/ctl", "restricted"); # for testing for(;;) alt{ k := <-tbtop.ctxt.kbd => tk->keyboard(tbtop, k); m := <-tbtop.ctxt.ptr => tk->pointer(tbtop, *m); s := <-tbtop.ctxt.ctl or s = <-tbtop.wreq => wmctl(tbtop, s); s := <-exec => # guard against parallel access to the shctxt environment if (donesetup){ { shctxt.run(ref Listnode(nil, s) :: nil, 0); } exception { "fail:*" => ; } } detask := <-task => deiconify(detask); (off, data, nil, wc) := <-snarfIO.write => if(wc == nil) break; if (off == 0) # write at zero truncates snarf = data; else { if (off + len data > len snarf) { nsnarf := array[off + len data] of byte; nsnarf[0:] = snarf; snarf = nsnarf; } snarf[off:] = data; } wc <-= (len data, ""); (off, nbytes, nil, rc) := <-snarfIO.read => if(rc == nil) break; if (off >= len snarf) { rc <-= (nil, ""); # XXX alt break; } e := off + nbytes; if (e > len snarf) e = len snarf; rc <-= (snarf[off:e], ""); # XXX alt donesetup = <-setupfinished => ; } } wmctl(top: ref Tk->Toplevel, c: string) { args := str->unquoted(c); if(args == nil) return; n := len args; case hd args{ "request" => # request clientid args... if(n < 3) return; args = tl args; clientid := hd args; args = tl args; err := handlerequest(clientid, args); if(err != nil) sys->fprint(sys->fildes(2), "toolbar: bad wmctl request %#q: %s\n", c, err); "newclient" => # newclient id ; "delclient" => # delclient id deiconify(hd tl args); "rect" => tkclient->wmctl(top, c); layout(top); * => tkclient->wmctl(top, c); } } handlerequest(clientid: string, args: list of string): string { n := len args; case hd args { "task" => # task name if(n != 2) return "no task label given"; iconify(clientid, hd tl args); "untask" or "unhide" => deiconify(clientid); * => return "unknown request"; } return nil; } iconify(id, label: string) { label = condenselabel(label); e := tk->cmd(tbtop, "button .toolbar." +id+" -command {send task "+id+"} -takefocus 0"); cmd(tbtop, ".toolbar." +id+" configure -text '" + label); if(e[0] != '!') cmd(tbtop, "pack .toolbar."+id+" -side left -fill y"); cmd(tbtop, "update"); } deiconify(id: string) { e := tk->cmd(tbtop, "destroy .toolbar."+id); if(e == nil){ tkclient->wmctl(tbtop, sys->sprint("ctl %q untask", id)); tkclient->wmctl(tbtop, sys->sprint("ctl %q kbdfocus 1", id)); } cmd(tbtop, "update"); } layout(top: ref Tk->Toplevel) { r := top.screenr; h := 32; if(r.dy() < 480) h = tk->rect(top, ".b", Tk->Border|Tk->Required).dy(); cmd(top, ". configure -x " + string r.min.x + " -y " + string (r.max.y - h) + " -width " + string r.dx() + " -height " + string h); cmd(top, "update"); tkclient->onscreen(tbtop, "exact"); } toolbar(ctxt: ref Draw->Context, startmenu: int, exec, task: chan of string): ref Tk->Toplevel { (tbtop, nil) = tkclient->toplevel(ctxt, nil, nil, Tkclient->Plain); screenr = tbtop.screenr; cmd(tbtop, "button .b -text {XXX}"); cmd(tbtop, "pack propagate . 0"); tk->namechan(tbtop, exec, "exec"); tk->namechan(tbtop, task, "task"); cmd(tbtop, "frame .toolbar"); if (startmenu) { cmd(tbtop, "menubutton .toolbar.start -menu .m -borderwidth 0 -bitmap vitasmall.bit"); cmd(tbtop, "pack .toolbar.start -side left"); } cmd(tbtop, "pack .toolbar -fill x"); cmd(tbtop, "menu .m"); return tbtop; } setup(shctxt: ref Context, finished: chan of int) { ctxt := shctxt.copy(0); ctxt.run(shell->stringlist2list("run"::"/lib/wmsetup"::nil), 0); # if no items in menu, then create some. if (tk->cmd(tbtop, ".m type 0")[0] == '!') ctxt.run(shell->stringlist2list(defaultscript::nil), 0); cmd(tbtop, "update"); finished <-= 1; } condenselabel(label: string): string { if(len label > 15){ new := ""; l := 0; while(len label > 15 && l < 3) { new += label[0:15]+"\n"; label = label[15:]; for(v := 0; v < len label; v++) if(label[v] != ' ') break; label = label[v:]; l++; } label = new + label; } return label; } initbuiltin(ctxt: ref Context, nil: Sh): string { if (tbtop == nil) { sys = load Sys Sys->PATH; sys->fprint(sys->fildes(2), "wm: cannot load wm as a builtin\n"); raise "fail:usage"; } ctxt.addbuiltin("menu", myselfbuiltin); ctxt.addbuiltin("delmenu", myselfbuiltin); ctxt.addbuiltin("error", myselfbuiltin); return nil; } whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string { return nil; } runbuiltin(c: ref Context, sh: Sh, cmd: list of ref Listnode, nil: int): string { case (hd cmd).word { "menu" => return builtin_menu(c, sh, cmd); "delmenu" => return builtin_delmenu(c, sh, cmd); } return nil; } runsbuiltin(nil: ref Context, nil: Sh, nil: list of ref Listnode): list of ref Listnode { return nil; } stderr(): ref Sys->FD { return sys->fildes(2); } word(ln: ref Listnode): string { if (ln.word != nil) return ln.word; if (ln.cmd != nil) return shell->cmd2string(ln.cmd); return nil; } menupath(title: string): string { mpath := ".m."+title; for(j := 0; j < len mpath; j++) if(mpath[j] == ' ') mpath[j] = '_'; return mpath; } builtin_menu(nil: ref Context, nil: Sh, argv: list of ref Listnode): string { n := len argv; if (n < 3 || n > 4) { sys->fprint(stderr(), "usage: menu topmenu [ secondmenu ] command\n"); raise "fail:usage"; } primary := (hd tl argv).word; argv = tl tl argv; if (n == 3) { w := word(hd argv); if (len w == 0) cmd(tbtop, ".m insert 0 separator"); else cmd(tbtop, ".m insert 0 command -label " + tk->quote(primary) + " -command {send exec " + w + "}"); } else { secondary := (hd argv).word; argv = tl argv; mpath := menupath(primary); e := tk->cmd(tbtop, mpath+" cget -width"); if(e[0] == '!') { cmd(tbtop, "menu "+mpath); cmd(tbtop, ".m insert 0 cascade -label "+tk->quote(primary)+" -menu "+mpath); } w := word(hd argv); if (len w == 0) cmd(tbtop, mpath + " insert 0 separator"); else cmd(tbtop, mpath+" insert 0 command -label "+tk->quote(secondary)+ " -command {send exec "+w+"}"); } return nil; } builtin_delmenu(nil: ref Context, nil: Sh, nil: list of ref Listnode): string { delmenu(".m"); cmd(tbtop, "menu .m"); return nil; } delmenu(m: string) { for (i := int cmd(tbtop, m + " index end"); i >= 0; i--) if (cmd(tbtop, m + " type " + string i) == "cascade") delmenu(cmd(tbtop, m + " entrycget " + string i + " -menu")); cmd(tbtop, "destroy " + m); } getself(): Shellbuiltin { return myselfbuiltin; } cmd(top: ref Tk->Toplevel, c: string): string { s := tk->cmd(top, c); if (s != nil && s[0] == '!') sys->fprint(stderr(), "tk error on %#q: %s\n", c, s); return s; } kill(pid: int, note: string): int { fd := sys->open("/prog/"+string pid+"/ctl", Sys->OWRITE); if(fd == nil || sys->fprint(fd, "%s", note) < 0) return -1; return 0; } fatal(s: string) { sys->fprint(sys->fildes(2), "wm: %s\n", s); kill(sys->pctl(0, nil), "killgrp"); raise "fail:error"; } bufferproc(in, out: chan of string) { h, t: list of string; dummyout := chan of string; for(;;){ outc := dummyout; s: string; if(h != nil || t != nil){ outc = out; if(h == nil) for(; t != nil; t = tl t) h = hd t :: h; s = hd h; } alt{ x := <-in => t = x :: t; outc <-= s => h = tl h; } } } con_cfg := array[] of { "frame .cons", "scrollbar .cons.scroll -command {.cons.t yview}", "text .cons.t -width 60w -height 15w -bg white "+ "-fg black -font /fonts/misc/latin1.6x13.font "+ "-yscrollcommand {.cons.scroll set}", "pack .cons.scroll -side left -fill y", "pack .cons.t -fill both -expand 1", "pack .cons -expand 1 -fill both", "pack propagate . 0", "update" }; nlines := 0; # transcript length consoleproc(ctxt: ref Draw->Context, sync: chan of string) { iostdout := sys->file2chan("/chan", "wmstdout"); if(iostdout == nil){ sync <-= sys->sprint("cannot make /chan/wmstdout: %r"); return; } iostderr := sys->file2chan("/chan", "wmstderr"); if(iostderr == nil){ sync <-= sys->sprint("cannot make /chan/wmstdout: %r"); return; } sync <-= nil; (top, titlectl) := tkclient->toplevel(ctxt, "", "Log", tkclient->Appl); for(i := 0; i < len con_cfg; i++) cmd(top, con_cfg[i]); r := tk->rect(top, ".", Tk->Border|Tk->Required); cmd(top, ". configure -x " + string ((top.screenr.dx() - r.dx()) / 2 + top.screenr.min.x) + " -y " + string (r.dy() / 3 + top.screenr.min.y)); tkclient->startinput(top, "ptr"::"kbd"::nil); tkclient->onscreen(top, "onscreen"); tkclient->wmctl(top, "task"); for(;;) alt { c := <-titlectl or c = <-top.wreq or c = <-top.ctxt.ctl => if(c == "exit") c = "task"; tkclient->wmctl(top, c); c := <-top.ctxt.kbd => tk->keyboard(top, c); p := <-top.ctxt.ptr => tk->pointer(top, *p); (nil, nil, nil, rc) := <-iostdout.read => if(rc != nil) rc <-= (nil, "inappropriate use of file"); (nil, nil, nil, rc) := <-iostderr.read => if(rc != nil) rc <-= (nil, "inappropriate use of file"); (nil, data, nil, wc) := <-iostdout.write => conout(top, data, wc); (nil, data, nil, wc) := <-iostderr.write => conout(top, data, wc); if(wc != nil) tkclient->wmctl(top, "untask"); } } conout(top: ref Tk->Toplevel, data: array of byte, wc: Sys->Rwrite) { if(wc == nil) return; s := string data; tk->cmd(top, ".cons.t insert end '"+ s); alt{ wc <-= (len data, nil) =>; * =>; } for(i := 0; i < len s; i++) if(s[i] == '\n') nlines++; if(nlines > MAXCONSOLELINES){ cmd(top, ".cons.t delete 1.0 " + string (nlines/4) + ".0; update"); nlines -= nlines / 4; } tk->cmd(top, ".cons.t see end; update"); }