implement Selectfile; include "sys.m"; sys: Sys; Dir: import sys; include "draw.m"; draw: Draw; Screen, Rect, Point: import draw; include "tk.m"; tk: Tk; include "string.m"; str: String; include "tkclient.m"; tkclient: Tkclient; include "workdir.m"; include "readdir.m"; readdir: Readdir; include "filepat.m"; filepat: Filepat; include "selectfile.m"; Browser: adt { top: ref Tk->Toplevel; ncols: int; colwidth: int; w: string; init: fn(top: ref Tk->Toplevel, w: string, colwidth: string): (ref Browser, chan of string); addcol: fn(c: self ref Browser, t: string, d: array of string); delete: fn(c: self ref Browser, colno: int); selection: fn(c: self ref Browser, cno: int): string; select: fn(b: self ref Browser, cno: int, e: string); entries: fn(b: self ref Browser, cno: int): array of string; resize: fn(c: self ref Browser);}; BState: adt { b: ref Browser; bpath: string; # path currently displayed in browser epath: string; # path entered by user dirfetchpid: int; dirfetchpath: string;}; filename_config := array[] of { "entry .e -bg white", "frame .pf", "entry .pf.e", "label .pf.t -text {Filter:}", "entry .pats", "bind .e <Key> +{send ech key}", "bind .e <Key-\n> {send ech enter}", "bind .e {<Key-\t>} {send ech expand}", "bind .pf.e <Key-\n> {send ech setpat}", "bind . <Configure> {send ech config}", "pack .b -side top -fill both -expand 1", "pack .pf.t -side left", "pack .pf.e -side top -fill x", "pack .pf -side top -fill x", "pack .e -side top -fill x", "pack propagate . 0",}; debugging := 0;STEP: con 20; init(): string{ sys = load Sys Sys->PATH; draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; tkclient = load Tkclient Tkclient->PATH; tkclient->init(); str = load String String->PATH; readdir = load Readdir Readdir->PATH; filepat = load Filepat Filepat->PATH; return nil;} filename(ctxt: ref Draw->Context, parent: ref Draw->Image, title: string, pats: list of string, dir: string): string{ patstr: string; if (dir == nil || dir == ".") { wd := load Workdir Workdir->PATH; if ((dir = wd->init()) != nil) { (ok, nil) := sys->stat(dir); if (ok == -1) dir = nil; } wd = nil; } if (dir == nil) dir = "/"; (pats, patstr) = makepats(pats); where := localgeom(parent); if (title == nil) title = "Open"; (top, wch) := tkclient->toplevel(ctxt, where+" -bd 1", # -font /fonts/misc/latin1.6x13.font", title, Tkclient->Popup|Tkclient->Resize|Tkclient->OK); (b, colch) := Browser.init(top, ".b", "16w"); entrych := chan of string; tk->namechan(top, entrych, "ech"); tkcmds(top, filename_config); cmd(top, ". configure -width " + string (b.colwidth * 3) + " -height 20h"); cmd(top, ".e insert 0 '" + dir); cmd(top, ".pf.e insert 0 '" + patstr); s := ref BState(b, nil, dir, -1, nil); s.b.resize(); dfch := chan of (string, array of ref Sys->Dir); if (parent == nil) centre(top); tkclient->onscreen(top, nil); tkclient->startinput(top, "kbd" :: "ptr" :: nil);loop: for (;;) { if (debugging) { sys->print("filename: before sync, bpath: '%s'; epath: '%s'\n", s.bpath, s.epath); } bsync(s, dfch, pats); if (debugging) { sys->print("filename: after sync, bpath: '%s'; epath: '%s'", s.bpath, s.epath); if (s.dirfetchpid == -1) sys->print("\n"); else sys->print("; fetching '%s' (pid %d)\n", s.dirfetchpath, s.dirfetchpid); } cmd(top, "focus .e"); cmd(top, "update"); alt { c := <-top.ctxt.kbd => tk->keyboard(top, c); p := <-top.ctxt.ptr => tk->pointer(top, *p); c := <-top.ctxt.ctl or c = <-top.wreq => tkclient->wmctl(top, c); c := <-colch => double := c[0] == 'd'; c = c[1:]; (bpath, nbpath, elem) := (s.bpath, "", ""); for (cno := 0; cno <= int c; cno++) { (elem, bpath) = nextelem(bpath); nbpath = pathcat(nbpath, elem); } nsel := s.b.selection(int c); if (nsel != nil) nbpath = pathcat(nbpath, nsel); s.epath = nbpath; cmd(top, ".e delete 0 end"); cmd(top, ".e insert 0 '" + s.epath); if (double) break loop; c := <-entrych => case c { "enter" => break loop; "config" => s.b.resize(); "key" => s.epath = cmdget(top, ".e get"); "expand" => cmd(top, ".e delete 0 end"); cmd(top, ".e insert 0 '" + s.bpath); s.epath = s.bpath; "setpat" => patstr = cmdget(top, ".pf.e get"); if (patstr == " debug ") debugging = !debugging; else { (nil, pats) = sys->tokenize(patstr, " "); s.b.delete(0); s.bpath = nil; } } c := <-wch => if (c == "ok") break loop; if (c == "exit") { s.epath = nil; break loop; } tkclient->wmctl(top, c); (t, d) := <-dfch => ds := array[len d] of string; for (i := 0; i < len d; i++) { n := d[i].name; if ((d[i].mode & Sys->DMDIR) != 0) n[len n] = '/'; ds[i] = n; } s.b.addcol(t, ds); ds = nil; d = nil; s.bpath = s.dirfetchpath; s.dirfetchpid = -1; } } if (s.dirfetchpid != -1) kill(s.dirfetchpid); return s.epath;} bsync(s: ref BState, dfch: chan of (string, array of ref Sys->Dir), pats: list of string){ (epath, bpath) := (s.epath, s.bpath); cno := 0; prefix, e1, e2: string = ""; # find maximal prefix of epath and bpath. for (;;) { p1, p2: string; (e1, p1) = nextelem(epath); (e2, p2) = nextelem(bpath); if (e1 == nil || e1 != e2) break; prefix = pathcat(prefix, e1); (epath, bpath) = (p1, p2); cno++; } if (epath == nil) { if (bpath != nil) { s.b.delete(cno); s.b.select(cno - 1, nil); s.bpath = prefix; } return; } # if the paths have no prefix in common then we're starting # at a different root - don't do anything until # we know we have at least one full element. # even then, if it's not a directory, we have to ignore it. if (cno == 0 && islastelem(epath)) return; if (e1 != nil && islastelem(epath)) { # find first prefix-matching entry. match := ""; for ((i, ents) := (0, s.b.entries(cno - 1)); i < len ents; i++) { m := ents[i]; if (len m >= len e1 && m[0:len e1] == e1) { match = deslash(m); break; } } if (match != nil) { if (match == e2 && islastelem(bpath)) return; epath = pathcat(match, epath[len e1:]); e1 = match; if (e1 == e2) cno++; } else { s.b.delete(cno); s.bpath = prefix; return; } } s.b.delete(cno); s.b.select(cno - 1, e1); np := pathcat(prefix, e1); if (s.dirfetchpid != -1) { if (np == s.dirfetchpath) return; kill(s.dirfetchpid); s.dirfetchpid = -1; } (ok, dir) := sys->stat(np); if (ok != -1 && (dir.mode & Sys->DMDIR) != 0) { sync := chan of int; spawn dirfetch(np, e1, sync, dfch, pats); s.dirfetchpid = <-sync; s.dirfetchpath = np; } else if (ok != -1) s.bpath = np; else s.bpath = prefix;} dirfetch(p: string, t: string, sync: chan of int, dfch: chan of (string, array of ref Sys->Dir), pats: list of string){ sync <-= sys->pctl(0, nil); (a, e) := readdir->init(p, Readdir->NAME|Readdir->COMPACT); if (e != -1) { j := 0; for (i := 0; i < len a; i++) { pl := pats; if ((a[i].mode & Sys->DMDIR) == 0) { for (; pl != nil; pl = tl pl) if (filepat->match(hd pl, a[i].name)) break; } if (pl != nil || pats == nil) a[j++] = a[i]; } a = a[0:j]; } dfch <-= (t, a);} dist(top: ref Tk->Toplevel, s: string): int{ cmd(top, "frame .xxxx -width " + s); d := int cmd(top, ".xxxx cget -width"); cmd(top, "destroy .xxxx"); return d;} Browser.init(top: ref Tk->Toplevel, w: string, colwidth: string): (ref Browser, chan of string){ b := ref Browser; b.top = top; b.ncols = 0; b.colwidth = dist(top, colwidth); b.w = w; cmd(b.top, "frame " + b.w); cmd(b.top, "canvas " + b.w + ".c -width 0 -height 0 -xscrollcommand {" + b.w + ".s set}"); cmd(b.top, "frame " + b.w + ".c.f -bd 0"); cmd(b.top, "pack propagate " + b.w + ".c.f 0"); cmd(b.top, b.w + ".c create window 0 0 -tags win -window " + b.w + ".c.f -anchor nw"); cmd(b.top, "scrollbar "+b.w+".s -command {"+b.w+".c xview} -orient horizontal"); cmd(b.top, "bind "+b.w+".c <Configure> {"+b.w+".c itemconfigure win -height ["+b.w+".c cget -actheight]}"); cmd(b.top, "pack "+b.w+".c -side top -fill both -expand 1"); cmd(b.top, "pack "+b.w+".s -side top -fill x"); ch := chan of string; tk->namechan(b.top, ch, "colch"); return (b, ch);} xview(top: ref Tk->Toplevel, w: string): (real, real){ s := tk->cmd(top, w + " xview"); if (s != nil && s[0] != '!') { (n, v) := sys->tokenize(s, " "); if (n == 2) return (real hd v, real hd tl v); } return (0.0, 0.0);} setscrollregion(b: ref Browser){ (w, h) := (b.colwidth * (b.ncols + 1), int cmd(b.top, b.w + ".c cget -actheight")); cmd(b.top, b.w+".c.f configure -width " + string w + " -height " + string h);# w := int cmd(b.top, b.w+".c.f cget -actwidth");# w += int cmd(b.top, b.w+".c cget -actwidth") - b.colwidth;# h := int cmd(b.top, b.w+".c.f cget -actheight"); if (w > 0 && h > 0) cmd(b.top, b.w + ".c configure -scrollregion {0 0 " + string w + " " + string h + "}"); (start, end) := xview(b.top, b.w+".c"); if (end > 1.0) cmd(b.top, b.w+".c xview scroll left 0 units");} Browser.addcol(b: self ref Browser, title: string, d: array of string){ ncol := string b.ncols++; f := b.w + ".c.f.d" + ncol; cmd(b.top, "frame " + f + " -bg green -width " + string b.colwidth); t := f + ".t"; cmd(b.top, "label " + t + " -text " + tk->quote(title) + " -bg black -fg white"); sb := f + ".s"; lb := f + ".l"; cmd(b.top, "scrollbar " + sb + " -command {" + lb + " yview}"); cmd(b.top, "listbox " + lb + " -selectmode browse" + " -yscrollcommand {" + sb + " set}" + " -bd 2"); cmd(b.top, "bind " + lb + " <ButtonRelease-1> +{send colch s " + ncol + "}"); cmd(b.top, "bind " + lb + " <Double-Button-1> +{send colch d " + ncol + "}"); cmd(b.top, "pack propagate " + f + " 0"); cmd(b.top, "pack " + t + " -side top -fill x"); cmd(b.top, "pack " + sb + " -side left -fill y"); cmd(b.top, "pack " + lb + " -side left -fill both -expand 1"); cmd(b.top, "pack " + f + " -side left -fill y"); for (i := 0; i < len d; i++) cmd(b.top, lb + " insert end '" + d[i]); setscrollregion(b); seecol(b, b.ncols - 1);} Browser.resize(b: self ref Browser){ if (b.ncols == 0) return; setscrollregion(b);} seecol(b: ref Browser, cno: int){ w := b.w + ".c.f.d" + string cno; min := int cmd(b.top, w + " cget -actx"); max := min + int cmd(b.top, w + " cget -actwidth") + 2 * int cmd(b.top, w + " cget -bd"); min = int cmd(b.top, b.w+".c canvasx " + string min); max = int cmd(b.top, b.w +".c canvasx " + string max); # see first the right edge; then the left edge, to ensure # that the start of a column is visible, even if the window # is narrower than one column. cmd(b.top, b.w + ".c see " + string max + " 0"); cmd(b.top, b.w + ".c see " + string min + " 0");} Browser.delete(b: self ref Browser, colno: int){ while (b.ncols > colno) cmd(b.top, "destroy " + b.w+".c.f.d" + string --b.ncols); setscrollregion(b);} Browser.selection(b: self ref Browser, cno: int): string{ if (cno >= b.ncols || cno < 0) return nil; l := b.w+".c.f.d" + string cno + ".l"; sel := cmd(b.top, l + " curselection"); if (sel == nil) return nil; return cmdget(b.top, l + " get " + sel);} Browser.select(b: self ref Browser, cno: int, e: string){ if (cno < 0 || cno >= b.ncols) return; l := b.w+".c.f.d" + string cno + ".l"; cmd(b.top, l + " selection clear 0 end"); if (e == nil) return; ents := b.entries(cno); for (i := 0; i < len ents; i++) { if (deslash(ents[i]) == e) { cmd(b.top, l + " selection set " + string i); cmd(b.top, l + " see " + string i); return; } }} Browser.entries(b: self ref Browser, cno: int): array of string{ if (cno < 0 || cno >= b.ncols) return nil; l := b.w+".c.f.d" + string cno + ".l"; nent := int cmd(b.top, l + " index end") + 1; ents := array[nent] of string; for (i := 0; i < len ents; i++) ents[i] = cmdget(b.top, l + " get " + string i); return ents;} # turn each pattern of the form "*.b (Limbo files)" into "*.b".# ignore '*' as it's a hangover from a past age.makepats(pats: list of string): (list of string, string){ np: list of string; s := ""; for (; pats != nil; pats = tl pats) { p := hd pats; for (i := 0; i < len p; i++) if (p[i] == ' ') break; pat := p[0:i]; if (p != "*") { np = p[0:i] :: np; s += hd np; if (tl pats != nil) s[len s] = ' '; } } return (np, s);} widgetwidth(top: ref Tk->Toplevel, w: string): int{ return int cmd(top, w + " cget -width") + 2 * int cmd(top, w + " cget -bd");Lines 1–500 of 624. Load more
implement Selectfile; include "sys.m"; sys: Sys; Dir: import sys; include "draw.m"; draw: Draw; Screen, Rect, Point: import draw; include "tk.m"; tk: Tk; include "string.m"; str: String; include "tkclient.m"; tkclient: Tkclient; include "workdir.m"; include "readdir.m"; readdir: Readdir; include "filepat.m"; filepat: Filepat; include "selectfile.m"; Browser: adt { top: ref Tk->Toplevel; ncols: int; colwidth: int; w: string; init: fn(top: ref Tk->Toplevel, w: string, colwidth: string): (ref Browser, chan of string); addcol: fn(c: self ref Browser, t: string, d: array of string); delete: fn(c: self ref Browser, colno: int); selection: fn(c: self ref Browser, cno: int): string; select: fn(b: self ref Browser, cno: int, e: string); entries: fn(b: self ref Browser, cno: int): array of string; resize: fn(c: self ref Browser); }; BState: adt { b: ref Browser; bpath: string; # path currently displayed in browser epath: string; # path entered by user dirfetchpid: int; dirfetchpath: string; }; filename_config := array[] of { "entry .e -bg white", "frame .pf", "entry .pf.e", "label .pf.t -text {Filter:}", "entry .pats", "bind .e <Key> +{send ech key}", "bind .e <Key-\n> {send ech enter}", "bind .e {<Key-\t>} {send ech expand}", "bind .pf.e <Key-\n> {send ech setpat}", "bind . <Configure> {send ech config}", "pack .b -side top -fill both -expand 1", "pack .pf.t -side left", "pack .pf.e -side top -fill x", "pack .pf -side top -fill x", "pack .e -side top -fill x", "pack propagate . 0", }; debugging := 0; STEP: con 20; init(): string { sys = load Sys Sys->PATH; draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; tkclient = load Tkclient Tkclient->PATH; tkclient->init(); str = load String String->PATH; readdir = load Readdir Readdir->PATH; filepat = load Filepat Filepat->PATH; return nil; } filename(ctxt: ref Draw->Context, parent: ref Draw->Image, title: string, pats: list of string, dir: string): string { patstr: string; if (dir == nil || dir == ".") { wd := load Workdir Workdir->PATH; if ((dir = wd->init()) != nil) { (ok, nil) := sys->stat(dir); if (ok == -1) dir = nil; } wd = nil; } if (dir == nil) dir = "/"; (pats, patstr) = makepats(pats); where := localgeom(parent); if (title == nil) title = "Open"; (top, wch) := tkclient->toplevel(ctxt, where+" -bd 1", # -font /fonts/misc/latin1.6x13.font", title, Tkclient->Popup|Tkclient->Resize|Tkclient->OK); (b, colch) := Browser.init(top, ".b", "16w"); entrych := chan of string; tk->namechan(top, entrych, "ech"); tkcmds(top, filename_config); cmd(top, ". configure -width " + string (b.colwidth * 3) + " -height 20h"); cmd(top, ".e insert 0 '" + dir); cmd(top, ".pf.e insert 0 '" + patstr); s := ref BState(b, nil, dir, -1, nil); s.b.resize(); dfch := chan of (string, array of ref Sys->Dir); if (parent == nil) centre(top); tkclient->onscreen(top, nil); tkclient->startinput(top, "kbd" :: "ptr" :: nil); loop: for (;;) { if (debugging) { sys->print("filename: before sync, bpath: '%s'; epath: '%s'\n", s.bpath, s.epath); } bsync(s, dfch, pats); if (debugging) { sys->print("filename: after sync, bpath: '%s'; epath: '%s'", s.bpath, s.epath); if (s.dirfetchpid == -1) sys->print("\n"); else sys->print("; fetching '%s' (pid %d)\n", s.dirfetchpath, s.dirfetchpid); } cmd(top, "focus .e"); cmd(top, "update"); alt { c := <-top.ctxt.kbd => tk->keyboard(top, c); p := <-top.ctxt.ptr => tk->pointer(top, *p); c := <-top.ctxt.ctl or c = <-top.wreq => tkclient->wmctl(top, c); c := <-colch => double := c[0] == 'd'; c = c[1:]; (bpath, nbpath, elem) := (s.bpath, "", ""); for (cno := 0; cno <= int c; cno++) { (elem, bpath) = nextelem(bpath); nbpath = pathcat(nbpath, elem); } nsel := s.b.selection(int c); if (nsel != nil) nbpath = pathcat(nbpath, nsel); s.epath = nbpath; cmd(top, ".e delete 0 end"); cmd(top, ".e insert 0 '" + s.epath); if (double) break loop; c := <-entrych => case c { "enter" => break loop; "config" => s.b.resize(); "key" => s.epath = cmdget(top, ".e get"); "expand" => cmd(top, ".e delete 0 end"); cmd(top, ".e insert 0 '" + s.bpath); s.epath = s.bpath; "setpat" => patstr = cmdget(top, ".pf.e get"); if (patstr == " debug ") debugging = !debugging; else { (nil, pats) = sys->tokenize(patstr, " "); s.b.delete(0); s.bpath = nil; } } c := <-wch => if (c == "ok") break loop; if (c == "exit") { s.epath = nil; break loop; } tkclient->wmctl(top, c); (t, d) := <-dfch => ds := array[len d] of string; for (i := 0; i < len d; i++) { n := d[i].name; if ((d[i].mode & Sys->DMDIR) != 0) n[len n] = '/'; ds[i] = n; } s.b.addcol(t, ds); ds = nil; d = nil; s.bpath = s.dirfetchpath; s.dirfetchpid = -1; } } if (s.dirfetchpid != -1) kill(s.dirfetchpid); return s.epath; } bsync(s: ref BState, dfch: chan of (string, array of ref Sys->Dir), pats: list of string) { (epath, bpath) := (s.epath, s.bpath); cno := 0; prefix, e1, e2: string = ""; # find maximal prefix of epath and bpath. for (;;) { p1, p2: string; (e1, p1) = nextelem(epath); (e2, p2) = nextelem(bpath); if (e1 == nil || e1 != e2) break; prefix = pathcat(prefix, e1); (epath, bpath) = (p1, p2); cno++; } if (epath == nil) { if (bpath != nil) { s.b.delete(cno); s.b.select(cno - 1, nil); s.bpath = prefix; } return; } # if the paths have no prefix in common then we're starting # at a different root - don't do anything until # we know we have at least one full element. # even then, if it's not a directory, we have to ignore it. if (cno == 0 && islastelem(epath)) return; if (e1 != nil && islastelem(epath)) { # find first prefix-matching entry. match := ""; for ((i, ents) := (0, s.b.entries(cno - 1)); i < len ents; i++) { m := ents[i]; if (len m >= len e1 && m[0:len e1] == e1) { match = deslash(m); break; } } if (match != nil) { if (match == e2 && islastelem(bpath)) return; epath = pathcat(match, epath[len e1:]); e1 = match; if (e1 == e2) cno++; } else { s.b.delete(cno); s.bpath = prefix; return; } } s.b.delete(cno); s.b.select(cno - 1, e1); np := pathcat(prefix, e1); if (s.dirfetchpid != -1) { if (np == s.dirfetchpath) return; kill(s.dirfetchpid); s.dirfetchpid = -1; } (ok, dir) := sys->stat(np); if (ok != -1 && (dir.mode & Sys->DMDIR) != 0) { sync := chan of int; spawn dirfetch(np, e1, sync, dfch, pats); s.dirfetchpid = <-sync; s.dirfetchpath = np; } else if (ok != -1) s.bpath = np; else s.bpath = prefix; } dirfetch(p: string, t: string, sync: chan of int, dfch: chan of (string, array of ref Sys->Dir), pats: list of string) { sync <-= sys->pctl(0, nil); (a, e) := readdir->init(p, Readdir->NAME|Readdir->COMPACT); if (e != -1) { j := 0; for (i := 0; i < len a; i++) { pl := pats; if ((a[i].mode & Sys->DMDIR) == 0) { for (; pl != nil; pl = tl pl) if (filepat->match(hd pl, a[i].name)) break; } if (pl != nil || pats == nil) a[j++] = a[i]; } a = a[0:j]; } dfch <-= (t, a); } dist(top: ref Tk->Toplevel, s: string): int { cmd(top, "frame .xxxx -width " + s); d := int cmd(top, ".xxxx cget -width"); cmd(top, "destroy .xxxx"); return d; } Browser.init(top: ref Tk->Toplevel, w: string, colwidth: string): (ref Browser, chan of string) { b := ref Browser; b.top = top; b.ncols = 0; b.colwidth = dist(top, colwidth); b.w = w; cmd(b.top, "frame " + b.w); cmd(b.top, "canvas " + b.w + ".c -width 0 -height 0 -xscrollcommand {" + b.w + ".s set}"); cmd(b.top, "frame " + b.w + ".c.f -bd 0"); cmd(b.top, "pack propagate " + b.w + ".c.f 0"); cmd(b.top, b.w + ".c create window 0 0 -tags win -window " + b.w + ".c.f -anchor nw"); cmd(b.top, "scrollbar "+b.w+".s -command {"+b.w+".c xview} -orient horizontal"); cmd(b.top, "bind "+b.w+".c <Configure> {"+b.w+".c itemconfigure win -height ["+b.w+".c cget -actheight]}"); cmd(b.top, "pack "+b.w+".c -side top -fill both -expand 1"); cmd(b.top, "pack "+b.w+".s -side top -fill x"); ch := chan of string; tk->namechan(b.top, ch, "colch"); return (b, ch); } xview(top: ref Tk->Toplevel, w: string): (real, real) { s := tk->cmd(top, w + " xview"); if (s != nil && s[0] != '!') { (n, v) := sys->tokenize(s, " "); if (n == 2) return (real hd v, real hd tl v); } return (0.0, 0.0); } setscrollregion(b: ref Browser) { (w, h) := (b.colwidth * (b.ncols + 1), int cmd(b.top, b.w + ".c cget -actheight")); cmd(b.top, b.w+".c.f configure -width " + string w + " -height " + string h); # w := int cmd(b.top, b.w+".c.f cget -actwidth"); # w += int cmd(b.top, b.w+".c cget -actwidth") - b.colwidth; # h := int cmd(b.top, b.w+".c.f cget -actheight"); if (w > 0 && h > 0) cmd(b.top, b.w + ".c configure -scrollregion {0 0 " + string w + " " + string h + "}"); (start, end) := xview(b.top, b.w+".c"); if (end > 1.0) cmd(b.top, b.w+".c xview scroll left 0 units"); } Browser.addcol(b: self ref Browser, title: string, d: array of string) { ncol := string b.ncols++; f := b.w + ".c.f.d" + ncol; cmd(b.top, "frame " + f + " -bg green -width " + string b.colwidth); t := f + ".t"; cmd(b.top, "label " + t + " -text " + tk->quote(title) + " -bg black -fg white"); sb := f + ".s"; lb := f + ".l"; cmd(b.top, "scrollbar " + sb + " -command {" + lb + " yview}"); cmd(b.top, "listbox " + lb + " -selectmode browse" + " -yscrollcommand {" + sb + " set}" + " -bd 2"); cmd(b.top, "bind " + lb + " <ButtonRelease-1> +{send colch s " + ncol + "}"); cmd(b.top, "bind " + lb + " <Double-Button-1> +{send colch d " + ncol + "}"); cmd(b.top, "pack propagate " + f + " 0"); cmd(b.top, "pack " + t + " -side top -fill x"); cmd(b.top, "pack " + sb + " -side left -fill y"); cmd(b.top, "pack " + lb + " -side left -fill both -expand 1"); cmd(b.top, "pack " + f + " -side left -fill y"); for (i := 0; i < len d; i++) cmd(b.top, lb + " insert end '" + d[i]); setscrollregion(b); seecol(b, b.ncols - 1); } Browser.resize(b: self ref Browser) { if (b.ncols == 0) return; setscrollregion(b); } seecol(b: ref Browser, cno: int) { w := b.w + ".c.f.d" + string cno; min := int cmd(b.top, w + " cget -actx"); max := min + int cmd(b.top, w + " cget -actwidth") + 2 * int cmd(b.top, w + " cget -bd"); min = int cmd(b.top, b.w+".c canvasx " + string min); max = int cmd(b.top, b.w +".c canvasx " + string max); # see first the right edge; then the left edge, to ensure # that the start of a column is visible, even if the window # is narrower than one column. cmd(b.top, b.w + ".c see " + string max + " 0"); cmd(b.top, b.w + ".c see " + string min + " 0"); } Browser.delete(b: self ref Browser, colno: int) { while (b.ncols > colno) cmd(b.top, "destroy " + b.w+".c.f.d" + string --b.ncols); setscrollregion(b); } Browser.selection(b: self ref Browser, cno: int): string { if (cno >= b.ncols || cno < 0) return nil; l := b.w+".c.f.d" + string cno + ".l"; sel := cmd(b.top, l + " curselection"); if (sel == nil) return nil; return cmdget(b.top, l + " get " + sel); } Browser.select(b: self ref Browser, cno: int, e: string) { if (cno < 0 || cno >= b.ncols) return; l := b.w+".c.f.d" + string cno + ".l"; cmd(b.top, l + " selection clear 0 end"); if (e == nil) return; ents := b.entries(cno); for (i := 0; i < len ents; i++) { if (deslash(ents[i]) == e) { cmd(b.top, l + " selection set " + string i); cmd(b.top, l + " see " + string i); return; } } } Browser.entries(b: self ref Browser, cno: int): array of string { if (cno < 0 || cno >= b.ncols) return nil; l := b.w+".c.f.d" + string cno + ".l"; nent := int cmd(b.top, l + " index end") + 1; ents := array[nent] of string; for (i := 0; i < len ents; i++) ents[i] = cmdget(b.top, l + " get " + string i); return ents; } # turn each pattern of the form "*.b (Limbo files)" into "*.b". # ignore '*' as it's a hangover from a past age. makepats(pats: list of string): (list of string, string) { np: list of string; s := ""; for (; pats != nil; pats = tl pats) { p := hd pats; for (i := 0; i < len p; i++) if (p[i] == ' ') break; pat := p[0:i]; if (p != "*") { np = p[0:i] :: np; s += hd np; if (tl pats != nil) s[len s] = ' '; } } return (np, s); } widgetwidth(top: ref Tk->Toplevel, w: string): int { return int cmd(top, w + " cget -width") + 2 * int cmd(top, w + " cget -bd");