ref: 8a788aea84aad3bfbd5b39d78c1925654f3b9e14
dir: /appl/grid/query.b/
implement Query;
#
# Copyright © 2003 Vita Nuova Holdings Limited. All rights reserved.
#
include "sys.m";
sys : Sys;
include "draw.m";
draw: Draw;
Display, Rect, Image: import draw;
include "tk.m";
tk: Tk;
include "tkclient.m";
tkclient: Tkclient;
include "readdir.m";
readdir: Readdir;
include "sh.m";
include "workdir.m";
include "registries.m";
registries: Registries;
Service: import registries;
include "grid/pathreader.m";
reader: PathReader;
include "grid/browser.m";
browser: Browser;
Browse, File: import browser;
include "grid/srvbrowse.m";
srvbrowse: Srvbrowse;
include "grid/fbrowse.m";
include "grid/announce.m";
announce: Announce;
srvfilter : list of list of (string, string);
Query : module {
init : fn (context : ref Draw->Context, nil : list of string);
readpath: fn (dir: File): (array of ref sys->Dir, int);
};
realinit()
{
sys = load Sys Sys->PATH;
if (sys == nil)
badmod(Sys->PATH);
readdir = load Readdir Readdir->PATH;
if (readdir == nil)
badmod(Readdir->PATH);
draw = load Draw Draw->PATH;
if (draw == nil)
badmod(Draw->PATH);
tk = load Tk Tk->PATH;
if (tk == nil)
badmod(Tk->PATH);
tkclient = load Tkclient Tkclient->PATH;
if (tkclient == nil)
badmod(Tkclient->PATH);
tkclient->init();
workdir := load Workdir Workdir->PATH;
if (workdir == nil)
badmod(Workdir->PATH);
registries = load Registries Registries->PATH;
if (registries == nil)
badmod(Registries->PATH);
registries->init();
browser = load Browser Browser->PATH;
if (browser == nil)
badmod(Browser->PATH);
browser->init();
srvbrowse = load Srvbrowse Srvbrowse->PATH;
if (srvbrowse == nil)
badmod(Srvbrowse->PATH);
srvbrowse->init();
announce = load Announce Announce->PATH;
if (announce == nil)
badmod(Announce->PATH);
announce->init();
reader = load PathReader "$self";
if (reader == nil)
badmod("PathReader");
}
init(ctxt : ref Draw->Context, nil: list of string)
{
realinit();
spawn start(ctxt, 1);
}
start(ctxt: ref Draw->Context, standalone: int)
{
sys->pctl(sys->FORKNS | sys->NEWPGRP, nil);
if (ctxt == nil)
ctxt = tkclient->makedrawcontext();
if (standalone)
sys->create("/tmp/query", sys->OREAD, sys->DMDIR | 8r777);
root := "/";
(top, titlebar) := tkclient->toplevel(ctxt,"","Query", tkclient->Appl);
butchan := chan of string;
tk->namechan(top, butchan, "butchan");
browsechan := chan of string;
tk->namechan(top, browsechan, "browsechan");
br := Browse.new(top, "browsechan", "services/", "Services", 1, reader);
br.addopened(File ("services/", nil), 1);
srvbrowse->refreshservices(srvfilter);
br.refresh();
for (ik := 0; ik < len mainscreen; ik++)
tkcmd(top,mainscreen[ik]);
tkcmd(top, "pack .f -fill both -expand 1; pack propagate . 0");
released := 1;
title := "";
resize(top, 400,400);
tkclient->onscreen(top, nil);
tkclient->startinput(top, "kbd"::"ptr"::nil);
tkpath: string;
main: for (;;) {
alt {
s := <-top.ctxt.kbd =>
tk->keyboard(top, s);
s := <-top.ctxt.ptr =>
tk->pointer(top, *s);
inp := <-browsechan =>
(nil, lst) := sys->tokenize(inp, " \n\t");
if (len lst > 1)
tkpath = hd tl lst;
selected := br.getselected(0);
br.defaultaction(lst, nil);
if (!File.eq(selected, br.getselected(0)))
actionbutton(top, br.selected[0].file.path, br.selected[0].tkpath);
tkcmd(top, "update");
inp := <-butchan =>
# sys->print("inp: %s\n",inp);
(nil, lst) := sys->tokenize(inp, " \n\t");
if (len lst > 1)
tkpath = hd tl lst;
case hd lst {
"search" =>
if (tl lst == nil)
spawn srvbrowse->searchwin(ctxt, butchan, nil);
else {
if (hd tl lst == "select") {
file := hd tl tl lst;
for (tmp := tl tl tl lst; tl tmp != nil; tmp = tl tmp)
file += " "+hd tmp;
qid := hd tmp;
br.gotoselectfile(File (file, qid));
actionbutton(top, br.selected[0].file.path, br.selected[0].tkpath);
}
else if (hd tl lst == "search") {
srvbrowse->refreshservices(srvfilter);
br.refresh();
}
}
"refresh" =>
# ! check to see if anything is mounted first
srvbrowse->refreshservices(srvfilter);
br.refresh();
"mount" =>
file := *br.getpath(tkpath);
(nsrv, lsrv) := sys->tokenize(file.path, "/");
if (nsrv == 3)
spawn mountsrv(ctxt, file, getcoords(top));
}
tkcmd(top, "update");
title = <-top.ctxt.ctl or
title = <-top.wreq or
title = <-titlebar =>
if (title == "exit")
break main;
e := tkclient->wmctl(top, title);
if (e == nil && title[0] == '!')
(nil, lst) := sys->tokenize(title, " \t\n");
}
}
killg(sys->pctl(0,nil));
}
resize(top: ref Tk->Toplevel, w, h: int)
{
tkcmd(top, ". configure -x 0 -width "+string min(top.screenr.dx(), w));
tkcmd(top, ". configure -y 0 -height "+string min(top.screenr.dy(), h));
}
min(a, b: int): int
{
if (a < b)
return a;
return b;
}
nactionbuttons := 0;
actionbutton(top: ref Tk->Toplevel, path, tkpath: string)
{
for (i := 0; i < nactionbuttons; i++) {
tkcmd(top, "grid forget .f.ftop.baction"+string i);
tkcmd(top, "destroy .f.ftop.baction"+string i);
}
if (path == nil) {
nactionbuttons = 0;
return;
}
(n, nil) := sys->tokenize(path, "/");
buttons : list of (string, string) = nil;
if (n == 3)
buttons = ("Mount", "mount "+tkpath) :: buttons;
nactionbuttons = len buttons;
for (i = 0; i < nactionbuttons; i++) {
name := ".f.ftop.baction"+string i+" ";
(text,cmd) := hd buttons;
tkcmd(top, "button "+name+"-text {"+text+"} "+
"-font /fonts/charon/bold.normal.font "+
"-command {send butchan "+cmd+"}");
tkcmd(top, "grid "+name+" -row 0 -column "+string (4+i));
buttons = tl buttons;
}
}
kill(pid: int)
{
if ((fd := sys->open("/prog/" + string pid + "/ctl", Sys->OWRITE)) != nil)
sys->fprint(fd, "kill");
}
killg(pid: int)
{
if ((fd := sys->open("/prog/" + string pid + "/ctl", Sys->OWRITE)) != nil)
sys->fprint(fd, "killgrp");
}
mainscreen := array[] of {
"frame .f",
"frame .f.ftop",
"variable opt command",
"button .f.ftop.br -text {Refresh} -command {send butchan refresh} -font /fonts/charon/bold.normal.font",
"button .f.ftop.bs -text {Search} -command {send butchan search} -font /fonts/charon/bold.normal.font",
"grid .f.ftop.br .f.ftop.bs -row 0",
"grid columnconfigure .f.ftop 3 -minsize 30",
"label .f.l -text { } -height 1 -bg red",
"grid .f.l -row 1 -column 0 -sticky ew",
"grid .f.ftop -row 0 -column 0 -pady 2 -sticky w",
"grid .fbrowse -in .f -row 2 -column 0 -sticky nsew",
"grid columnconfigure .f 0 -weight 1",
"grid rowconfigure .f 2 -weight 1",
"bind .Wm_t <Button-1> +{focus .Wm_t}",
"bind .Wm_t.title <Button-1> +{focus .Wm_t}",
"focus .Wm_t",
};
readpath(dir: File): (array of ref sys->Dir, int)
{
return srvbrowse->servicepath2Dir(dir.path, int dir.qid);
}
badmod(path: string)
{
sys->print("Query: failed to load %s: %r\n",path);
exit;
}
mountscr := array[] of {
"frame .f -borderwidth 2 -relief raised",
"text .f.t -width 200 -height 60 -borderwidth 1 -bg white -font /fonts/charon/plain.normal.font",
"button .f.b -text {Cancel} -command {send butchan cancel} -width 70 -font /fonts/charon/plain.normal.font",
"grid .f.t -row 0 -column 0 -padx 10 -pady 10",
"grid .f.b -row 1 -column 0 -sticky n",
"grid rowconfigure .f 1 -minsize 30",
};
mountsrv(ctxt: ref Draw->Context, srvfile: File, coords: draw->Rect)
{
(top, nil) := tkclient->toplevel(ctxt, "", nil, tkclient->Plain);
ctlchan := chan of string;
butchan := chan of string;
tk->namechan(top, butchan, "butchan");
tkcmds(top, mountscr);
tkcmd(top, ". configure "+getcentre(top, coords)+"; pack .f; update");
spawn mountit(ctxt, srvfile, ctlchan);
pid := int <-ctlchan;
tkclient->onscreen(top, "exact");
tkclient->startinput(top, "kbd"::"ptr"::nil);
for (;;) {
alt {
s := <-top.ctxt.kbd =>
tk->keyboard(top, s);
s := <-top.ctxt.ptr =>
tk->pointer(top, *s);
e := <- ctlchan =>
if (e[0] == '!') {
tkcmd(top, ".f.t insert end {"+e[1:]+"}");
tkcmd(top, ".f.b configure -text {close}; update");
pid = -1;
}
else if (e == "ok")
return;
else
tkcmd(top, ".f.t insert end {"+e+"}; update");
<- butchan =>
if (pid != -1)
kill(pid);
return;
}
}
}
mountit(ctxt: ref Draw->Context, srvfile: File, ctlchan: chan of string)
{
ctlchan <-= string sys->pctl(0,nil);
n := 0;
(nil, lst) := sys->tokenize(srvfile.path, "/");
stype := hd tl lst;
name := hd tl tl lst;
addr := "";
ctlchan <-= "Connecting...\n";
lsrv := srvbrowse->servicepath2Service(srvfile.path, srvfile.qid);
if (len lsrv < 1) {
ctlchan <-= "!could not find service";
return;
}
srvc := hd lsrv;
ctlchan <-= "Mounting...\n";
id := 0;
dir : string;
for (;;) {
dir = "/tmp/query/"+string id;
(n2, nil) := sys->stat(dir);
if (n2 == -1) {
fdtmp := sys->create(dir, sys->OREAD, sys->DMDIR | 8r777);
if (fdtmp != nil)
break;
}
else {
(dirs2, nil) := readdir->init(dir, readdir->NAME | readdir->COMPACT);
if (len dirs2 == 0)
break;
}
id++;
}
attached := srvc.attach(nil, nil);
if (attached == nil) {
ctlchan <-= sys->sprint("!could not connect: %r");
return;
}
if (sys->mount(attached.fd, nil, dir, sys->MREPL, nil) != -1) {
ctlchan <-= "ok";
fbrowse := load FBrowse FBrowse->PATH;
if (fbrowse == nil)
badmod(FBrowse->PATH);
fbrowse->init(ctxt, srvfile.path, dir, dir);
sys->unmount(nil, dir);
attached = nil;
}
else
ctlchan <-= sys->sprint("!mount failed: %r");
}
getcoords(top: ref Tk->Toplevel): draw->Rect
{
h := int tkcmd(top, ". cget -height");
w := int tkcmd(top, ". cget -width");
x := int tkcmd(top, ". cget -actx");
y := int tkcmd(top, ". cget -acty");
r := draw->Rect((x,y),(x+w,y+h));
return r;
}
getcentre(top: ref Tk->Toplevel, winr: draw->Rect): string
{
h := int tkcmd(top, ".f cget -height");
w := int tkcmd(top, ".f cget -width");
midx := winr.min.x + (winr.dx() / 2);
midy := winr.min.y + (winr.dy() / 2);
newx := midx - (w/2);
newy := midy - (h/2);
return "-x "+string newx+" -y "+string newy;
}
tkcmd(top: ref Tk->Toplevel, cmd: string): string
{
e := tk->cmd(top, cmd);
if (e != "" && e[0] == '!')
sys->print("Tk error: '%s': %s\n",cmd,e);
return e;
}
tkcmds(top: ref Tk->Toplevel, a: array of string)
{
for (j := 0; j < len a; j++)
tkcmd(top, a[j]);
}