summaryrefslogtreecommitdiff
path: root/appl/wm/toolbar.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/wm/toolbar.b')
-rw-r--r--appl/wm/toolbar.b566
1 files changed, 566 insertions, 0 deletions
diff --git a/appl/wm/toolbar.b b/appl/wm/toolbar.b
new file mode 100644
index 00000000..a96f5ba4
--- /dev/null
+++ b/appl/wm/toolbar.b
@@ -0,0 +1,566 @@
+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]");
+ startmenu := 1;
+ while((c := arg->opt()) != 0){
+ case c {
+ 's' =>
+ startmenu = 0;
+ * =>
+ 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 := sys->file2chan("/chan", "snarf");
+ if(snarfIO == nil)
+ fatal(sys->sprint("cannot make /chan/snarf: %r"));
+ 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{
+ s := <-tbtop.ctxt.kbd =>
+ tk->keyboard(tbtop, c);
+ 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 e {"fail:*" =>;}
+ }
+ detask := <-task =>
+ deiconify(detask);
+ (off, data, fid, 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);
+ (off, nbytes, fid, rc) := <-iostdout.read =>
+ if(rc == nil)
+ break;
+ alt{
+ rc <-= (nil, "inappropriate use of file") =>;
+ * =>;
+ }
+ (off, nbytes, fid, rc) := <-iostderr.read =>
+ if(rc == nil)
+ break;
+ alt{
+ rc <-= (nil, "inappropriate use of file") =>;
+ * =>;
+ }
+ (off, data, fid, wc) := <-iostdout.write =>
+ conout(top, data, wc);
+ (off, data, fid, 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");
+}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 19:45:32 +0000