implement Tkclient; # # Copyright © 2003 Vita Nuova Holdings Limited # include "sys.m"; sys: Sys; include "draw.m"; draw: Draw; Display, Image, Screen, Rect, Point, Pointer, Wmcontext, Context: import draw; include "tk.m"; tk: Tk; Toplevel: import tk; include "wmlib.m"; wmlib: Wmlib; qword, splitqword, s2r: import wmlib; include "titlebar.m"; titlebar: Titlebar; include "tkclient.m"; Background: con int 16r777777FF; # should be drawn over immediately, but just in case... init() { sys = load Sys Sys->PATH; draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; wmlib = load Wmlib Wmlib->PATH; if(wmlib == nil){ sys->fprint(sys->fildes(2), "tkclient: cannot load %s: %r\n", Wmlib->PATH); raise "fail:bad module"; } wmlib->init(); titlebar = load Titlebar Titlebar->PATH; if(titlebar == nil){ sys->fprint(sys->fildes(2), "tkclient: cannot load %s: %r\n", Titlebar->PATH); raise "fail:bad module"; } titlebar->init(); } makedrawcontext(): ref Draw->Context { return wmlib->makedrawcontext(); } toplevel(ctxt: ref Draw->Context, topconfig: string, title: string, buts: int): (ref Tk->Toplevel, chan of string) { wm := wmlib->connect(ctxt); opts := ""; if((buts & Plain) == 0) opts = "-borderwidth 1 -relief raised "; top := tk->toplevel(wm.ctxt.display, opts+topconfig); if (top == nil) { sys->fprint(sys->fildes(2), "wmlib: window creation failed (top %ux, i %ux)\n", top, top.image); raise "fail:window creation failed"; } top.ctxt = wm; readscreenrect(top); c := titlebar->new(top, buts); titlebar->settitle(top, title); return (top, c); } readscreenrect(top: ref Tk->Toplevel) { if((fd := sys->open("/chan/wmrect", Sys->OREAD)) != nil){ buf := array[12*4] of byte; n := sys->read(fd, buf, len buf); if(n > 0) (top.screenr, nil) = s2r(string buf[0:n], 0); } } onscreen(top: ref Tk->Toplevel, how: string) { if(how == nil) how = "place"; wmctl(top, sys->sprint("!reshape . -1 %s %q", r2s(tk->rect(top, ".", Tk->Border|Tk->Required)), how)); } startinput(top: ref Tk->Toplevel, devs: list of string) { for(; devs != nil; devs = tl devs) wmctl(top, sys->sprint("start %q", hd devs)); } r2s(r: Rect): string { return sys->sprint("%d %d %d %d", r.min.x, r.min.y, r.max.x, r.max.y); } # commands originating both from tkclient and wm (via ctl) wmctl(top: ref Tk->Toplevel, req: string): string { #sys->print("wmctl %s\n", req); (c, next) := qword(req, 0); case c { "exit" => sys->fprint(sys->open("/prog/" + string sys->pctl(0, nil) + "/ctl", Sys->OWRITE), "killgrp"); exit; # old-style requests: pass them back around in proper form. "move" => # move x y titlebar->sendctl(top, "!move . -1 " + req[next:]); "size" => minsz := titlebar->minsize(top); titlebar->sendctl(top, "!size . -1 " + string minsz.x + " " + string minsz.y); "ok" or "help" => ; "rect" => r: Rect; (c, next) = qword(req, next); r.min.x = int c; (c, next) = qword(req, next); r.min.y = int c; (c, next) = qword(req, next); r.max.x = int c; (c, next) = qword(req, next); r.max.y = int c; top.screenr = r; "haskbdfocus" => in := int qword(req, next).t0 != 0; cmd(top, "focus -global " + string in); cmd(top, "update"); "task" => (r, nil) := splitqword(req, next); if(r.t0 == r.t1) req = sys->sprint("task %q", cmd(top, ".Wm_t.title cget -text")); if(wmreq(top, c, req, next) == nil) cmd(top, ". unmap; update"); "untask" => cmd(top, ". map; update"); return wmreq(top, c, req, next); * => return wmreq(top, c, req, next); } return nil; } wmreq(top: ref Tk->Toplevel, c, req: string, e: int): string { err := wmreq1(top, c, req, e); # if(err != nil) # sys->fprint(sys->fildes(2), "tkclient: request %#q failed: %s\n", req, err); return err; } wmreq1(top: ref Tk->Toplevel, c, req: string, e: int): string { name, reqid: string; if(req != nil && req[0] == '!'){ (name, e) = qword(req, e); (reqid, e) = qword(req, e); if(name == nil || reqid == nil) return "bad arg count"; } if(top.ctxt.connfd != nil){ if(sys->fprint(top.ctxt.connfd, "%s", req) == -1) return sys->sprint("%r"); if(req[0] == '!') recvimage(top, name, reqid); return nil; } if(req[0] != '!'){ (nil, nil, err) := wmlib->wmctl(top.ctxt, req); return err; } # if there's no window manager, then we create a screen on the # display image. there's nowhere to find the screen again except # through the toplevel's image. that means that you can't create a # menu without mapping a toplevel, and if you manage to unmap # the toplevel without unmapping the menu, you'll have two # screens on the same display image # in the image, so if(c != "!reshape") return "unknown request"; i: ref Image; if(top.image == nil){ if(name != ".") return "screen not available"; di := top.display.image; screen := Screen.allocate(di, top.display.color(Background), 0); di.draw(di.r, screen.fill, nil, screen.fill.r.min); i = screen.newwindow(di.r, Draw->Refbackup, Draw->Nofill); }else{ if(name == ".") i = top.image; else i = top.image.screen.newwindow(s2r(req, e).t0, Draw->Refbackup, Draw->Red); } tk->putimage(top, name+" "+reqid, i, nil); return nil; } recvimage(top: ref Tk->Toplevel, name, reqid: string) { i := <-top.ctxt.images; if(i == nil){ cmd(top, name + " suspend"); i = <-top.ctxt.images; } tk->putimage(top, name+" "+reqid, i, nil); } settitle(top: ref Tk->Toplevel, name: string): string { return titlebar->settitle(top, name); } handler(top: ref Tk->Toplevel, stop: chan of int) { ctxt := top.ctxt; if(stop == nil) stop = chan of int; for(;;)alt{ c := <-ctxt.kbd => tk->keyboard(top, c); p := <-ctxt.ptr => tk->pointer(top, *p); c := <-ctxt.ctl or c = <-top.wreq => wmctl(top, c); <-stop => exit; } } snarfget(): string { return wmlib->snarfget(); } snarfput(buf: string) { return wmlib->snarfput(buf); } cmd(top: ref Tk->Toplevel, s: string): string { e := tk->cmd(top, s); if (e != nil && e[0] == '!') sys->fprint(sys->fildes(2), "tkclient: tk error %s on '%s'\n", e, s); return e; }