diff options
| author | Charles.Forsyth <devnull@localhost> | 2006-12-22 17:07:39 +0000 |
|---|---|---|
| committer | Charles.Forsyth <devnull@localhost> | 2006-12-22 17:07:39 +0000 |
| commit | 37da2899f40661e3e9631e497da8dc59b971cbd0 (patch) | |
| tree | cbc6d4680e347d906f5fa7fca73214418741df72 /appl/grid/lib | |
| parent | 54bc8ff236ac10b3eaa928fd6bcfc0cdb2ba46ae (diff) | |
20060303a
Diffstat (limited to 'appl/grid/lib')
| -rw-r--r-- | appl/grid/lib/announce.b | 42 | ||||
| -rw-r--r-- | appl/grid/lib/browser.b | 1178 | ||||
| -rw-r--r-- | appl/grid/lib/browser.m | 97 | ||||
| -rw-r--r-- | appl/grid/lib/fbrowse.b | 390 | ||||
| -rw-r--r-- | appl/grid/lib/mkfile | 27 | ||||
| -rw-r--r-- | appl/grid/lib/pathreader.m | 3 | ||||
| -rw-r--r-- | appl/grid/lib/srvbrowse.b | 719 |
7 files changed, 2456 insertions, 0 deletions
diff --git a/appl/grid/lib/announce.b b/appl/grid/lib/announce.b new file mode 100644 index 00000000..b29dfe42 --- /dev/null +++ b/appl/grid/lib/announce.b @@ -0,0 +1,42 @@ +implement Announce; +include "sys.m"; + sys: Sys; +include "grid/announce.m"; + +init() +{ + sys = load Sys Sys->PATH; +} + +announce(): (string, ref Sys->Connection) +{ + sysname := readfile("/dev/sysname"); + (ok, c) := sys->announce("tcp!*!0"); + if(ok == -1) + return (nil, nil); + local := readfile(c.dir + "/local"); + if(local == nil) + return (nil, nil); + for(i := len local - 1; i >= 0; i--) + if(local[i] == '!') + break; + port := local[i+1:]; + if(port == nil) + return (nil, nil); + if(port[len port - 1] == '\n') + port = port[0:len port - 1]; + return ("tcp!" + sysname + "!" + port, ref c); +} + + +readfile(f: string): string +{ + fd := sys->open(f, Sys->OREAD); + if (fd == nil) + return nil; + buf := array[8192] of byte; + n := sys->read(fd, buf, len buf); + if (n <= 0) + return nil; + return string buf[0:n]; +} diff --git a/appl/grid/lib/browser.b b/appl/grid/lib/browser.b new file mode 100644 index 00000000..c6de92cf --- /dev/null +++ b/appl/grid/lib/browser.b @@ -0,0 +1,1178 @@ +implement Browser; + +# +# 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 "./pathreader.m"; +include "./browser.m"; + +entryheight := ""; + +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(); +} + +Browse.new(top: ref Tk->Toplevel, tkchanname, root, rlabel: string, nopanes: int, reader: PathReader): ref Browse +{ + b : Browse; + b.top = top; + b.tkchan = tkchanname; + if (nopanes < 1 || nopanes > 2) + return nil; + b.nopanes = 2; + b.bgnorm = bgnorm; + b.bgselect = bgselect; + b.selected = array[2] of { * => Selected (File(nil, nil), nil) }; + b.opened = (root, nil) :: nil; + if (root == nil) + return nil; + if (root[len root - 1] != '/') + root[len root] = '/'; + b.pane0width = "2 3"; + b.root = root; + b.rlabel = rlabel; + b.reader = reader; + b.pane1 = File (nil, "-123"); + b.released = 1; + tkcmds(top, pane0scr); + + tkcmds(top, pane1scr); + tkcmd(top, "bind .fbrowse.lmov <Button-1> {send "+b.tkchan+" movdiv %X}"); + + size := tkcmd(top, "grid size .fbrowse"); + p := isat(size, " "); + tkcmd(top, "label .fbrowse.l -text { } -anchor w -width 0" + + " -font /fonts/charon/plain.normal.font"); + tkcmd(top, ".fbrowse.l configure -height "+tkcmd(top, ".fbrowse.l cget -height")); + tkcmd(top, "grid .fbrowse.l -row 0 -column 0 -sticky ew -pady 2 -columnspan 4"); + rb := ref b; + rb.newroot(b.root, b.rlabel); + rb.changeview(nopanes); + setbrowsescrollr(rb); + return rb; +} + +Browse.refresh(b: self ref Browse) +{ + scrval := tkcmd(b.top, ".fbrowse.sy1 get"); + p := isat(scrval, " "); + p1 := b.pane1; + b.newroot(b.root, b.rlabel); + setbrowsescrollr(b); + if (b.nopanes == 2) + popdirpane1(b, p1); + b.selectfile(1,DESELECT, File (nil, nil), nil); + b.selectfile(0,DESELECT, File (nil, nil), nil); + tkcmd(b.top, ".fbrowse.c1 yview moveto "+scrval[:p]+"; update"); +} + +bgnorm := "white"; +bgselect := "#5555FF"; + +ft := " -font /fonts/charon/plain.normal.font"; +fts := " -font /fonts/charon/plain.tiny.font"; +ftb := " -font /fonts/charon/bold.normal.font"; + +Browse.gotoselectfile(b: self ref Browse, file: File): string +{ + (dir, tkpath) := b.gotopath(file, 0); + if (tkpath == nil) + return nil; + # Select dir + tkpath += ".l"; + if (dir.qid != nil) + tkpath += "Q" + dir.qid; + b.selectfile(0, SELECT, dir, tkpath); + + # If it is a file, select the file too + if (!File.eq(file, dir)) { + slaves := tkcmd(b.top, "grid slaves .fbrowse.fl2"); + (nil, lst) := sys->tokenize(slaves, " "); + for (; lst != nil; lst = tl lst) { + if (File.eq(file, *b.getpath(hd lst))) { + b.selectfile(1, SELECT, file, hd lst); + tkpath = hd lst; + break; + } + } + pane1see(b); + } + return tkpath; +} + +pane1see(b: ref Browse) +{ + f := b.selected[1].tkpath; + if (f == "") + return; + x1 := int tkcmd(b.top, f+" cget -actx") - int tkcmd(b.top, ".fbrowse.fl2 cget -actx"); + y1 := int tkcmd(b.top, f+" cget -acty") - int tkcmd(b.top, ".fbrowse.fl2 cget -acty"); + x2 := x1 + int tkcmd(b.top, f+" cget -actwidth"); + y2 := y1 + int tkcmd(b.top, f+" cget -actheight"); + tkcmd(b.top, sys->sprint(".fbrowse.c2 see %d %d %d %d", x1,y1,x2,y2)); +} + +Browse.opendir(b: self ref Browse, file: File, tkpath: string, action: int): int +{ + curr := tkcmd(b.top, tkpath+".lp cget -text"); + if ((action == OPEN || action == TOGGLE) && curr == "+") { + tkcmd(b.top, tkpath+".lp configure -text {-} -relief sunken"); + popdirpane0(b, file, tkpath); + seeframe(b.top, tkpath); + b.addopened(file, 1); + setbrowsescrollr(b); + return 1; + } + else if ((action == CLOSE || action == TOGGLE) && curr == "-") { + tkcmd(b.top, tkpath+".lp configure -text {+} -relief raised"); + slaves := tkcmd(b.top, "grid slaves "+tkpath+" -column 1"); + p := isat(slaves, " "); + if (p != -1) + tkcmd(b.top, "destroy "+slaves[p:]); + slaves = tkcmd(b.top, "grid slaves "+tkpath+" -column 2"); + if (slaves != "") + tkcmd(b.top, "destroy "+slaves); + b.addopened(file, 0); + setbrowsescrollr(b); + return 1; + } + return 0; +} + +Browse.addopened(b: self ref Browse, file: File, add: int) +{ + tmp : list of File = nil; + for (; b.opened != nil; b.opened = tl b.opened) { + dir := hd b.opened; + if (!File.eq(file, dir)) + tmp = dir :: tmp; + } + if (add) + tmp = file :: tmp; + b.opened = tmp; +} + +Browse.changeview(b: self ref Browse, nopanes: int) +{ + if (b.nopanes == nopanes) + return; + w := int tkcmd(b.top, ".fbrowse cget -actwidth"); + ws := int tkcmd(b.top, ".fbrowse.sy1 cget -width"); + if (nopanes == 1) { + b.pane0width = tkcmd(b.top, ".fbrowse.c1 cget -actwidth") + " " + + tkcmd(b.top, ".fbrowse.c2 cget -actwidth"); + tkcmd(b.top, "grid forget .fbrowse.sx2 .fbrowse.c2 .fbrowse.lmov"); + tkcmd(b.top, "grid columnconfigure .fbrowse 3 -weight 0"); + } + else { + (nil, wlist) := sys->tokenize(b.pane0width, " "); + tkcmd(b.top, "grid columnconfigure .fbrowse 1 -weight "+hd wlist); + tkcmd(b.top, "grid columnconfigure .fbrowse 3 -weight "+hd tl wlist); + + tkcmd(b.top, "grid .fbrowse.sx2 -row 3 -column 3 -sticky ew"); + tkcmd(b.top, "grid .fbrowse.c2 -row 2 -column 3 -sticky nsew"); + tkcmd(b.top, "grid .fbrowse.lmov -row 2 -column 2 -rowspan 2 -sticky ns"); + } + b.nopanes = nopanes; +} + +Browse.selectfile(b: self ref Browse, pane, action: int, file: File, tkpath: string) +{ + if (action == SELECT && b.selected[pane].tkpath == tkpath) + return; + if (b.selected[pane].tkpath != nil) + tk->cmd(b.top, b.selected[pane].tkpath+" configure -bg "+bgnorm); + if ((action == TOGGLE && b.selected[pane].tkpath == tkpath) || action == DESELECT) { + if (pane == 0) + popdirpane1(b, File (nil,nil)); + b.selected[pane] = (File(nil, nil), nil); + return; + } + b.selected[pane] = (file, tkpath); + tkcmd(b.top, tkpath+" configure -bg "+bgselect); + if (pane == 0) + popdirpane1(b, file); +} + +Browse.resize(b: self ref Browse) +{ + p1 := b.pane1; + b.pane1 = File (nil, nil); + + if (p1.path != "") + popdirpane1(b, p1); + + if (b.selected[1].tkpath != nil) { + s := b.selected[1]; + b.selectfile(1, DESELECT, s.file, s.tkpath); + b.selectfile(1, SELECT, s.file, s.tkpath); + } +} + +setbrowsescrollr(b: ref Browse) +{ + h := tkcmd(b.top, ".fbrowse.fl cget -height"); + w := tkcmd(b.top, ".fbrowse.fl cget -width"); + tkcmd(b.top, ".fbrowse.c1 configure -scrollregion {0 0 "+w+" "+h+"}"); + if (b.nopanes == 2) { + h = tkcmd(b.top, ".fbrowse.fl2 cget -height"); + w = tkcmd(b.top, ".fbrowse.fl2 cget -width"); + tkcmd(b.top, ".fbrowse.c2 configure -scrollregion {0 0 "+w+" "+h+"}"); + } +} + +seeframe(top: ref Tk->Toplevel, frame: string) +{ + x := int tkcmd(top, frame+" cget -actx") - int tkcmd(top, ".fbrowse.fl cget -actx"); + y := int tkcmd(top, frame+" cget -acty") - int tkcmd(top, ".fbrowse.fl cget -acty"); + w := int tkcmd(top, frame+" cget -width"); + h := int tkcmd(top, frame+" cget -height"); + wc := int tkcmd(top, ".fbrowse.c1 cget -width"); + hc := int tkcmd(top, ".fbrowse.c1 cget -height"); + if (w > wc) + w = wc; + if (h > hc) + h = hc; + tkcmd(top, sys->sprint(".fbrowse.c1 see %d %d %d %d",x,y,x+w,y+h)); +} + +# Goes to selected dir OR dir containing selected file +Browse.gotopath(b: self ref Browse, file: File, openfinal: int): (File, string) +{ + tkpath := ".fbrowse.fl.f0"; + path := b.root; + testqid := ""; + testpath := ""; + close : list of string; + trackbacklist : list of (string, list of string, list of string) = nil; + trackback := 0; + enddir := ""; + endfile := ""; + filetkpath := ""; + if (file.path[len file.path - 1] != '/') { + # i.e. is not a directory + p := isatback(file.path, "/"); + enddir = file.path[:p + 1]; + } + if (enddir == path) { + if (!dircontainsfile(b, File (path, nil), file)) + return (File (nil, nil), nil); + } + else { + for(;;) { + lst : list of string; + if (trackback) { + (path, lst, close) = hd trackbacklist; + trackbacklist = tl trackbacklist; + if (close != nil) + b.opendir(File (hd close, hd tl close), hd tl tl close, CLOSE); + trackback = 0; + } + else { + frames := tkcmd(b.top, "grid slaves "+tkpath+" -column 1"); + (nil, lst) = sys->tokenize(frames, " "); + if (lst != nil) + lst = tl lst; # ignore first frame (name of parent dir); + } + found := 0; + hasdups := 1; + for (; lst != nil; lst = tl lst) { + testpath = path; + if (hasdups) { + labels := tkcmd(b.top, "grid slaves "+hd lst+" -row 0"); + (nil, lst2) := sys->tokenize(labels, " "); + testpath += tkcmd(b.top, hd tl lst2+" cget -text") + "/"; + testqid = getqidfromlabel(hd tl lst2); + if (testqid == nil) + hasdups = 0; + } + else + testpath += tkcmd(b.top, hd lst+".l cget -text") + "/"; + if (len testpath <= len file.path && file.path[:len testpath] == testpath) { + opened := 0; + close = nil; + if (openfinal || testpath != file.path) + opened = b.opendir(File(testpath, testqid), hd lst, OPEN); + if (opened) + close = testpath :: testqid :: hd lst :: nil; + if (tl lst != nil && hasdups) + trackbacklist = (path, tl lst, close) :: trackbacklist; + tkpath = hd lst; + path = testpath; + found = 1; + break; + } + } + if (enddir != nil && path == enddir) + if (dircontainsfile(b, File(testpath, testqid), file)) + break; + if (!found) { + if (trackbacklist == nil) + return (File (nil, nil), nil); + trackback = 1; + } + else if (testpath == file.path && testqid == file.qid) + break; + } + } + seeframe(b.top, tkpath); + dir := File (path, testqid); + popdirpane1(b, dir); + return (dir, tkpath); +} + +dircontainsfile(b: ref Browse, dir, file: File): int +{ + (files, hasdups) := b.reader->readpath(dir); + for (j := 0; j < len files; j++) { + if (files[j].name == file.path[len dir.path:] && + (!hasdups || files[j].qid.path == big file.qid)) + return 1; + } + return 0; +} + +Browse.getpath(b: self ref Browse, f: string): ref File +{ + if (len f < 11 || f[:11] != ".fbrowse.fl") + return nil; + (nil, lst) := sys->tokenize(f, "."); + lst = tl lst; + if (hd lst == "fl2") { + # i.e. is in pane 1 + qid := getqidfromlabel(f); + return ref File (b.pane1.path + tk->cmd(b.top, f+" cget -text"), qid); + } + tkpath := ".fbrowse.fl.f0"; + path := b.root; + lst = tl tl lst; + started := 0; +# sys->print("getpath: %s %s\n",tkpath, path); + qid := ""; + for (; lst != nil; lst = tl lst) { + tkpath += "."+hd lst; + if ((hd lst)[0] == 'l') { + qid = getqidfromlabel(tkpath); + if (qid != nil) + qid = "Q" + qid; + if (len hd lst - len qid > 1) + path += tk->cmd(b.top, tkpath+" cget -text"); + } + else if ((hd lst)[0] == 'f') { + qid = getqidfromframe(b,tkpath); + if (qid != nil) + qid = "Q"+qid; + path += tk->cmd(b.top, tkpath+".l"+qid+" cget -text") + "/"; + } +# sys->print("getpath: %s %s\n",tkpath, path); + } + # Temporary hack! + if (qid != nil) + qid = qid[1:]; + return ref File (path, qid); +} + +setroot(b: ref Browse, rlabel, root: string) +{ + b.root = root; + b.rlabel = rlabel; + makedir(b, File (root, nil), ".fbrowse.fl.f0", rlabel, "0"); + tkcmd(b.top, "grid forget .fbrowse.fl.f0.lp"); +} + +getqidfromframe(b: ref Browse, frame: string): string +{ + tmp := tkcmd(b.top, "grid slaves "+frame+" -row 0"); + (nil, lst) := sys->tokenize(tmp, " \t\n"); + if (lst == nil) + return nil; + return getqidfromlabel(hd tl lst); +} + +getqidfromlabel(label: string): string +{ + p := isatback(label, "Q"); + if (p != -1) + return label[p+1:]; + return nil; +} + +popdirpane0(b: ref Browse, dir : File, frame: string) +{ + (dirs, hasdups) := b.reader->readpath(dir); + for (i := 0; i < len dirs; i++) { + si := string i; + f : string; + dirqid := string dirs[i].qid.path; + if (!hasdups) + dirqid = nil; + if (dirs[i].mode & sys->DMDIR) { + f = frame + ".f"+si; + makedir(b, File (dir.path+dirs[i].name, dirqid), f, dirs[i].name, string (i+1)); + } + else { + if (b.nopanes == 1) { + f = frame + ".l"+si; + makefile(b, f, dirs[i].name, string (i+1), dirqid); + } + } + } + dirs = nil; +} + +isopened(b: ref Browse, dir: File): int +{ + for (tmp := b.opened; tmp != nil; tmp = tl tmp) { + if (File.eq(hd tmp, dir)) + return 1; + } + return 0; +} + +makefile(b: ref Browse, f, name, row, qid: string) +{ + if (qid != nil) + f += "Q" + qid; + bgcol := bgnorm; +# if (f == selected[0].t1) +# bgcol = bgselect; + p := isat(name, "\0"); + if (p != -1) { + tkcmd(b.top, "label "+f+" -text {"+name[:p]+"} -bg "+bgcol+ft); + tkcmd(b.top, "label "+f+"b -text {"+name[p+1:]+"} -bg "+bgcol+ft); + tkcmd(b.top, "grid "+f+" -row "+row+" -column 1 -sticky w -padx 5 -pady 2"); + tkcmd(b.top, "grid "+f+"b -row "+row+" -column 2 -sticky w -pady 2"); + tkcmd(b.top, "bind "+f+" <Button-2> {send "+b.tkchan+" but2pane1 "+f+"}"); + tkcmd(b.top, "bind "+f+" <ButtonRelease-2> {send "+b.tkchan+" release}"); + } + else { + tkcmd(b.top, "label "+f+" -text {"+name+"} -bg "+bgcol+ft); + tkcmd(b.top, "grid "+f+" -row "+row+" -column 1 -sticky w -padx 5 -pady 2"); + } + tkcmd(b.top, "bind "+f+" <Button-1> {send "+b.tkchan+" but1pane0 "+f+"}"); + tkcmd(b.top, "bind "+f+" <ButtonRelease-1> {send "+b.tkchan+" release}"); + tkcmd(b.top, "bind "+f+" <Button-2> {send "+b.tkchan+" but2pane0 "+f+"}"); + tkcmd(b.top, "bind "+f+" <ButtonRelease-2> {send "+b.tkchan+" release}"); + tkcmd(b.top, "bind "+f+" <Button-3> {send "+b.tkchan+" but3pane0 "+f+"}"); + tkcmd(b.top, "bind "+f+" <ButtonRelease-3> {send "+b.tkchan+" release}"); +} + +Browse.defaultaction(b: self ref Browse, lst: list of string, rfile: ref File) +{ + tkpath: string; + file: File; + if (len lst > 1) { + tkpath = hd tl lst; + if (len tkpath > 11 && tkpath[:11] == ".fbrowse.fl") { + if (rfile == nil) + file = *b.getpath(tkpath); + else + file = *rfile; + } + } + case hd lst { + "release" => + b.released = 1; + "open" or "double1pane0" => + if (file.path == b.root) + break; + if (b.released) { + b.selectfile(0, DESELECT, File(nil, nil), nil); + b.selectfile(1, DESELECT, File(nil, nil), nil); + b.opendir(file, prevframe(tkpath), TOGGLE); + b.selectfile(0, SELECT, file, tkpath); + b.released = 0; + } + "double1pane1" => + b.gotoselectfile(file); + "but1pane0" => + if (b.released) { + b.selectfile(1, DESELECT, File(nil, nil), nil); + b.selectfile(0, TOGGLE, file, tkpath); + b.released = 0; + } + "but1pane1" => + if (b.released) { + b.selectfile(1, TOGGLE, file, tkpath); + b.released = 0; + } + "movdiv" => + movdiv(b, int hd tl lst); + } +} + +prevframe(tkpath: string): string +{ + end := len tkpath; + for (;;) { + p := isatback(tkpath[:end], "."); + if (tkpath[p+1] == 'f') + return tkpath[:end]; + end = p; + } + return nil; +} + +makedir(b: ref Browse, dir: File, f, name, row: string) +{ + bgcol := bgnorm; + if (f == ".fbrowse.fl.f0") + dir = File (b.root, nil); +# if (name == "") +# name = path; + if (dir.path[len dir.path - 1] != '/') + dir.path[len dir.path] = '/'; + if (File.eq(dir, b.selected[0].file)) + bgcol = bgselect; + tkcmd(b.top, "frame "+f+" -bg white"); + label := f+".l"; + if (dir.qid != nil) + label += "Q" + dir.qid; + tkcmd(b.top, "label "+label+" -text {"+name+"} -bg "+bgcol+ftb); + if (isopened(b, dir)) { + popdirpane0(b, dir, f); + tkcmd(b.top, "label "+f+".lp -text {-} -borderwidth 1 -relief sunken -height 8 -width 8"+fts); + } + else tkcmd(b.top, "label "+f+".lp -text {+} -borderwidth 1 -relief raised -height 8 -width 8"+fts); + tkcmd(b.top, "bind "+label+" <Button-1> {send "+b.tkchan+" but1pane0 "+label+"}"); + tkcmd(b.top, "bind "+label+" <Double-Button-1> {send "+b.tkchan+" double1pane0 "+label+"}"); + tkcmd(b.top, "bind "+label+" <ButtonRelease-1> {send "+b.tkchan+" release}"); + tkcmd(b.top, "bind "+label+" <Button-3> {send "+b.tkchan+" but3pane0 "+label+"}"); + tkcmd(b.top, "bind "+label+" <ButtonRelease-3> {send "+b.tkchan+" release}"); + tkcmd(b.top, "bind "+label+" <Button-2> {send "+b.tkchan+" but2pane0 "+label+"}"); + tkcmd(b.top, "bind "+label+" <ButtonRelease-2> {send "+b.tkchan+" release}"); + + tkcmd(b.top, "bind "+f+".lp <Button-1> {send "+b.tkchan+" open "+label+"}"); + tkcmd(b.top, "bind "+f+".lp <ButtonRelease-1> {send "+b.tkchan+" release}"); + tkcmd(b.top, "grid "+f+".lp -row 0 -column 0"); + tkcmd(b.top, "grid "+label+" -row 0 -column 1 -sticky w -padx 5 -pady 2 -columnspan 2"); + tkcmd(b.top, "grid "+f+" -row "+row+" -column 1 -sticky w -padx 5 -columnspan 2"); +} + +popdirpane1(b: ref Browse, dir: File) +{ +# if (path == b.pane1.path && qid == b.pane1.qid) +# return; + b.pane1 = dir; + labelset(b, ".fbrowse.l", prevpath(dir.path+"/")); + if (b.nopanes == 1) + return; + tkcmd(b.top, "destroy .fbrowse.fl2; frame .fbrowse.fl2 -bg white"); + tkcmd(b.top, ".fbrowse.c2 create window 0 0 -window .fbrowse.fl2 -anchor nw"); + if (dir.path == nil) { + setbrowsescrollr(b); + return; + } + (dirs, hasdups) := b.reader->readpath(dir); +# if (path[len path - 1] == '/') +# path = path[:len path - 1]; +# tkcmd(b.top, "label .fbrowse.fl2.l -text {"+path+"}"); + row := 0; + col := 0; + tkcmd(b.top, ".fbrowse.c2 see 0 0"); + ni := 0; + n := (int tkcmd(b.top, ".fbrowse.c2 cget -actheight")) / 21; + for (i := 0; i < len dirs; i++) { + + f := ".fbrowse.fl2.l"+string ni; + if (hasdups) + f += "Q" + string dirs[i].qid.path; + name := dirs[i].name; + isdir := dirs[i].mode & sys->DMDIR; + if (isdir) + name[len name]= '/'; + bgcol := bgnorm; + # Sort this out later + # if (path+"/"+name == selected[1].t0) { + # bgcol = bgselect; + # selected[1].t1 = f; + #} + tkcmd(b.top, "label "+f+" -text {"+name+"} -bg "+bgcol+ft); + tkcmd(b.top, "bind "+f+" <Double-Button-1> {send "+b.tkchan+" double1pane1 "+f+"}"); + tkcmd(b.top, "bind "+f+" <Button-1> {send "+b.tkchan+" but1pane1 "+f+"}"); + tkcmd(b.top, "bind "+f+" <ButtonRelease-1> {send "+b.tkchan+" release}"); + tkcmd(b.top, "bind "+f+" <Button-3> {send "+b.tkchan+" but3pane1 "+f+" %X %Y}"); + tkcmd(b.top, "bind "+f+" <ButtonRelease-3> {send "+b.tkchan+" release}"); + tkcmd(b.top, "grid "+f+" -row "+string row+" -column "+string col+ + " -sticky w -padx 10 -pady 2"); + row++; + if (row >= n) { + row = 0; + col++; + } + ni++; + } + + dirs = nil; + setbrowsescrollr(b); +} + +pane0scr := array[] of { + "frame .fbrowse", + + "scrollbar .fbrowse.sy1 -command {.fbrowse.c1 yview}", + "scrollbar .fbrowse.sx1 -command {.fbrowse.c1 xview} -orient horizontal", + "canvas .fbrowse.c1 -yscrollcommand {.fbrowse.sy1 set} -xscrollcommand {.fbrowse.sx1 set} -bg white -width 50 -height 20 -borderwidth 2 -relief sunken -xscrollincrement 10 -yscrollincrement 21", + "grid .fbrowse.sy1 -row 2 -column 0 -sticky ns -rowspan 2", + "grid .fbrowse.sx1 -row 3 -column 1 -sticky ew", + "grid .fbrowse.c1 -row 2 -column 1 -sticky nsew", + "grid rowconfigure .fbrowse 2 -weight 1", + "grid columnconfigure .fbrowse 1 -weight 2", + +}; + +pane1scr := array[] of { +# ".fbrowse.c1 configure -width 146", + "frame .fbrowse.fl2 -bg white", + "label .fbrowse.fl2.l -text {}", + "scrollbar .fbrowse.sx2 -command {.fbrowse.c2 xview} -orient horizontal", + "label .fbrowse.lmov -text { } -relief sunken -borderwidth 2 -width 5", + + "canvas .fbrowse.c2 -xscrollcommand {.fbrowse.sx2 set} -bg white -width 50 -height 20 -borderwidth 2 -relief sunken -xscrollincrement 10 -yscrollincrement 21", + ".fbrowse.c2 create window 0 0 -window .fbrowse.fl2 -anchor nw", + "grid .fbrowse.sx2 -row 3 -column 3 -sticky ew", + "grid .fbrowse.c2 -row 2 -column 3 -sticky nsew", + "grid .fbrowse.lmov -row 2 -column 2 -rowspan 2 -sticky ns", + "grid columnconfigure .fbrowse 3 -weight 3", +}; + +Browse.newroot(b: self ref Browse, root, rlabel: string) +{ + tk->cmd(b.top, "destroy .fbrowse.fl"); + tkcmd(b.top, "frame .fbrowse.fl -bg white"); + tkcmd(b.top, ".fbrowse.c1 create window 0 0 -window .fbrowse.fl -anchor nw"); + b.pane1 = File (root, nil); + setroot(b, rlabel, root); + setbrowsescrollr(b); +} + +Browse.showpath(b: self ref Browse, on: int) +{ + if (on == b.showpathlabel) + return; + if (on) { + b.showpathlabel = 1; + if (b.pane1.path != nil) + labelset(b, ".fbrowse.l", prevpath(b.pane1.path+"/")); + } + else { + b.showpathlabel = 0; + tkcmd(b.top, ".fbrowse.l configure -text {}"); + } +} + +Browse.getselected(b: self ref Browse, pane: int): File +{ + return b.selected[pane].file; +} + +labelset(b: ref Browse, label, text: string) +{ + if (!b.showpathlabel) + return; + if (text != nil) { + tmp := b.rlabel; + if (tmp[len tmp - 1] != '/') + tmp[len tmp] = '/'; + text = tmp + text[len b.root:]; + } + tkcmd(b.top, label + " configure -text {"+text+"}"); +} + +movdiv(b: ref Browse, x: int) +{ + x1 := int tkcmd(b.top, ".fbrowse.lmov cget -actx"); + x2 := x1 + int tkcmd(b.top, ".fbrowse.lmov cget -width"); + diff := 0; + if (x < x1) + diff = x - x1; + if (x > x2) + diff = x - x2; + if (abs(diff) > 5) { + w1 := int tkcmd(b.top, ".fbrowse.c1 cget -actwidth"); + w2 := int tkcmd(b.top, ".fbrowse.c2 cget -actwidth"); + if (w1 + diff < 36) + diff = 36 - w1; + if (w2 - diff < 36) + diff = w2 - 36; + w1 += diff; + w2 -= diff; + # sys->print("w1: %d w2: %d\n",w1,w2); + tkcmd(b.top, "grid columnconfigure .fbrowse 1 -weight "+string w1); + tkcmd(b.top, "grid columnconfigure .fbrowse 3 -weight "+string w2); + } +} + + +dialog(ctxt: ref draw->Context, oldtop: ref Tk->Toplevel, butlist: list of string, title, msg: string): int +{ + (top, titlebar) := tkclient->toplevel(ctxt, "", title, tkclient->Popup); + butchan := chan of string; + tk->namechan(top, butchan, "butchan"); + tkcmd(top, "frame .f"); + tkcmd(top, "label .f.l -text {"+msg+"} -font /fonts/charon/plain.normal.font"); + tkcmd(top, "bind .Wm_t <Button-1> +{focus .}"); + tkcmd(top, "bind .Wm_t.title <Button-1> +{focus .}"); + + l := len butlist; + tkcmd(top, "grid .f.l -row 0 -column 0 -columnspan "+string l+" -sticky w -padx 10 -pady 5"); + i := 0; + for(; butlist != nil; butlist = tl butlist) { + si := string i; + tkcmd(top, "button .f.b"+si+" -text {"+hd butlist+"} "+ + "-font /fonts/charon/plain.normal.font -command {send butchan "+si+"}"); + tkcmd(top, "grid .f.b"+si+" -row 1 -column "+si+" -padx 5 -pady 5"); + i++; + } + placement := ""; + if (oldtop != nil) { + setcentre(oldtop, top); + placement = "exact"; + } + tkcmd(top, "pack .f; update; focus ."); + tkclient->onscreen(top, placement); + tkclient->startinput(top, "kbd"::"ptr"::nil); + for (;;) { + alt { + s := <-top.ctxt.kbd => + tk->keyboard(top, s); + s := <-top.ctxt.ptr => + tk->pointer(top, *s); + inp := <- butchan => + tkcmd(oldtop, "focus ."); + return int inp; + title = <-top.ctxt.ctl or + title = <-top.wreq or + title = <-titlebar => + if (title == "exit") { + tkcmd(oldtop, "focus ."); + return -1; + } + tkclient->wmctl(top, title); + } + } +} +######################## Select Functions ######################### + + +setselectscrollr(s: ref Select, f: string) +{ + h := tkcmd(s.top, f+" cget -height"); + w := tkcmd(s.top, f+" cget -width"); + tkcmd(s.top, ".fselect.c configure -scrollregion {0 0 "+w+" "+h+"}"); +} + +Select.setscrollr(s: self ref Select, fname: string) +{ + frame := getframe(s, fname); + if (frame != nil) + setselectscrollr(s,frame.path); +} + +Select.new(top: ref Tk->Toplevel, tkchanname: string): ref Select +{ + s: Select; + s.top = top; + s.tkchan = tkchanname; + s.frames = nil; + s.currfname = nil; + s.currfid = nil; + tkcmds(top, selectscr); + if (entryheight == nil) { + tkcmd(top, "entry .fselect.test"); + entryheight = " -height " + tkcmd(top, ".fselect.test cget -height"); + tkcmd(top, "destroy .fselect.test"); + } + for (i := 1; i < 4; i++) + tkcmd(top, "bind .fselect.c <ButtonRelease-"+string i+"> {send "+s.tkchan+" release}"); + return ref s; +} + +selectscr := array[] of { + "frame .fselect", + "scrollbar .fselect.sy -command {.fselect.c yview}", + "scrollbar .fselect.sx -command {.fselect.c xview} -orient horizontal", + "canvas .fselect.c -yscrollcommand {.fselect.sy set} -xscrollcommand {.fselect.sx set} -bg white -width 414 -borderwidth 2 -relief sunken -height 180 -xscrollincrement 10 -yscrollincrement 19", + + "grid .fselect.sy -row 0 -column 0 -sticky ns -rowspan 2", + "grid .fselect.sx -row 1 -column 1 -sticky ew", + "grid .fselect.c -row 0 -column 1", +}; + +Select.addframe(s: self ref Select, fname, title: string) +{ + if (isat(fname, " ") != -1) + return; + f := ".fselect.f"+fname; + tkcmd(s.top, "frame "+f+" -bg white"); + if (title != nil){ + tkcmd(s.top, "label "+f+".l -text {"+title+"} -bg white "+ + "-font /fonts/charon/bold.normal.font; "+ + "grid "+f+".l -row 0 -column 0 -columnspan 3 -sticky w"); + } + fr: Frame; + fr.name = fname; + fr.path = f; + fr.selected = nil; + s.frames = ref fr :: s.frames; +} + +getframe(s: ref Select, fname: string): ref Frame +{ + for (tmp := s.frames; tmp != nil; tmp = tl tmp) + if ((hd tmp).name == fname) + return hd tmp; + return nil; +} + +Select.delframe(s: self ref Select, fname: string) +{ + if (s.currfname == fname) { + tkcmd(s.top, ".fselect.c delete " + s.currfid); + s.currfid = nil; + s.currfname = nil; + } + f := getframe(s,fname); + if (f != nil) { + tkcmd(s.top, "destroy "+f.path); + tmp: list of ref Frame = nil; + for (;s.frames != nil; s.frames = tl s.frames) { + if ((hd s.frames).name != fname) + tmp = hd s.frames :: tmp; + } + s.frames = tmp; + } +} + +Select.showframe(s: self ref Select, fname: string) +{ + if (s.currfid != nil) + tkcmd(s.top, ".fselect.c delete " + s.currfid); + f := getframe(s, fname); + if (f != nil) { + s.currfid = tkcmd(s.top, ".fselect.c create window 0 0 "+ + "-window "+f.path+" -anchor nw"); + s.currfname = fname; + } +} + +Select.addselection(s: self ref Select, fname, text: string, lp: list of ref Parameter, allowdups: int): string +{ + fr := getframe(s, fname); + if (fr == nil) + return nil; + f := fr.path; + if (!allowdups) { + slv := tkcmd(s.top, "grid slaves "+f+" -column 0"); + (nil, slaves) := sys->tokenize(slv, " \t\n"); + for (; slaves != nil; slaves = tl slaves) { + if (text == tkcmd(s.top, hd slaves+" cget -text")) + return nil; + } + } + font := " -font /fonts/charon/plain.normal.font"; + fontb := " -font /fonts/charon/bold.normal.font"; + (id, row) := newselected(s.top, f); + sid := string id; + label := f+".l"+sid; + tkcmd(s.top, "label "+label+" -text {"+text+"} -bg white"+entryheight+font); + gridpack := label+" "; + paramno := 0; + for (; lp != nil; lp = tl lp) { + spn := string paramno; + pframe := f+".f"+sid+"P"+spn; + tkcmd(s.top, "frame "+pframe+" -bg white"); + pick p := hd lp { + ArgIn => + tkp1 := pframe+".lA"; + tkp2 := pframe+".eA"; + + tkcmd(s.top, "label "+tkp1+" -text {"+p.name+"} "+ + "-bg white "+entryheight+fontb); + tkcmd(s.top, "entry "+tkp2+" -bg white -width 50 "+ + "-borderwidth 1"+entryheight+font); + if (p.initval != nil) + tkcmd(s.top, tkp2+" insert end {"+p.initval+"}"); + tkcmd(s.top, "grid "+tkp1+" "+tkp2+" -row 0"); + + IntIn => + tkp1 := pframe+".sI"; + tkp2 := pframe+".lI"; + tkcmd(s.top, "scale "+tkp1+" -showvalue 0 -orient horizontal -height 20"+ + " -from "+string p.min+" -to "+string p.max+" -command {send "+ + s.tkchan+" scale "+tkp2+"}"); + tkcmd(s.top, tkp1+" set "+string p.initval); + tkcmd(s.top, "label "+tkp2+" -text {"+string p.initval+"} "+ + "-bg white "+entryheight+fontb); + tkcmd(s.top, "grid "+tkp1+" "+tkp2+" -row 0"); + + } + gridpack += " "+pframe; + paramno++; + } + tkcmd(s.top, "grid "+gridpack+" -row "+row+" -sticky w"); + + sendstr := " " + label + " %X %Y}"; + tkcmd(s.top, "bind "+label+" <Double-Button-1> {send "+s.tkchan+" double1"+sendstr); + tkcmd(s.top, "bind "+label+" <Button-1> {send "+s.tkchan+" but1"+sendstr); + tkcmd(s.top, "bind "+label+" <ButtonRelease-1> {send "+s.tkchan+" release}"); + tkcmd(s.top, "bind "+label+" <Button-2> {send "+s.tkchan+" but2"+sendstr); + tkcmd(s.top, "bind "+label+" <ButtonRelease-2> {send "+s.tkchan+" release}"); + tkcmd(s.top, "bind "+label+" <Button-3> {send "+s.tkchan+" but3"+sendstr); + tkcmd(s.top, "bind "+label+" <ButtonRelease-3> {send "+s.tkchan+" release}"); + setselectscrollr(s, f); + if (s.currfname == fname) { + y := int tkcmd(s.top, label+" cget -acty") - + int tkcmd(s.top, f+" cget -acty"); + h := int tkcmd(s.top, label+" cget -height"); + tkcmd(s.top, ".fselect.c see 0 "+string (h+y)); + } + return label; +} + +newselected(top: ref Tk->Toplevel, frame: string): (int, string) +{ + (n, slaves) := sys->tokenize(tkcmd(top, "grid slaves "+frame+" -column 0"), " \t\n"); + id := 0; + slaves = tl slaves; # Ignore Title + for (;;) { + if (isin(slaves, frame+".l"+string id)) + id++; + else break; + } + return (id, string n); +} + +isin(l: list of string, test: string): int +{ + for(tmpl := l; tmpl != nil; tmpl = tl tmpl) + if (hd tmpl == test) + return 1; + return 0; +} + +Select.delselection(s: self ref Select, fname, tkpath: string) +{ + f := getframe(s, fname); + (row, nil) := getrowcol(s.top, tkpath); + slaves := tkcmd(s.top, "grid slaves "+f.path+" -row "+row); + # sys->print("row %s: deleting: %s\n",row,slaves); + tkcmd(s.top, "grid rowdelete "+f.path+" "+row); + tkcmd(s.top, "destroy "+slaves); + # Select the next one if the item deleted was selected + if (f.selected == tkpath) { + f.selected = nil; + for (;;) { + slaves = tkcmd(s.top, "grid slaves "+f.path+" -row "+row); + if (slaves != nil) + break; + r := (int row) - 1; + if (r < 1) + return; + row = string r; + } + (nil, lst) := sys->tokenize(slaves, " "); + if (lst != nil) + s.select(fname, hd lst, SELECT); + } +} + +getrowcol(top: ref Tk->Toplevel, s: string): (string, string) +{ + row := ""; + col := ""; + (nil, lst) := sys->tokenize(tkcmd(top, "grid info "+s), " \t\n"); + for (; lst != nil; lst = tl lst) { + if (hd lst == "-row") + row = hd tl lst; + else if (hd lst == "-column") + col = hd tl lst; + } + return (row, col); +} + +Select.select(s: self ref Select, fname, tkpath: string, action: int) +{ + f := getframe(s, fname); + if (action == SELECT && f.selected == tkpath) + return; + if (f.selected != nil) + tkcmd(s.top, f.selected+" configure -bg "+bgnorm); + if ((action == TOGGLE && f.selected == tkpath) || action == DESELECT) + f.selected = nil; + else { + tkcmd(s.top, tkpath+" configure -bg "+bgselect); + f.selected = tkpath; + } +} + +Select.defaultaction(s: self ref Select, lst: list of string) +{ + case hd lst { + "but1" => + s.select(s.currfname, hd tl lst, TOGGLE); + "scale" => + tkcmd(s.top, hd tl lst+" configure -text {"+hd tl tl lst+"}"); + } +} + +Select.getselected(s: self ref Select, fname: string): string +{ + retlist : list of (int, list of ref Parameter) = nil; + row := 1; + f := getframe(s, fname); + return f.selected; +} + +Select.getselection(s: self ref Select, fname: string): list of (string, list of ref Parameter) +{ + retlist : list of (string, list of ref Parameter) = nil; + row := 1; + f := getframe(s, fname); + for (;;) { + slaves := tkcmd(s.top, "grid slaves "+f.path+" -row "+string (row++)); + # sys->print("slaves: %s\n",slaves); + if (slaves == nil || slaves[0] == '!') + break; + (nil, lst) := sys->tokenize(slaves, " "); + pos := isatback(hd lst, "l"); + tkpath := hd lst; + lst = tl lst; + lp : list of ref Parameter = nil; + for (; lst != nil; lst = tl lst) { + pslaves := tkcmd(s.top, "grid slaves "+hd lst); + (nil, plist) := sys->tokenize(pslaves, " "); + # sys->print("slaves of %s - hd plist: '%s'\n",hd lst, hd plist); + case (hd plist)[len hd plist - 3:] { + ".eA" or ".lA" => + argname := tkcmd(s.top, hd lst+".lA cget -text"); + argval := tkcmd(s.top, hd lst+".eA get"); + lp = ref Parameter.ArgOut(argname, argval) :: lp; + ".sI" or ".lI" => + val := int tkcmd(s.top, hd lst+".lI cget -text"); + lp = ref Parameter.IntOut(val) :: lp; + } + } + retlist = (tkpath, lp) :: retlist; + } + return retlist; +} + +Select.resize(s: self ref Select, width, height: int) +{ + ws := int tkcmd(s.top, ".fselect.sy cget -width"); + hs := int tkcmd(s.top, ".fselect.sx cget -height"); + + tkcmd(s.top, ".fselect.c configure -width "+string (width - ws - 8)+ + " -height "+string (height - hs - 8)); + f := getframe(s, s.currfname); + if (f != nil) + setselectscrollr(s, f.path); + + tkcmd(s.top, "update"); +} + +File.eq(a,b: File): int +{ + if (a.path != b.path || a.qid != b.qid) + return 0; + return 1; +} + + +######################## General Functions ######################## + +setcentre(top1, top2: ref Tk->Toplevel) +{ + x1 := int tkcmd(top1, ". cget -actx"); + y1 := int tkcmd(top1, ". cget -acty"); + h1 := int tkcmd(top1, ". cget -height"); + w1 := int tkcmd(top1, ". cget -width"); + + h2 := int tkcmd(top2, ".f cget -height"); + w2 := int tkcmd(top2, ".f cget -width"); + + newx := (x1 + (w1 / 2)) - (w2/2); + newy := (y1 + (h1 / 2)) - (h2/2); + tkcmd(top2, ". configure -x "+string newx+" -y "+string newy); +} + +abs(x: int): int +{ + if (x < 0) + return -x; + return x; +} + +prevpath(path: string): string +{ + if (path == nil) + return nil; + p := isatback(path[:len path - 1], "/"); + if (p == -1) + return nil; + return path[:p+1]; +} + +isat(s, test: string): int +{ + if (len test > len s) + return -1; + for (i := 0; i < (1 + len s - len test); i++) + if (test == s[i:i+len test]) + return i; + return -1; +} + +isatback(s, test: string): int +{ + if (len test > len s) + return -1; + for (i := len s - len test; i >= 0; i--) + if (test == s[i:i+len test]) + return i; + return -1; +} + +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]); +} + +badmod(path: string) +{ + sys->print("Browser: failed to load: %s\n",path); + exit; +} diff --git a/appl/grid/lib/browser.m b/appl/grid/lib/browser.m new file mode 100644 index 00000000..ea0bc9fa --- /dev/null +++ b/appl/grid/lib/browser.m @@ -0,0 +1,97 @@ +Browser: module { + + PATH: con "/dis/scheduler/browser.dis"; + + DESELECT: con 0; + SELECT: con 1; + TOGGLE: con 2; + OPEN: con 3; + CLOSE: con 4; + + init: fn (); + dialog: fn (ctxt: ref draw->Context, oldtop: ref Tk->Toplevel, butlist: list of string, title, msg: string): int; + prevpath: fn (path: string): string; + setcentre: fn (top1, top2: ref Tk->Toplevel); + + Browse: adt { + new: fn (top: ref Tk->Toplevel, tkchanname, root, rlabel: string, nopanes: int, reader: PathReader): ref Browse; + refresh: fn (b: self ref Browse); + defaultaction: fn (b: self ref Browse, lst: list of string, f: ref File); + getpath: fn (b: self ref Browse, tkpath: string): ref File; + opendir: fn (b: self ref Browse, file: File, tkpath: string, action: int): int; + newroot: fn (b: self ref Browse, root, rlabel: string); + changeview: fn (b: self ref Browse, nopanes: int); + selectfile: fn (b: self ref Browse, pane, action: int, file: File, tkpath: string); + gotoselectfile: fn (b: self ref Browse, file: File): string; + gotopath: fn (b: self ref Browse, dir: File, openfinal: int): (File, string); + getselected: fn (b: self ref Browse, pane: int): File; + addopened: fn (b: self ref Browse, file: File, add: int); + showpath: fn (b: self ref Browse, on: int); + resize: fn (b: self ref Browse); + top: ref Tk->Toplevel; + tkchan: string; + bgnorm, bgselect: string; + nopanes: int; + selected: array of Selected; + opened: list of File; + root, rlabel: string; + reader: PathReader; + pane1: File; + pane0width: string; + width: int; + showpathlabel: int; + released: int; + }; + + SELECTED: con 0; + UNSELECTED: con 1; + ALL: con 2; + + Select: adt { + new: fn (top: ref Tk->Toplevel, tkchanname: string): ref Select; + addframe: fn (s: self ref Select, fname, title: string); + showframe: fn (s: self ref Select, fname: string); + delframe: fn (s: self ref Select, fname: string); + addselection: fn (s: self ref Select, fname, text: string, lp: list of ref Parameter, allowdups: int): string; + delselection: fn (s: self ref Select, fname, tkpath: string); + getselection: fn (s: self ref Select, fname: string): list of (string, list of ref Parameter); + getselected: fn (s: self ref Select, fname: string): string; + select: fn (s: self ref Select, fname, tkpath: string, action: int); + defaultaction: fn (s: self ref Select, lst: list of string); + resize: fn (s: self ref Select, width, height: int); + setscrollr: fn (s: self ref Select, fname: string); + top: ref Tk->Toplevel; + tkchan: string; + currfname, currfid: string; + frames: list of ref Frame; + }; + + Frame: adt { + name: string; + path: string; + selected: string; + }; + + Parameter: adt { + pick { + ArgIn => + name, initval: string; + ArgOut => + name, val: string; + IntIn => + min, max, initval: int; + IntOut => + val: int; + } + }; + + File: adt { + eq: fn (a,b: File): int; + path, qid: string; + }; + + Selected: adt { + file: File; + tkpath: string; + }; +};
\ No newline at end of file diff --git a/appl/grid/lib/fbrowse.b b/appl/grid/lib/fbrowse.b new file mode 100644 index 00000000..bde88e62 --- /dev/null +++ b/appl/grid/lib/fbrowse.b @@ -0,0 +1,390 @@ +implement FBrowse; + +# +# 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 "readdir.m"; + readdir: Readdir; +include "workdir.m"; +include "sh.m"; + sh: Sh; +include "grid/pathreader.m"; + reader: PathReader; +include "grid/browser.m"; + browser: Browser; + Browse, Select, File, Parameter, + DESELECT, SELECT, TOGGLE: import browser; +include "grid/fbrowse.m"; + +br: ref Browse; + +init(ctxt : ref Draw->Context, title, root, currdir: string): string +{ + sys = load Sys Sys->PATH; + if (sys == nil) + badmod(Sys->PATH); + draw = load Draw Draw->PATH; + if (draw == nil) + badmod(Draw->PATH); + readdir = load Readdir Readdir->PATH; + if (readdir == nil) + badmod(Readdir->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); + sh = load Sh Sh->PATH; + if (sh == nil) + badmod(Sh->PATH); + browser = load Browser Browser->PATH; + if (browser == nil) + badmod(Browser->PATH); + browser->init(); + reader = load PathReader "$self"; + if (reader == nil) + sys->print("cannot load reader!\n"); + sys->pctl(sys->NEWPGRP, nil); + if (root == nil) + root = "/"; + sys->chdir(root); + if (currdir == nil) + currdir = workdir->init(); + if (root[len root - 1] != '/') + root[len root] = '/'; + if (currdir[len currdir - 1] != '/') + currdir[len currdir] = '/'; + + (top, titlebar) := tkclient->toplevel(ctxt,"", title , tkclient->OK | tkclient->Appl); + browsechan := chan of string; + tk->namechan(top, browsechan, "browsechan"); + br = Browse.new(top, "browsechan", root, root, 2, reader); + br.addopened(File (root, nil), 1); + br.gotoselectfile(File (currdir, nil)); + for (ik := 0; ik < len mainscreen; ik++) + tkcmd(top,mainscreen[ik]); + butchan := chan of string; + tk->namechan(top, butchan, "butchan"); + + tkcmd(top, "pack .f -fill both -expand 1; pack propagate . 0"); + tkcmd(top, ". configure -height 300 -width 300"); + + tkcmd(top, "update"); + released := 1; + title = ""; + + menudata := ("", ""); + + tkclient->onscreen(top, nil); + resize(top, ctxt.display.image); + tkclient->startinput(top, "kbd"::"ptr"::nil); + + path: 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"); + selected := br.getselected(1); + case hd lst { + "double1pane1" => + tkpath := hd tl lst; + file := br.getpath(tkpath); + br.defaultaction(lst, file); + (n, dir) := sys->stat(file.path); + if (n == -1 || dir.mode & sys->DMDIR) + break; + if ((len dir.name > 4 && dir.name[len dir.name - 4:] == ".dis") || + dir.mode & 8r111) + spawn send(butchan, "run "+tkpath); + else if (dir.mode & 8r222) + spawn send(butchan, "write "+tkpath); + else if (dir.mode & 8r444) + spawn send(butchan, "open "+tkpath); + * => + br.defaultaction(lst, nil); + } + if (!File.eq(selected, br.getselected(1))) + actionbutton(top, br.selected[1].file.path, br.selected[1].tkpath); + tkcmd(top, "update"); + inp := <-butchan => + (nil, lst) := sys->tokenize(inp, " \n\t"); + case hd lst { + "refresh" => + br.refresh(); + "shell" => + path = br.getselected(1).path; + if (path == nil) + sys->chdir(root); + else + sys->chdir(path); + sh->run(ctxt, "/dis/wm/sh.dis" :: nil); + + "run" => + spawn run(ctxt, br.getselected(1).path); + "read" => + wtitle := tkcmd(top, hd tl lst+" cget text"); + spawn openfile(ctxt, br.getselected(1).path, wtitle,0); + "write" => + wtitle := tkcmd(top, hd tl lst+" cget text"); + spawn openfile(ctxt, br.getselected(1).path, wtitle,1); + } + 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 && e[0] == '!') + br.resize(); + } + } + if (title == "ok") + return br.getselected(1).path; + return ""; +} + +send(chanout: chan of string, s: string) +{ + chanout <-= s; +} + +resize(top: ref Tk->Toplevel, img: ref Draw->Image) +{ + if (img != nil) { + scw := img.r.dx(); + sch := img.r.dy(); + ww := int tkcmd(top, ". cget -width"); + wh := int tkcmd(top, ". cget -height"); + if (ww > scw) + tkcmd(top, ". configure -x 0 -width "+string scw); + if (wh > sch) + tkcmd(top, ". configure -y 0 -height "+string sch); + } +} + +mainscreen := array[] of { + "frame .f", + "frame .f.ftop", + "button .f.ftop.bs -text {Shell} -command {send butchan shell} -font /fonts/charon/bold.normal.font", + "button .f.ftop.br -text {Refresh} -command {send butchan refresh} -font /fonts/charon/bold.normal.font", + "grid .f.ftop.bs .f.ftop.br -row 0", + "grid columnconfigure .f.ftop 2 -minsize 30", + "grid .f.ftop -row 0 -column 0 -pady 2 -sticky w", + "label .f.l -text { } -height 1 -bg red", + "grid .f.l -row 1 -sticky ew", + "grid .fbrowse -in .f -row 2 -column 0 -sticky nsew", + "grid rowconfigure .f 2 -weight 1", + "grid columnconfigure .f 0 -weight 1", + + "bind .Wm_t <Button-1> +{focus .Wm_t}", + "bind .Wm_t.title <Button-1> +{focus .Wm_t}", + "focus .Wm_t", +}; + +readpath(file: File): (array of ref sys->Dir, int) +{ + (dirs, nil) := readdir->init(file.path, readdir->NAME | readdir->COMPACT); + return (dirs, 0); +} + +run(ctxt: ref Draw->Context, file: string) +{ + sys->pctl(sys->FORKNS | sys->NEWPGRP, nil); + sys->chdir(browser->prevpath(file)); + sh->run(ctxt, file :: nil); +} + +openscr := array[] of { + "frame .f", + "scrollbar .f.sy -command {.f.t yview}", + "text .f.t -yscrollcommand {.f.sy set} -bg white -font /fonts/charon/plain.normal.font", + "pack .f.sy -side left -fill y", + "pack .f.t -fill both -expand 1", + "bind .Wm_t <Button-1> +{focus .Wm_t}", + "bind .Wm_t.title <Button-1> +{focus .Wm_t}", + "focus .f.t", +}; + +fopensize := ("", ""); + +plumbing := array[] of { + ("bit", "wm/view"), + ("jpg", "wm/view"), +}; + +freader(top: ref Tk->Toplevel, fd: ref sys->FD, sync: chan of int) +{ + sync <-= sys->pctl(0,nil); + buf := array[8192] of byte; + for (;;) { + i := sys->read(fd, buf, len buf); + if (i < 1) + return; + s :=""; + for (j := 0; j < i; j++) { + c := int buf[j]; + if (c == '{' || c == '}') + s[len s] = '\\'; + s[len s] = c; + } + tk->cmd(top, ".f.t insert end {"+s+"}; update"); + } +} + +openfile(ctxt: ref draw->Context, file, title: string, writeable: int) +{ + ext := getext(file); + plumb := getplumb(ext); + if (plumb != nil) { + sh->run(ctxt, plumb :: file :: nil); + return; + } + button := tkclient->Appl; + if (writeable) + button = button | tkclient->OK; + (top, titlebar) := tkclient->toplevel(ctxt, "", title, button); + tkcmds(top, openscr); + tkcmd(top,"pack .f -fill both -expand 1"); + tkcmd(top,"pack propagate . 0"); + (w,h) := fopensize; + if (w != "" && h != "") + tkcmd(top, ". configure -width "+w+" -height "+h); + errors := 0; + killpid := -1; + fd := sys->open(file, sys->OREAD); + if (fd != nil) { + sync := chan of int; + spawn freader(top, fd, sync); + killpid = <-sync; + } + tkcmd(top, "update"); + 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); + + title = <-top.ctxt.ctl or + title = <-top.wreq or + title = <-titlebar => + if (title == "exit" || title == "ok") + break main; + tkclient->wmctl(top, title); + } + } + if (killpid != -1) + kill(killpid); + fopensize = (tkcmd(top, ". cget -width"), tkcmd(top, ". cget -height")); + if (title == "ok") { + (n, dir) := sys->stat(file); + if (n != -1) { + fd = sys->create(file, sys->OWRITE, dir.mode); + if (fd != nil) { + s := tkcmd(top, ".f.t get 1.0 end"); + sys->fprint(fd,"%s",s); + fd = nil; + } + } + } +} + +badmod(path: string) +{ + sys->print("FBrowse: failed to load: %s\n",path); + exit; +} + +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]); +} + +nactionbuttons := 0; +actionbutton(top: ref Tk->Toplevel, path, tkpath: string) +{ + (n, dir) := sys->stat(path); + 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 || n == -1 || dir.mode & sys->DMDIR) { + nactionbuttons = 0; + return; + } + buttons : list of (string,string) = nil; + + if (dir.mode & 8r222) + buttons = ("Open", "write "+tkpath) :: buttons; + else if (dir.mode & 8r444) + buttons = ("Open", "read "+tkpath) :: buttons; + if (len dir.name > 4 && dir.name[len dir.name - 4:] == ".dis" || dir.mode & 8r111) + buttons = ("Run", "run "+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; + } +} + +getext(file: string): string +{ + (n, lst) := sys->tokenize(file, "."); + for (; tl lst != nil; lst = tl lst) + ; + return hd lst; +} + +getplumb(ext: string): string +{ + for (i := 0; i < len plumbing; i++) + if (ext == plumbing[i].t0) + return plumbing[i].t1; + return nil; +} + +kill(pid: int) +{ + if ((fd := sys->open("/prog/" + string pid + "/ctl", Sys->OWRITE)) != nil) + sys->fprint(fd, "kill"); +} diff --git a/appl/grid/lib/mkfile b/appl/grid/lib/mkfile new file mode 100644 index 00000000..e4ea4483 --- /dev/null +++ b/appl/grid/lib/mkfile @@ -0,0 +1,27 @@ +<../../../mkconfig + +TARG= announce.dis\ + browser.dis\ + fbrowse.dis\ + srvbrowse.dis\ + +MODULES=\ + +SYSMODULES= \ + draw.m\ + grid/announce.m\ + grid/browser.m\ + grid/fbrowse.m\ + grid/pathreader.m\ + grid/srvbrowse.m\ + readdir.m\ + registries.m\ + sh.m\ + sys.m\ + tk.m\ + tkclient.m\ + workdir.m\ + +DISBIN=$ROOT/dis/grid/lib + +<$ROOT/mkfiles/mkdis diff --git a/appl/grid/lib/pathreader.m b/appl/grid/lib/pathreader.m new file mode 100644 index 00000000..7ec4f0f4 --- /dev/null +++ b/appl/grid/lib/pathreader.m @@ -0,0 +1,3 @@ +PathReader : module { + readpath: fn (dir: Browser->File): (array of ref sys->Dir, int); +};
\ No newline at end of file diff --git a/appl/grid/lib/srvbrowse.b b/appl/grid/lib/srvbrowse.b new file mode 100644 index 00000000..eec8f56e --- /dev/null +++ b/appl/grid/lib/srvbrowse.b @@ -0,0 +1,719 @@ +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, err) := 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]); +} |
