ref: 600bbfe4aaa9ad0f73d8d73eef1b7670e5f7d3a3
dir: /appl/grid/lib/srvbrowse.b/
implement Srvbrowse; # # Copyright © 2003 Vita Nuova Holdings Limited. All rights reserved. # include "sys.m"; sys : Sys; include "draw.m"; draw: Draw; Rect: import draw; include "tk.m"; tk: Tk; include "tkclient.m"; tkclient: Tkclient; include "grid/srvbrowse.m"; include "registries.m"; registries: Registries; Registry, Attributes, Service: import registries; init() { sys = load Sys Sys->PATH; if (sys == nil) badmod(Sys->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(); registries = load Registries Registries->PATH; if (registries == nil) badmod(Registries->PATH); registries->init(); reg = Registry.new("/mnt/registry"); if (reg == nil) { reg = Registry.connect(nil, nil, nil); if (reg == nil) error("Could not find registry"); } qids = array[511] of { * => "" }; } reg : ref Registry; qids : array of string; # Qid stuff is a bit rubbish at the mo but waiting for registries to change: # currently address is unique but will not be in the future so waiting # for another id to uniquely identify a resource addqid(srvc: ref Service): int { addr := srvc.addr; qid := addr2qid(addr); for (;;) { if (qids[qid] == nil) break; else if (qids[qid] == addr) return qid; qid++; if (qid >= len qids) qid = 0; } qids[qid] = addr; # sys->print("adding %s (%s) to %d\n",srvc.attrs.get("resource"), addr, qid); return qid; } getqid(srvc: ref Service): string { addr := srvc.addr; qid := addr2qid(addr); startqid := qid; for (;;) { if (qids[qid] == addr) return string qid; qid++; if (qid == startqid) break; if (qid >= len qids) qid = 0; } return nil; } addr2qid(addr: string): int { qid := 0; # assume addr starts 'tcp!...' for (i := 4; i < len addr; i++) { qid += addr[i] * 2**(i%10); qid = qid % len qids; } return qid; } addservice(srvc: ref Service) { services = srvc :: services; addqid(srvc); } find(filter: list of list of (string, string)): list of ref Service { lsrv : list of ref Service = nil; if (filter == nil) (lsrv, nil) = reg.services(); else { for (; filter != nil; filter = tl filter) { attr := hd filter; (s, nil) := reg.find(attr); for (; s != nil; s = tl s) lsrv = hd s :: lsrv; } } return sortservices(lsrv); } refreshservices(filter: list of list of (string, string)) { services = find(filter); } servicepath2Service(path, qid: string): list of ref Service { srvl : list of ref Service = nil; (nil, lst) := sys->tokenize(path, "/"); pname: string; l := len lst; if (l < 2 || l > 3) return nil; presource := hd tl lst; if (l == 3) pname = hd tl tl lst; for (tmpl := services; tmpl != nil; tmpl = tl tmpl) { srvc := hd tmpl; (resource, name) := getresname(srvc); if (l == 2) { if (resource == presource) srvl = srvc :: srvl; } else if (l == 3) { if (resource == presource) { if (name == pname && qid == getqid(srvc)) { srvl = srvc :: srvl; break; } } } } return srvl; } servicepath2Dir(path: string, qid: int): (array of ref sys->Dir, int) { # sys->print("srvcPath2Dir: '%s' %d\n",path, qid); res : list of (string, string) = nil; (nil, lst) := sys->tokenize(path, "/"); presource, pname: string; pattrib := 0; l := len lst; if (l > 1) presource = hd tl lst; if (l > 2) pname = hd tl tl lst; if (l == 4 && hd tl tl tl lst == "attributes") pattrib = 1; for (tmpl := services; tmpl != nil; tmpl = tl tmpl) { srvc := hd tmpl; (resource, name) := getresname(srvc); if (l == 1) { if (!isin(res, resource)) res = (resource, nil) :: res; } else if (l == 2) { if (resource == presource) res = (name, string getqid(srvc)) :: res; } else if (l == 3) { if (resource == presource && name == pname) { if (qid == int getqid(srvc)) { if (srvc.addr[0] == '@') res = (srvc.addr[1:], string getqid(srvc)) :: res; else { if (srvc.attrs != nil) res = ("attributes", string getqid(srvc)) :: res; res = ("address:\0"+srvc.addr+"}", string getqid(srvc)) :: res; } break; } } } else if (l == 4) { if (resource == presource && name == pname && pattrib) { if (qid == int getqid(srvc)) { for (tmpl2 := srvc.attrs.attrs; tmpl2 != nil; tmpl2 = tl tmpl2) { (attrib, val) := hd tmpl2; if (attrib != "name" && attrib != "resource") res = (attrib+":\0"+val, string getqid(srvc)) :: res; } break; } } } } resa := array [len res] of ref sys->Dir; i := len resa - 1; for (; res != nil; res = tl res) { dir : sys->Dir; qid: string; (dir.name, qid) = hd res; if (l < 3 || dir.name == "attributes") dir.mode = 8r777 | sys->DMDIR; else dir.mode = 8r777; if (qid != nil) dir.qid.path = big qid; resa[i--] = ref dir; } dups := 0; if (l >= 2) dups = 1; return (resa, dups); } isin(l: list of (string, string), s: string): int { for (; l != nil; l = tl l) if ((hd l).t0 == s) return 1; return 0; } getresname(srvc: ref Service): (string, string) { resource := srvc.attrs.get("resource"); if (resource == nil) resource = "Other"; name := srvc.attrs.get("name"); if (name == nil) name = "?????"; return (resource,name); } badmod(path: string) { sys->print("Srvbrowse: failed to load: %s\n",path); exit; } sortservices(lsrv: list of ref Service): list of ref Service { a := array[len lsrv] of ref Service; i := 0; for (; lsrv != nil; lsrv = tl lsrv) { addqid(hd lsrv); a[i++] = hd lsrv; } heapsort(a); lsrvsorted: list of ref Service = nil; for (i = len a - 1; i >= 0; i--) lsrvsorted = a[i] :: lsrvsorted; return lsrvsorted; } heapsort(a: array of ref Service) { for (i := (len a / 2) - 1; i >= 0; i--) movedownheap(a, i, len a - 1); for (i = len a - 1; i > 0; i--) { tmp := a[0]; a[0] = a[i]; a[i] = tmp; movedownheap(a, 0, i - 1); } } movedownheap(a: array of ref Service, root, end: int) { max: int; while (2*root <= end) { r2 := root * 2; if (2*root == end || comp(a[r2], a[r2+1]) == GT) max = r2; else max = r2 + 1; if (comp(a[root], a[max]) == LT) { tmp := a[root]; a[root] = a[max]; a[max] = tmp; root = max; } else break; } } LT: con -1; EQ: con 0; GT: con 1; comp(a1, a2: ref Service): int { (resource1, name1) := getresname(a1); (resource2, name2) := getresname(a2); if (resource1 < resource2) return LT; if (resource1 > resource2) return GT; if (name1 < name2) return LT; if (name1 > name2) return GT; return EQ; } error(e: string) { sys->fprint(sys->fildes(2), "Srvbrowse: %s\n", e); raise "fail:error"; } searchscr := array[] of { "frame .f", "scrollbar .f.sy -command {.f.c yview}", "scrollbar .f.sx -command {.f.c xview} -orient horizontal", "canvas .f.c -yscrollcommand {.f.sy set} -xscrollcommand {.f.sx set} -bg white -width 414 -borderwidth 2 -relief sunken -height 180 -xscrollincrement 10 -yscrollincrement 19", "grid .f.sy -row 0 -column 0 -sticky ns -rowspan 2", "grid .f.sx -row 1 -column 1 -sticky ew", "grid .f.c -row 0 -column 1", "pack .f -fill both -expand 1 ; pack propagate . 0; update", }; SEARCH, RESULTS: con iota; searchwin(ctxt: ref Draw->Context, chanout: chan of string, filter: list of list of (string, string)) { (top, titlebar) := tkclient->toplevel(ctxt,"","Search", tkclient->Appl); butchan := chan of string; tk->namechan(top, butchan, "butchan"); tkcmds(top, searchscr); makesearchframe(top); flid := setframe(top, ".fsearch", nil); selected := ""; lresults : list of ref Service = nil; resultstart := 0; resize(top, 368,220); maxresults := getmaxresults(top); currmode := SEARCH; tkclient->onscreen(top, nil); tkclient->startinput(top, "kbd"::"ptr"::nil); main: for (;;) { alt { s := <-top.ctxt.kbd => tk->keyboard(top, s); s := <-top.ctxt.ptr => tk->pointer(top, *s); inp := <-butchan => (nil, lst) := sys->tokenize(inp, " "); case hd lst { "key" => s := " "; id := hd tl lst; nv := hd tl tl lst; tkp : string; if (id != "-1") tkp = ".fsearch.ea"+nv+id; else tkp = ".fsearch.e"+nv; char := int hd tl tl tl lst; s[0] = char; if (char == '\n' || char == '\t') { newtkp := ".fsearch"; if (nv == "n") newtkp += ".eav"+id; else if (nv == "v") { newid := string ((int id)+1); e := tk->cmd(top, ".fsearch.ean"+newid+" cget -width"); if (e == "" || e[0] == '!') { insertattribrow(top); newtkp += ".ean"+newid; } else newtkp += ".ean"+newid; } focus(top, newtkp); } else { tkcmd(top, tkp+" insert insert {"+s+"}"); tkcmd(top, tkp+" see "+tkcmd(top, tkp+" index insert")); } "go" => lresults = search(top, filter); resultstart = 0; makeresultsframe(top, lresults, 0, maxresults); selected = nil; flid = setframe(top, ".fresults", flid); currmode = RESULTS; if (chanout != nil) chanout <-= "search search"; "prev" => selected = nil; resultstart -= maxresults; if (resultstart < 0) resultstart = 0; makeresultsframe(top, lresults, resultstart, maxresults); flid = setframe(top, ".fresults", flid); "next" => selected = nil; if (resultstart < 0) resultstart = 0; resultstart += maxresults; if (resultstart >= len lresults) resultstart -= maxresults; makeresultsframe(top, lresults, resultstart, maxresults); flid = setframe(top, ".fresults", flid); "backto" => flid = setframe(top, ".fsearch", flid); tkcmd(top, ".f.c see 0 "+tkcmd(top, ".fsearch cget -height")); currmode = SEARCH; "new" => resetsearchscr(top); tkcmd(top, ".f.c see 0 0"); setscrollr(top, ".fsearch"); "select" => if (selected != nil) tkcmd(top, selected+" configure -bg white"); if (selected == hd tl lst) selected = nil; else { selected = hd tl lst; tkcmd(top, hd tl lst+" configure -bg #5555FF"); if (chanout != nil) chanout <-= "search select " + tkcmd(top, selected+" cget -text") + " " + hd tl tl lst; } } tkcmd(top, "update"); title := <-top.ctxt.ctl or title = <-top.wreq or title = <-titlebar => if (title == "exit" || title == "ok") break main; e := tkclient->wmctl(top, title); if (e == nil && title[0] == '!') { (nil, lst) := sys->tokenize(title, " \t\n"); if (len lst >= 2 && hd lst == "!size" && hd tl lst == ".") { resize(top, -1,-1); maxresults = getmaxresults(top); if (currmode == RESULTS) { makeresultsframe(top, lresults, resultstart, maxresults); flid = setframe(top, ".fresults", flid); tkcmd(top, "update"); } } } } } } getmaxresults(top: ref Tk->Toplevel): int { val := ((int tkcmd(top, ".f.c cget -height")) - 65)/17; if (val < 1) return 1; return val; } setframe(top: ref Tk->Toplevel, f, oldflid: string): string { if (oldflid != nil) tkcmd(top, ".f.c delete " + oldflid); newflid := tkcmd(top, ".f.c create window 0 0 -window "+f+" -anchor nw"); setscrollr(top, f); return newflid; } setscrollr(top: ref Tk->Toplevel, f: string) { h := tkcmd(top, f+" cget -height"); w := tkcmd(top, f+" cget -width"); tkcmd(top, ".f.c configure -scrollregion {0 0 "+w+" "+h+"}"); } resize(top: ref Tk->Toplevel, width, height: int) { if (width == -1) { width = int tkcmd(top, ". cget -width"); height = int tkcmd(top, ". cget -height"); } else tkcmd(top, sys->sprint(". configure -width %d -height %d", width, height)); htitle := int tkcmd(top, ".f cget -acty") - int tkcmd(top, ". cget -acty"); height -= htitle; ws := int tkcmd(top, ".f.sy cget -width"); hs := int tkcmd(top, ".f.sx cget -height"); tkcmd(top, ".f.c configure -width "+string (width - ws - 8)+ " -height "+string (height - hs - 8)); tkcmd(top, "update"); } makesearchframe(top: ref Tk->Toplevel) { font := " -font /fonts/charon/plain.normal.font"; fontb := " -font /fonts/charon/bold.normal.font"; f := ".fsearch"; tkcmd(top, "frame "+f+" -bg white"); tkcmd(top, "label "+f+".l -text {Search for Resource Attributes} -bg white" + fontb); tkcmd(top, "grid "+f+".l -row 0 -column 0 -columnspan 3 -sticky nw"); tkcmd(top, "grid rowconfigure "+f+" 0 -minsize 30"); tkcmd(top, "frame "+f+".fgo -bg white"); tkcmd(top, "button "+f+".bs -text {Search} -command {send butchan go} "+font); tkcmd(top, "button "+f+".bc -text {Clear} -command {send butchan new} "+font); tkcmd(top, "grid "+f+".bs -row 3 -column 0 -sticky e -padx 2 -pady 5"); tkcmd(top, "grid "+f+".bc -row 3 -column 1 -sticky w -pady 5"); tkcmd(top, "label "+f+".la1 -text {name} -bg white "+fontb); tkcmd(top, "label "+f+".la2 -text {value} -bg white "+fontb); tkcmd(top, "grid "+f+".la1 "+f+".la2 -row 1"); insertattribrow(top); } insertattribrow(top: ref Tk->Toplevel) { (n, nil) := sys->tokenize(tkcmd(top, "grid slaves .fsearch -column 1"), " \t\n"); row := string (n); sn := string (n - 2); fsn := ".fsearch.ean"+sn; fsv := ".fsearch.eav"+sn; font := " -font /fonts/charon/plain.normal.font"; tkcmd(top, "entry "+fsn+" -width 170 -borderwidth 0 "+font); tkcmd(top, "bind "+fsn+" <Key> {send butchan key "+sn+" n %s}"); tkcmd(top, "entry "+fsv+" -width 170 -borderwidth 0 "+font); tkcmd(top, "bind "+fsv+" <Key> {send butchan key "+sn+" v %s}"); tkcmd(top, "grid rowinsert .fsearch "+row); tkcmd(top, "grid "+fsn+" -column 0 -row "+row+" -sticky w -pady 1 -padx 2"); tkcmd(top, "grid "+fsv+" -column 1 -row "+row+" -sticky w -pady 1"); setscrollr(top, ".fsearch"); } min(a,b: int): int { if (a < b) return a; return b; } max(a,b: int): int { if (a > b) return a; return b; } makeresultsframe(top: ref Tk->Toplevel, lsrv: list of ref Service, resultstart, maxresults: int) { font := " -font /fonts/charon/plain.normal.font"; fontb := " -font /fonts/charon/bold.normal.font"; f := ".fresults"; nresults := len lsrv; row := 0; n := 0; tk->cmd(top, "destroy "+f); tkcmd(top, "frame "+f+" -bg white"); title := "Search Results"; if (nresults > 0) { from := resultstart+1; too := min(resultstart+maxresults, nresults); if (from == too) title += sys->sprint(" (displaying match %d of %d)", from, nresults); else title += sys->sprint(" (displaying matches %d - %d of %d)", from, too, nresults); } tkcmd(top, "label "+f+".l -text {"+title+"} -bg white -anchor w" + fontb); w1 := int tkcmd(top, f+".l cget -width"); w2 := int tkcmd(top, ".f.c cget -width"); tkcmd(top, f+".l configure -width "+string max(w1,w2)); tkcmd(top, "grid "+f+".l -row 0 -column 0 -columnspan 3 -sticky nw"); tkcmd(top, "grid rowconfigure "+f+" 0 -minsize 30"); tkcmd(top, "frame "+f+".f -bg white"); for (; lsrv != nil; lsrv = tl lsrv) { if (n >= resultstart && n < resultstart + maxresults) { srvc := hd lsrv; (resource, name) := getresname(srvc); qid := getqid(srvc); if (qid == nil) qid = string addqid(srvc); label := f+".f.lQ"+qid; tkcmd(top, "label "+label+" -bg white -text {services/"+ resource+"/"+name+"/}"+font); tkcmd(top, "grid "+label+" -row "+string row+" -column 0 -sticky w"); tkcmd(top, "bind "+label+" <Button-1> {send butchan select "+label+" "+qid+"}"); row++; } n++; } if (nresults == 0) { tkcmd(top, "label "+f+".f.l0 -bg white -text {No matches found}"+font); tkcmd(top, "grid "+f+".f.l0 -row 0 -column 0 -columnspan 3 -sticky w"); } else { tkcmd(top, "button "+f+".bprev -text {<<} "+ "-command {send butchan prev}"+font); if (resultstart == 0) tkcmd(top, f+".bprev configure -state disabled"); tkcmd(top, "button "+f+".bnext -text {>>} "+ "-command {send butchan next}"+font); if (resultstart + maxresults >= nresults) tkcmd(top, f+".bnext configure -state disabled"); tkcmd(top, "grid "+f+".bprev -column 0 -row 2 -padx 5 -pady 5"); tkcmd(top, "grid "+f+".bnext -column 2 -row 2 -padx 5 -pady 5"); } tkcmd(top, "grid "+f+".f -row 1 -column 0 -columnspan 3 -sticky nw"); tkcmd(top, "grid rowconfigure "+f+" 1 -minsize "+string (maxresults*17)); tkcmd(top, "button "+f+".bsearch -text {Back to Search} "+ "-command {send butchan backto}"+font); tkcmd(top, "grid "+f+".bsearch -column 1 -row 2 -padx 5 -pady 5"); } focus(top: ref Tk->Toplevel, newtkp: string) { tkcmd(top, "focus "+newtkp); x1 := int tkcmd(top, newtkp + " cget -actx") - int tkcmd(top, ".fsearch cget -actx"); y1 := int tkcmd(top, newtkp + " cget -acty") - int tkcmd(top, ".fsearch cget -acty"); x2 := x1 + int tkcmd(top, newtkp + " cget -width"); y2 := y1 + int tkcmd(top, newtkp + " cget -height") + 45; tkcmd(top, sys->sprint(".f.c see %d %d %d %d", x1,y1-30,x2,y2)); } search(top: ref Tk->Toplevel, filter: list of list of (string, string)): list of ref Service { searchattrib: list of (string, string) = nil; (n, nil) := sys->tokenize(tkcmd(top, "grid slaves .fsearch -column 0"), " \t\n"); for (i := 0; i < n - 3; i++) { attrib := tkcmd(top, ".fsearch.ean"+string i+" get"); val := tkcmd(top, ".fsearch.eav"+string i+" get"); if (val == nil) val = "*"; if (attrib != nil) searchattrib = (attrib, val) :: searchattrib; } tmp : list of list of (string, string) = nil; for (; filter != nil; filter = tl filter) { l := hd filter; for (tmp2 := searchattrib; tmp2 != nil; tmp2 = tl tmp2) l = hd tmp2 :: l; tmp = l :: tmp; } filter = tmp; if (filter == nil) filter = searchattrib :: nil; return find(filter); } getitem(l : list of (string, ref Service), testid: string): ref Service { for (; l != nil; l = tl l) { (id, srvc) := hd l; if (testid == id) return srvc; } return nil; } delitem(l : list of (string, ref Service), testid: string): list of (string, ref Service) { l2 : list of (string, ref Service) = nil; for (; l != nil; l = tl l) { (id, srvc) := hd l; if (testid != id) l2 = (id, srvc) :: l2; } return l2; } resetsearchscr(top: ref Tk->Toplevel) { (n, nil) := sys->tokenize(tkcmd(top, "grid slaves .fsearch -column 1"), " \t\n"); for (i := 1; i < n - 2; i++) tkcmd(top, "destroy .fsearch.ean"+string i+" .fsearch.eav"+string i); s := " delete 0 end"; tkcmd(top, ".fsearch.ean0"+s); tkcmd(top, ".fsearch.eav0"+s); } 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]); }