1implement Selectfile; 2 3include "sys.m"; 4 sys: Sys; 5 Dir: import sys; 6 7include "draw.m"; 8 draw: Draw; 9 Screen, Rect, Point: import draw; 10 11include "tk.m"; 12 tk: Tk; 13 14include "string.m"; 15 str: String; 16 17include "tkclient.m"; 18 tkclient: Tkclient; 19 20include "workdir.m"; 21 22include "readdir.m"; 23 readdir: Readdir; 24 25include "filepat.m"; 26 filepat: Filepat; 27 28include "selectfile.m"; 29 30Browser: adt { 31 top: ref Tk->Toplevel; 32 ncols: int; 33 colwidth: int; 34 w: string; 35 init: fn(top: ref Tk->Toplevel, w: string, colwidth: string): (ref Browser, chan of string); 36 37 addcol: fn(c: self ref Browser, t: string, d: array of string); 38 delete: fn(c: self ref Browser, colno: int); 39 selection: fn(c: self ref Browser, cno: int): string; 40 select: fn(b: self ref Browser, cno: int, e: string); 41 entries: fn(b: self ref Browser, cno: int): array of string; 42 resize: fn(c: self ref Browser); 43}; 44 45BState: adt { 46 b: ref Browser; 47 bpath: string; # path currently displayed in browser 48 epath: string; # path entered by user 49 dirfetchpid: int; 50 dirfetchpath: string; 51}; 52 53filename_config := array[] of { 54 "entry .e -bg white", 55 "frame .pf", 56 "entry .pf.e", 57 "label .pf.t -text {Filter:}", 58 "entry .pats", 59 "bind .e <Key> +{send ech key}", 60 "bind .e <Key-\n> {send ech enter}", 61 "bind .e {<Key-\t>} {send ech expand}", 62 "bind .pf.e <Key-\n> {send ech setpat}", 63 "bind . <Configure> {send ech config}", 64 "pack .b -side top -fill both -expand 1", 65 "pack .pf.t -side left", 66 "pack .pf.e -side top -fill x", 67 "pack .pf -side top -fill x", 68 "pack .e -side top -fill x", 69 "pack propagate . 0", 70}; 71 72debugging := 0; 73STEP: con 20; 74 75init(): string 76{ 77 sys = load Sys Sys->PATH; 78 draw = load Draw Draw->PATH; 79 tk = load Tk Tk->PATH; 80 tkclient = load Tkclient Tkclient->PATH; 81 tkclient->init(); 82 str = load String String->PATH; 83 readdir = load Readdir Readdir->PATH; 84 filepat = load Filepat Filepat->PATH; 85 return nil; 86} 87 88filename(ctxt: ref Draw->Context, parent: ref Draw->Image, 89 title: string, 90 pats: list of string, 91 dir: string): string 92{ 93 patstr: string; 94 95 if (dir == nil || dir == ".") { 96 wd := load Workdir Workdir->PATH; 97 if ((dir = wd->init()) != nil) { 98 (ok, nil) := sys->stat(dir); 99 if (ok == -1) 100 dir = nil; 101 } 102 wd = nil; 103 } 104 if (dir == nil) 105 dir = "/"; 106 (pats, patstr) = makepats(pats); 107 where := localgeom(parent); 108 if (title == nil) 109 title = "Open"; 110 (top, wch) := tkclient->toplevel(ctxt, where+" -bd 1", # -font /fonts/misc/latin1.6x13.font", 111 title, Tkclient->Popup|Tkclient->Resize|Tkclient->OK); 112 (b, colch) := Browser.init(top, ".b", "16w"); 113 entrych := chan of string; 114 tk->namechan(top, entrych, "ech"); 115 tkcmds(top, filename_config); 116 cmd(top, ". configure -width " + string (b.colwidth * 3) + " -height 20h"); 117 cmd(top, ".e insert 0 '" + dir); 118 cmd(top, ".pf.e insert 0 '" + patstr); 119 s := ref BState(b, nil, dir, -1, nil); 120 s.b.resize(); 121 dfch := chan of (string, array of ref Sys->Dir); 122 if (parent == nil) 123 centre(top); 124 tkclient->onscreen(top, nil); 125 tkclient->startinput(top, "kbd" :: "ptr" :: nil); 126loop: for (;;) { 127 if (debugging) { 128 sys->print("filename: before sync, bpath: '%s'; epath: '%s'\n", 129 s.bpath, s.epath); 130 } 131 bsync(s, dfch, pats); 132 if (debugging) { 133 sys->print("filename: after sync, bpath: '%s'; epath: '%s'", s.bpath, s.epath); 134 if (s.dirfetchpid == -1) 135 sys->print("\n"); 136 else 137 sys->print("; fetching '%s' (pid %d)\n", s.dirfetchpath, s.dirfetchpid); 138 } 139 cmd(top, "focus .e"); 140 cmd(top, "update"); 141 alt { 142 c := <-top.ctxt.kbd => 143 tk->keyboard(top, c); 144 p := <-top.ctxt.ptr => 145 tk->pointer(top, *p); 146 c := <-top.ctxt.ctl or 147 c = <-top.wreq => 148 tkclient->wmctl(top, c); 149 c := <-colch => 150 double := c[0] == 'd'; 151 c = c[1:]; 152 (bpath, nbpath, elem) := (s.bpath, "", ""); 153 for (cno := 0; cno <= int c; cno++) { 154 (elem, bpath) = nextelem(bpath); 155 nbpath = pathcat(nbpath, elem); 156 } 157 nsel := s.b.selection(int c); 158 if (nsel != nil) 159 nbpath = pathcat(nbpath, nsel); 160 s.epath = nbpath; 161 cmd(top, ".e delete 0 end"); 162 cmd(top, ".e insert 0 '" + s.epath); 163 if (double) 164 break loop; 165 c := <-entrych => 166 case c { 167 "enter" => 168 break loop; 169 "config" => 170 s.b.resize(); 171 "key" => 172 s.epath = cmdget(top, ".e get"); 173 "expand" => 174 cmd(top, ".e delete 0 end"); 175 cmd(top, ".e insert 0 '" + s.bpath); 176 s.epath = s.bpath; 177 "setpat" => 178 patstr = cmdget(top, ".pf.e get"); 179 if (patstr == " debug ") 180 debugging = !debugging; 181 else { 182 (nil, pats) = sys->tokenize(patstr, " "); 183 s.b.delete(0); 184 s.bpath = nil; 185 } 186 } 187 c := <-wch => 188 if (c == "ok") 189 break loop; 190 if (c == "exit") { 191 s.epath = nil; 192 break loop; 193 } 194 tkclient->wmctl(top, c); 195 (t, d) := <-dfch => 196 ds := array[len d] of string; 197 for (i := 0; i < len d; i++) { 198 n := d[i].name; 199 if ((d[i].mode & Sys->DMDIR) != 0) 200 n[len n] = '/'; 201 ds[i] = n; 202 } 203 s.b.addcol(t, ds); 204 ds = nil; 205 d = nil; 206 s.bpath = s.dirfetchpath; 207 s.dirfetchpid = -1; 208 } 209 } 210 if (s.dirfetchpid != -1) 211 kill(s.dirfetchpid); 212 return s.epath; 213} 214 215bsync(s: ref BState, dfch: chan of (string, array of ref Sys->Dir), pats: list of string) 216{ 217 (epath, bpath) := (s.epath, s.bpath); 218 cno := 0; 219 prefix, e1, e2: string = ""; 220 221 # find maximal prefix of epath and bpath. 222 for (;;) { 223 p1, p2: string; 224 (e1, p1) = nextelem(epath); 225 (e2, p2) = nextelem(bpath); 226 if (e1 == nil || e1 != e2) 227 break; 228 prefix = pathcat(prefix, e1); 229 (epath, bpath) = (p1, p2); 230 cno++; 231 } 232 233 if (epath == nil) { 234 if (bpath != nil) { 235 s.b.delete(cno); 236 s.b.select(cno - 1, nil); 237 s.bpath = prefix; 238 } 239 return; 240 } 241 242 # if the paths have no prefix in common then we're starting 243 # at a different root - don't do anything until 244 # we know we have at least one full element. 245 # even then, if it's not a directory, we have to ignore it. 246 if (cno == 0 && islastelem(epath)) 247 return; 248 249 if (e1 != nil && islastelem(epath)) { 250 # find first prefix-matching entry. 251 match := ""; 252 for ((i, ents) := (0, s.b.entries(cno - 1)); i < len ents; i++) { 253 m := ents[i]; 254 if (len m >= len e1 && m[0:len e1] == e1) { 255 match = deslash(m); 256 break; 257 } 258 } 259 if (match != nil) { 260 if (match == e2 && islastelem(bpath)) 261 return; 262 263 epath = pathcat(match, epath[len e1:]); 264 e1 = match; 265 if (e1 == e2) 266 cno++; 267 } else { 268 s.b.delete(cno); 269 s.bpath = prefix; 270 return; 271 } 272 } 273 274 s.b.delete(cno); 275 s.b.select(cno - 1, e1); 276 np := pathcat(prefix, e1); 277 if (s.dirfetchpid != -1) { 278 if (np == s.dirfetchpath) 279 return; 280 kill(s.dirfetchpid); 281 s.dirfetchpid = -1; 282 } 283 (ok, dir) := sys->stat(np); 284 if (ok != -1 && (dir.mode & Sys->DMDIR) != 0) { 285 sync := chan of int; 286 spawn dirfetch(np, e1, sync, dfch, pats); 287 s.dirfetchpid = <-sync; 288 s.dirfetchpath = np; 289 } else if (ok != -1) 290 s.bpath = np; 291 else 292 s.bpath = prefix; 293} 294 295dirfetch(p: string, t: string, sync: chan of int, 296 dfch: chan of (string, array of ref Sys->Dir), 297 pats: list of string) 298{ 299 sync <-= sys->pctl(0, nil); 300 (a, e) := readdir->init(p, Readdir->NAME|Readdir->COMPACT); 301 if (e != -1) { 302 j := 0; 303 for (i := 0; i < len a; i++) { 304 pl := pats; 305 if ((a[i].mode & Sys->DMDIR) == 0) { 306 for (; pl != nil; pl = tl pl) 307 if (filepat->match(hd pl, a[i].name)) 308 break; 309 } 310 if (pl != nil || pats == nil) 311 a[j++] = a[i]; 312 } 313 a = a[0:j]; 314 } 315 dfch <-= (t, a); 316} 317 318dist(top: ref Tk->Toplevel, s: string): int 319{ 320 cmd(top, "frame .xxxx -width " + s); 321 d := int cmd(top, ".xxxx cget -width"); 322 cmd(top, "destroy .xxxx"); 323 return d; 324} 325 326Browser.init(top: ref Tk->Toplevel, w: string, colwidth: string): (ref Browser, chan of string) 327{ 328 b := ref Browser; 329 b.top = top; 330 b.ncols = 0; 331 b.colwidth = dist(top, colwidth); 332 b.w = w; 333 cmd(b.top, "frame " + b.w); 334 cmd(b.top, "canvas " + b.w + ".c -width 0 -height 0 -xscrollcommand {" + b.w + ".s set}"); 335 cmd(b.top, "frame " + b.w + ".c.f -bd 0"); 336 cmd(b.top, "pack propagate " + b.w + ".c.f 0"); 337 cmd(b.top, b.w + ".c create window 0 0 -tags win -window " + b.w + ".c.f -anchor nw"); 338 cmd(b.top, "scrollbar "+b.w+".s -command {"+b.w+".c xview} -orient horizontal"); 339 cmd(b.top, "bind "+b.w+".c <Configure> {"+b.w+".c itemconfigure win -height ["+b.w+".c cget -actheight]}"); 340 cmd(b.top, "pack "+b.w+".c -side top -fill both -expand 1"); 341 cmd(b.top, "pack "+b.w+".s -side top -fill x"); 342 ch := chan of string; 343 tk->namechan(b.top, ch, "colch"); 344 return (b, ch); 345} 346 347xview(top: ref Tk->Toplevel, w: string): (real, real) 348{ 349 s := tk->cmd(top, w + " xview"); 350 if (s != nil && s[0] != '!') { 351 (n, v) := sys->tokenize(s, " "); 352 if (n == 2) 353 return (real hd v, real hd tl v); 354 } 355 return (0.0, 0.0); 356} 357 358setscrollregion(b: ref Browser) 359{ 360 (w, h) := (b.colwidth * (b.ncols + 1), int cmd(b.top, b.w + ".c cget -actheight")); 361 cmd(b.top, b.w+".c.f configure -width " + string w + " -height " + string h); 362# w := int cmd(b.top, b.w+".c.f cget -actwidth"); 363# w += int cmd(b.top, b.w+".c cget -actwidth") - b.colwidth; 364# h := int cmd(b.top, b.w+".c.f cget -actheight"); 365 if (w > 0 && h > 0) 366 cmd(b.top, b.w + ".c configure -scrollregion {0 0 " + string w + " " + string h + "}"); 367 (start, end) := xview(b.top, b.w+".c"); 368 if (end > 1.0) 369 cmd(b.top, b.w+".c xview scroll left 0 units"); 370} 371 372Browser.addcol(b: self ref Browser, title: string, d: array of string) 373{ 374 ncol := string b.ncols++; 375 376 f := b.w + ".c.f.d" + ncol; 377 cmd(b.top, "frame " + f + " -bg green -width " + string b.colwidth); 378 379 t := f + ".t"; 380 cmd(b.top, "label " + t + " -text " + tk->quote(title) + " -bg black -fg white"); 381 382 sb := f + ".s"; 383 lb := f + ".l"; 384 cmd(b.top, "scrollbar " + sb + 385 " -command {" + lb + " yview}"); 386 387 cmd(b.top, "listbox " + lb + 388 " -selectmode browse" + 389 " -yscrollcommand {" + sb + " set}" + 390 " -bd 2"); 391 392 cmd(b.top, "bind " + lb + " <ButtonRelease-1> +{send colch s " + ncol + "}"); 393 cmd(b.top, "bind " + lb + " <Double-Button-1> +{send colch d " + ncol + "}"); 394 cmd(b.top, "pack propagate " + f + " 0"); 395 cmd(b.top, "pack " + t + " -side top -fill x"); 396 cmd(b.top, "pack " + sb + " -side left -fill y"); 397 cmd(b.top, "pack " + lb + " -side left -fill both -expand 1"); 398 cmd(b.top, "pack " + f + " -side left -fill y"); 399 for (i := 0; i < len d; i++) 400 cmd(b.top, lb + " insert end '" + d[i]); 401 setscrollregion(b); 402 seecol(b, b.ncols - 1); 403} 404 405Browser.resize(b: self ref Browser) 406{ 407 if (b.ncols == 0) 408 return; 409 setscrollregion(b); 410} 411 412seecol(b: ref Browser, cno: int) 413{ 414 w := b.w + ".c.f.d" + string cno; 415 min := int cmd(b.top, w + " cget -actx"); 416 max := min + int cmd(b.top, w + " cget -actwidth") + 417 2 * int cmd(b.top, w + " cget -bd"); 418 min = int cmd(b.top, b.w+".c canvasx " + string min); 419 max = int cmd(b.top, b.w +".c canvasx " + string max); 420 421 # see first the right edge; then the left edge, to ensure 422 # that the start of a column is visible, even if the window 423 # is narrower than one column. 424 cmd(b.top, b.w + ".c see " + string max + " 0"); 425 cmd(b.top, b.w + ".c see " + string min + " 0"); 426} 427 428Browser.delete(b: self ref Browser, colno: int) 429{ 430 while (b.ncols > colno) 431 cmd(b.top, "destroy " + b.w+".c.f.d" + string --b.ncols); 432 setscrollregion(b); 433} 434 435Browser.selection(b: self ref Browser, cno: int): string 436{ 437 if (cno >= b.ncols || cno < 0) 438 return nil; 439 l := b.w+".c.f.d" + string cno + ".l"; 440 sel := cmd(b.top, l + " curselection"); 441 if (sel == nil) 442 return nil; 443 return cmdget(b.top, l + " get " + sel); 444} 445 446Browser.select(b: self ref Browser, cno: int, e: string) 447{ 448 if (cno < 0 || cno >= b.ncols) 449 return; 450 l := b.w+".c.f.d" + string cno + ".l"; 451 cmd(b.top, l + " selection clear 0 end"); 452 if (e == nil) 453 return; 454 ents := b.entries(cno); 455 for (i := 0; i < len ents; i++) { 456 if (deslash(ents[i]) == e) { 457 cmd(b.top, l + " selection set " + string i); 458 cmd(b.top, l + " see " + string i); 459 return; 460 } 461 } 462} 463 464Browser.entries(b: self ref Browser, cno: int): array of string 465{ 466 if (cno < 0 || cno >= b.ncols) 467 return nil; 468 l := b.w+".c.f.d" + string cno + ".l"; 469 nent := int cmd(b.top, l + " index end") + 1; 470 ents := array[nent] of string; 471 for (i := 0; i < len ents; i++) 472 ents[i] = cmdget(b.top, l + " get " + string i); 473 return ents; 474} 475 476# turn each pattern of the form "*.b (Limbo files)" into "*.b". 477# ignore '*' as it's a hangover from a past age. 478makepats(pats: list of string): (list of string, string) 479{ 480 np: list of string; 481 s := ""; 482 for (; pats != nil; pats = tl pats) { 483 p := hd pats; 484 for (i := 0; i < len p; i++) 485 if (p[i] == ' ') 486 break; 487 pat := p[0:i]; 488 if (p != "*") { 489 np = p[0:i] :: np; 490 s += hd np; 491 if (tl pats != nil) 492 s[len s] = ' '; 493 } 494 } 495 return (np, s); 496} 497 498widgetwidth(top: ref Tk->Toplevel, w: string): int 499{ 500 return int cmd(top, w + " cget -width") + 2 * int cmd(top, w + " cget -bd"); 501} 502 503skipslash(path: string): string 504{ 505 for (i := 0; i < len path; i++) 506 if (path[i] != '/') 507 return path[i:]; 508 return nil; 509} 510 511nextelem(path: string): (string, string) 512{ 513 if (path == nil) 514 return (nil, nil); 515 if (path[0] == '/') 516 return ("/", skipslash(path)); 517 for (i := 0; i < len path; i++) 518 if (path[i] == '/') 519 break; 520 return (path[0:i], skipslash(path[i:])); 521} 522 523islastelem(path: string): int 524{ 525 for (i := 0; i < len path; i++) 526 if (path[i] == '/') 527 return 0; 528 return 1; 529} 530 531pathcat(path, elem: string): string 532{ 533 if (path != nil && path[len path - 1] != '/') 534 path[len path] = '/'; 535 return path + elem; 536} 537 538# remove a possible trailing slash 539deslash(s: string): string 540{ 541 if (len s > 0 && s[len s - 1] == '/') 542 s = s[0:len s - 1]; 543 return s; 544} 545 546# 547# find upper left corner for subsidiary child window (always at constant 548# position relative to parent) 549# 550localgeom(im: ref Draw->Image): string 551{ 552 if (im == nil) 553 return nil; 554 555 return sys->sprint("-x %d -y %d", im.r.min.x+STEP, im.r.min.y+STEP); 556} 557 558centre(t: ref Tk->Toplevel) 559{ 560 org: Point; 561 org.x = t.screenr.dx() / 2 - int cmd(t, ". cget -width") / 2; 562 org.y = t.screenr.dy() / 3 - int cmd(t, ". cget -height") / 2; 563 if (org.y < 0) 564 org.y = 0; 565 cmd(t, ". configure -x " + string org.x + " -y " + string org.y); 566} 567 568tkcmds(top: ref Tk->Toplevel, a: array of string) 569{ 570 n := len a; 571 for(i := 0; i < n; i++) 572 tk->cmd(top, a[i]); 573} 574 575topopts := array[] of { 576 "font" 577# , "bd" # Wait for someone to ask for these 578# , "relief" # Note: colors aren't inherited, it seems 579}; 580 581opts(top: ref Tk->Toplevel) : string 582{ 583 if (top == nil) 584 return nil; 585 opts := ""; 586 for ( i := 0; i < len topopts; i++ ) { 587 cfg := tk->cmd(top, ". cget " + topopts[i]); 588 if ( cfg != "" && cfg[0] != '!' ) 589 opts += " -" + topopts[i] + " " + tk->quote(cfg); 590 } 591 return opts; 592} 593 594kill(pid: int): int 595{ 596 fd := sys->open("/prog/"+string pid+"/ctl", Sys->OWRITE); 597 if (fd == nil) 598 return -1; 599 if (sys->write(fd, array of byte "kill", 4) != 4) 600 return -1; 601 return 0; 602} 603Showtk: con 0; 604 605cmd(top: ref Tk->Toplevel, s: string): string 606{ 607 if (Showtk) 608 sys->print("%s\n", s); 609 e := tk->cmd(top, s); 610 if (e != nil && e[0] == '!') 611 sys->fprint(sys->fildes(2), "tkclient: tk error %s on '%s'\n", e, s); 612 return e; 613} 614 615cmdget(top: ref Tk->Toplevel, s: string): string 616{ 617 if (Showtk) 618 sys->print("%s\n", s); 619 tk->cmd(top, "variable lasterror"); 620 e := tk->cmd(top, s); 621 lerr := tk->cmd(top, "variable lasterror"); 622 if (lerr != nil) sys->fprint(sys->fildes(2), "tkclient: tk error %s on '%s'\n", e, s); 623 return e; 624} 625