ref: 600bbfe4aaa9ad0f73d8d73eef1b7670e5f7d3a3
dir: /appl/lib/tkclient.b/
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;
}