1implement Unibrowse; 2 3# unicode browser for inferno. 4# roger peppe (rog@ohm.york.ac.uk) 5 6include "sys.m"; 7 sys: Sys; 8 stderr: ref Sys->FD; 9include "draw.m"; 10 draw: Draw; 11include "tk.m"; 12 tk: Tk; 13include "tkclient.m"; 14 tkclient: Tkclient; 15include "dialog.m"; 16 dialog: Dialog; 17include "selectfile.m"; 18 selectfile: Selectfile; 19include "string.m"; 20 str: String; 21include "bufio.m"; 22 bio: Bufio; 23 24Unibrowse: module 25{ 26 init: fn(ctxt: ref Draw->Context, nil: list of string); 27}; 28 29Widgetstack: adt { 30 stk: list of string; # list of widget names; bottom of list is left-most widget 31 name: string; 32 33 # init returns the widget name for the widgetstack; 34 # wn is the name of the frame holding the widget stack 35 new: fn(wn: string): ref Widgetstack; 36 37 push: fn(ws: self ref Widgetstack, w: string); 38 pop: fn(ws: self ref Widgetstack): string; 39 top: fn(ws: self ref Widgetstack): string; 40}; 41 42Defaultwidth: con 30; 43Defaultheight: con 1; 44 45Tablerows: con 3; 46Tablecols: con 8; 47 48Element: adt { 49 name: string; 50 cmd: chan of string; 51 cmdname: string; 52 config: array of string; 53 doneinit: int; 54}; 55 56# columns in unidata file 57ud_VAL, ud_CHARNAME, ud_CATEG, ud_COMBINE, ud_BIDIRECT, 58ud_DECOMP, ud_DECDIGIT, ud_DIGIT, ud_NUMERICVAL, ud_MIRRORED, 59ud_OLDNAME, ud_COMMENT, ud_UPCASE, ud_LOWCASE, ud_TITLECASE: con iota; 60 61# default font configurations within the application 62DEFAULTFONT: con ""; 63UNICODEFONT: con "lucm/unicode.9"; 64TITLEFONT: con "misc/latin1.8x13"; 65DATAFONT: con "misc/latin1.8x13"; 66BUTTONFONT: con "misc/latin1.8x13"; 67 68currfont := "/fonts/" + UNICODEFONT + ".font"; 69 70MAINMENU, BYSEARCH, BYNUMBER, BYCATEGORY, BYFONT, TABLE: con iota; 71elements := array[] of { 72MAINMENU => Element(".main", nil, "maincmd", array[] of { 73 "frame .main", 74 "$listbox data .main.menu -height 6h", 75 "$button button .main.insp -text {Inspector} -command {send maincmd inspect}", 76 "$button button .main.font -text {Font} -command {send maincmd font}", 77 "$label unicode .fontlabel", # .fontlabel's font is currently chosen font 78 "pack .main.menu -side top", 79 "pack .main.insp .main.font -side left", 80 "bind .main.menu <ButtonRelease-1> +{send maincmd newselect}" 81 }, 0), 82BYNUMBER => Element(".numfield", nil, "numcmd", array[] of { 83 "frame .numfield", 84 "$entry data .numfield.f -width 8w", 85 "bind .numfield.f <Key-\n> {send numcmd shownum}", 86 "$label title .numfield.l -text 'Hex unicode value", 87 "pack .numfield.l .numfield.f -side left" 88 }, 0), 89TABLE => Element(".tbl", nil, "tblcmd", array[] of { 90 "frame .tbl", 91 "frame .tbl.tf", 92 "frame .tbl.buts", 93 "$button button .tbl.buts.forw -text {Next} -command {send tblcmd forw}", 94 "$button button .tbl.buts.backw -text {Prev} -command {send tblcmd backw}", 95 "pack .tbl.buts.forw .tbl.buts.backw -side left", 96 "pack .tbl.tf -side top", 97 "pack .tbl.buts -side left" 98 }, 0), 99BYCATEGORY => Element(".cat", nil, "catcmd", array[] of { 100 "frame .cat", 101 "$listbox data .cat.menu -width 43w -height 130 -yscrollcommand {.cat.yscroll set}", 102 "scrollbar .cat.yscroll -width 18 -command {.cat.menu yview}", 103 "pack .cat.yscroll .cat.menu -side left -fill y", 104 "bind .cat.menu <ButtonRelease-1> +{send catcmd newselect}" 105 }, 0), 106BYSEARCH => Element(".srch", nil, "searchcmd", array[] of { 107 "frame .srch", 108 "$listbox data .srch.menu -width 43w -height 130 -yscrollcommand {.srch.yscroll set}", 109 "scrollbar .srch.yscroll -width 18 -command {.srch.menu yview}", 110 "pack .srch.yscroll .srch.menu -side left -fill y", 111 "bind .srch.menu <ButtonRelease-1> +{send searchcmd search}" 112 }, 0), 113BYFONT => Element(".font", nil, "fontcmd", array[] of { 114 "frame .font", 115 "$listbox data .font.menu -width 43w -height 130 -yscrollcommand {.font.yscroll set}", 116 "scrollbar .font.yscroll -width 18 -command {.font.menu yview}", 117 "pack .font.yscroll .font.menu -side left -fill y", 118 "bind .font.menu <ButtonRelease-1> +{send fontcmd newselect}" 119 }, 0), 120}; 121 122entries := array[] of { 123("By Category", BYCATEGORY), 124("By number", BYNUMBER), 125("Symbol wordsearch", BYSEARCH), 126("Font information", BYFONT) 127}; 128 129toplevelconfig := array[] of { 130"pack .Wm_t .display -side top -fill x", 131"image create bitmap waiting -file cursor.wait" 132}; 133 134wmchan: chan of string; # from main window 135inspchan: chan of string; # to inspector 136 137ctxt: ref Draw->Context; 138displ: ref Widgetstack; 139top: ref Tk->Toplevel; 140unidata: ref bio->Iobuf; 141 142UNIDATA: con "/lib/unidata/unidata2.txt"; 143UNIINDEX: con "/lib/unidata/index2.txt"; 144UNIBLOCKS: con "/lib/unidata/blocks.txt"; 145 146notice(msg: string) 147{ 148 dialog->prompt(ctxt, top.image, "bomb.bit", "Notice", msg, 0, "OK"::nil); 149} 150 151init(drawctxt: ref Draw->Context, nil: list of string) 152{ 153 entrychan := chan of string; 154 155 ctxt = drawctxt; 156 config(); 157 if ((unidata = bio->open(UNIDATA, bio->OREAD)) == nil) { 158 notice("Couldn't open unicode data file"); 159 inspchan <-= "exit"; 160 exit; 161 } 162 163 push(MAINMENU); 164 tkclient->onscreen(top, nil); 165 tkclient->startinput(top, "kbd"::"ptr"::nil); 166 currpos := 0; 167 168 for (;;) alt { 169 c := <-top.ctxt.kbd => 170 tk->keyboard(top, c); 171 p := <-top.ctxt.ptr => 172 tk->pointer(top, *p); 173 c := <-top.ctxt.ctl or 174 c = <-top.wreq or 175 c = <-wmchan => 176 tkclient->wmctl(top, c); 177 c := <-elements[MAINMENU].cmd => 178 case c { 179 "font" => 180 font := choosefont(ctxt); 181 if (font != nil) { 182 currfont = font; 183 updatefont(); 184 update(top); 185 } 186 "newselect" => 187 sel := int cmd(top, ".main.menu curselection"); 188 (nil, el) := entries[sel]; 189 if (el == BYSEARCH) { 190 spawn sendentry(top, "Enter search string", entrychan); 191 break; 192 } 193 pop(MAINMENU); 194 push(el); 195 update(top); 196 197 "inspect" => 198 inspchan <-= "raise"; 199 } 200 c := <-entrychan => 201 if (c != nil) { 202 pop(MAINMENU); 203 push(BYSEARCH); 204 update(top); 205 keywordsearch(c); 206 } 207 208 <-elements[BYNUMBER].cmd => 209 txt := cmd(top, ".numfield.f get"); 210 (n, nil) := str->toint(txt, 16); 211 212 pop(BYNUMBER); 213 push(TABLE); 214 setchar(0, n); 215 currpos = filltable(n); 216 update(top); 217 218 <-elements[BYCATEGORY].cmd => 219 sel := cmd(top, ".cat.menu curselection"); 220 (currpos, nil) = str->toint(cmd(top, ".cat.menu get "+sel), 16); 221 pop(BYCATEGORY); 222 push(TABLE); 223 currpos = filltable(currpos); 224 update(top); 225 226 c := <-elements[TABLE].cmd => 227 case c { 228 "forw" => currpos = filltable(currpos + Tablerows * Tablecols); 229 update(top); 230 231 "backw" => currpos = filltable(currpos - Tablerows * Tablecols); 232 update(top); 233 234 * => # must be set <col> <row> <raise> 235 (nil, args) := sys->tokenize(c, " "); 236 setchar(int hd tl tl tl args, currpos + int hd tl args 237 + int hd tl tl args * Tablecols); 238 } 239 240 <-elements[BYSEARCH].cmd => 241 sel := cmd(top, ".srch.menu curselection"); 242 (n, nil) := str->toint(cmd(top, ".srch.menu get "+sel), 16); 243 244 pop(BYSEARCH); 245 push(TABLE); 246 setchar(0, n); 247 currpos = filltable(n); 248 update(top); 249 250 <-elements[BYFONT].cmd => 251 sel := cmd(top, ".font.menu curselection"); 252 (currpos, nil) = str->toint(cmd(top, ".font.menu get "+sel), 16); 253 pop(BYFONT); 254 push(TABLE); 255 currpos = filltable(currpos); 256 update(top); 257 } 258 inspchan <-= "exit"; 259} 260 261sendentry(t: ref Tk->Toplevel, msg: string, where: chan of string) 262{ 263 where <-= dialog->getstring(ctxt, t.image, msg); 264 exit; 265} 266 267setchar(raisei: int, c: int) 268{ 269 s := ""; s[0] = c; 270 if(raisei) 271 inspchan <-= "raise"; 272 inspchan <-= s; 273} 274 275 276charconfig := array[] of { 277"frame .chdata -borderwidth 5 -relief ridge", 278"frame .chdata.f1", 279"frame .chdata.f2", 280"frame .chdata.chf -borderwidth 4 -relief raised", 281"frame .chdata.chcf -borderwidth 3 -relief ridge", 282"$label title .chdata.chf.title -text 'Glyph: ", 283"$label unicode .chdata.ch", 284"$label data .chdata.val -anchor e", 285"$label title .chdata.name -anchor w", 286"$label data .chdata.cat -anchor w", 287"$label data .chdata.comm -anchor w", 288"$button button .chdata.snarfbut -text {Snarf} -command {send charcmd snarf}", 289"$button button .chdata.pastebut -text {Paste} -command {send charcmd paste}", 290"pack .chdata.chf.title .chdata.chcf -in .chdata.chf -side left", 291"pack .chdata.ch -in .chdata.chcf", 292"pack .chdata.chf -in .chdata.f1 -side left -padx 1 -pady 1", 293"pack .chdata.val -in .chdata.f1 -side right", 294"pack .chdata.snarfbut .chdata.pastebut -in .chdata.f2 -side right", 295"pack .chdata.f1 .chdata.name .chdata.cat .chdata.comm .chdata.f2 -fill x -side top", 296"pack .Wm_t .chdata -side top -fill x", 297}; 298 299inspector(ctxt: ref Draw->Context, cmdch: chan of string) 300{ 301 chtop: ref Tk->Toplevel; 302 303 kbd := chan of int; 304 ptr := chan of ref Draw->Pointer; 305 wreq := chan of string; 306 iwmchan := chan of string; 307 ctl := chan of string; 308 309 charcmd := chan of string; 310 currc := 'A'; 311 312 for (;;) alt { 313 c := <-kbd => 314 tk->keyboard(chtop, c); 315 p := <-ptr => 316 tk->pointer(chtop, *p); 317 c := <-ctl or 318 c = <-wreq or 319 c = <-iwmchan => 320 if (c != "exit" && chtop != nil) 321 tkclient->wmctl(chtop, c); 322 else 323 chtop = nil; 324 c := <-cmdch => 325 case c { 326 "raise" => 327 if (chtop != nil) { 328 cmd(chtop, "raise ."); 329 break; 330 } 331 org := winorg(top); 332 org.y += int cmd(top, ". cget -actheight"); 333 (chtop, iwmchan) = tkclient->toplevel(ctxt, 334 "-x "+string org.x+" -y "+string org.y, 335 "Character inspector", 0); 336 tk->namechan(chtop, charcmd, "charcmd"); 337 338 runconfig(chtop, charconfig); 339 inspector_setchar(chtop, currc); 340 tkclient->onscreen(chtop, "onscreen"); 341 tkclient->startinput(chtop, "ptr"::nil); 342 kbd = chtop.ctxt.kbd; 343 ptr = chtop.ctxt.ptr; 344 ctl = chtop.ctxt.ctl; 345 wreq = chtop.wreq; 346 "font" => 347 if (chtop != nil) { 348 cmd(chtop, ".chdata.ch configure -font "+currfont); 349 update(chtop); 350 } 351 "exit" => 352 exit; 353 * => 354 if (len c == 1) { 355 currc = c[0]; 356 inspector_setchar(chtop, currc); 357 } else { 358 sys->fprint(stderr, "unknown inspector cmd: '%s'\n", c); 359 } 360 } 361 c := <-charcmd => 362 case c { 363 "snarf" => 364 tkclient->snarfput(cmd(chtop, ".chdata.ch cget -text")); 365 "paste" => 366 buf := tkclient->snarfget(); 367 if (len buf > 0) 368 inspector_setchar(chtop, buf[0]); 369 } 370 } 371} 372 373inspector_setchar(t: ref Tk->Toplevel, c: int) 374{ 375 if(t == nil) 376 return; 377 line := look(unidata, ';', sys->sprint("%4.4X", c)); 378 labelset(t, ".chdata.ch", sys->sprint("%c", c)); 379 labelset(t, ".chdata.val", sys->sprint("%4.4X", c)); 380 if (line == nil) { 381 labelset(t, ".chdata.name", "No entry found in unicode table"); 382 labelset(t, ".chdata.cat", ""); 383 labelset(t, ".chdata.comm", ""); 384 } else { 385 flds := fields(line, ';'); 386 labelset(t, ".chdata.name", fieldindex(flds, ud_CHARNAME)); 387 labelset(t, ".chdata.cat", categname(fieldindex(flds, ud_CATEG))); 388 labelset(t, ".chdata.comm", fieldindex(flds, ud_OLDNAME)); 389 } 390 update(t); 391} 392 393keywordsearch(key: string): int 394{ 395 396 data := bio->open(UNIINDEX, Sys->OREAD); 397 398 key = str->tolower(key); 399 400 busy(); 401 cmd(top, ".srch.menu delete 0 end"); 402 count := 0; 403 while ((l := bio->data.gets('\n')) != nil) { 404 l = str->tolower(l); 405 if (str->prefix(key, l)) { 406 if (len l > 1 && l[len l - 2] == '\r') 407 l = l[0:len l - 2]; 408 else 409 l = l[0:len l - 1]; 410 flds := fields(l, '\t'); 411 cmd(top, ".srch.menu insert end '" 412 +fieldindex(flds, 1)+": "+fieldindex(flds, 0)); 413 update(top); 414 count++; 415 } 416 } 417 notbusy(); 418 if (count == 0) { 419 notice("No match"); 420 return 0; 421 } 422 return 1; 423} 424 425nomodule(s: string) 426{ 427 sys->fprint(stderr, "couldn't load modules %s: %r\n", s); 428 raise "could not load modules"; 429} 430 431config() 432{ 433 sys = load Sys Sys->PATH; 434 if(ctxt == nil){ 435 sys->fprint(stderr, "unibrowse: window manager required\n"); 436 raise "no wm"; 437 } 438 sys->pctl(Sys->NEWPGRP, nil); 439 stderr = sys->fildes(2); 440 441 draw = load Draw Draw->PATH; 442 if (draw == nil) nomodule(Draw->PATH); 443 444 tk = load Tk Tk->PATH; 445 if (tk == nil) nomodule(Tk->PATH); 446 447 tkclient = load Tkclient Tkclient->PATH; 448 if (tkclient == nil) nomodule(Tkclient->PATH); 449 450 dialog = load Dialog Dialog->PATH; 451 if (dialog == nil) nomodule(Dialog->PATH); 452 453 selectfile = load Selectfile Selectfile->PATH; 454 if (selectfile == nil) nomodule(Selectfile->PATH); 455 456 str = load String String->PATH; 457 if (str == nil) nomodule(String->PATH); 458 459 bio = load Bufio Bufio->PATH; 460 if (bio == nil) nomodule(Bufio->PATH); 461 462 tkclient->init(); 463 dialog->init(); 464 selectfile->init(); 465 466 ctxt = ctxt; 467 468 (top, wmchan) = tkclient->toplevel(ctxt, nil, "Unicode browser", Tkclient->Hide); 469 470 displ = Widgetstack.new(".display"); 471 cmd(top, "pack .display"); 472 473 for (i := 0; i < len elements; i++) { 474 elements[i].cmd = tkchan(elements[i].cmdname); 475 runconfig(top, elements[i].config); 476 } 477 478 runconfig(top, toplevelconfig); 479 480 inspchan = chan of string; 481 spawn inspector(ctxt, inspchan); 482} 483 484runconfig(top: ref Tk->Toplevel, cmds: array of string) 485{ 486 for (i := 0; i < len cmds; i++) { 487 ent := tkexpand(cmds[i]); 488 if (ent != nil) { 489 err := cmd(top, ent); 490 if (len err > 0 && err[0] == '!') 491 sys->fprint(stderr, "config err: %s on '%s'\n", err, ent); 492 } 493 } 494} 495 496update(top: ref Tk->Toplevel) 497{ cmd(top, "update"); } 498 499busy() 500{ cmd(top, "cursor -image waiting"); } 501 502notbusy() 503{ cmd(top, "cursor -default"); } 504 505initelement(el: int): int 506# returns non-zero on success 507{ 508 if (!elements[el].doneinit) { 509 elements[el].doneinit = 1; 510 case el { 511 MAINMENU => 512 for (e := entries; len e > 0; e = e[1:]) { 513 (text, nil) := e[0]; 514 cmd(top, ".main.menu insert end '" + text); 515 } 516 517 BYCATEGORY => 518 cats := getcategories(); 519 if (cats == nil) { 520 notice("No categories found"); 521 elements[el].doneinit = 0; 522 return 0; 523 } 524 while (cats != nil) { 525 cmd(top, ".cat.menu insert 0 '" + hd cats); 526 cats = tl cats; 527 } 528 BYFONT => 529 elements[el].doneinit = 0; # do it each time 530 fonts := getfonts(currfont); 531 if (fonts == nil) { 532 notice("Can't find font information file"); 533 return 0; 534 } 535 536 cmd(top, ".font.menu delete 0 end"); 537 while (fonts != nil) { 538 cmd(top, ".font.menu insert 0 '" + hd fonts); 539 fonts = tl fonts; 540 } 541 TABLE => 542 inittable(); 543 } 544 545 } 546 return 1; 547} 548 549tablecharpath(col, row: int): string 550{ 551 return ".tbl.tf.c"+string row+"_"+string col; 552} 553 554inittable() 555{ 556 i: int; 557 for (i = 0; i < Tablerows; i++) { 558 cmd(top, tkexpand("$label title .tbl.tf.num" + string i)); 559 cmd(top, sys->sprint("grid .tbl.tf.num%d -row %d", i, i)); 560 561 # >>> could put entry here 562 for (j := 0; j < Tablecols; j++) { 563 cname := ".tbl.tf.c" + string i +"_" +string j; 564 cmd(top, tkexpand("$label unicode "+cname 565 +" -borderwidth 1 -relief raised")); 566 cmd(top, "bind "+cname+" <ButtonRelease-1>" 567 +" {send tblcmd set "+string j+" "+string i+" 0}"); 568 cmd(top, "bind "+cname+" <Double-Button-1>" 569 +" {send tblcmd set "+string j+" "+string i+" 1}"); 570 cmd(top, "grid "+cname+" -row "+string i+" -column "+string (j+1) + 571 " -sticky ews"); 572 } 573 } 574} 575 576# fill table starting at n. 577# return actual starting value. 578filltable(n: int): int 579{ 580 if (n < 0) 581 n = 0; 582 if (n + Tablerows * Tablecols > 16rffff) 583 n = 16rffff - Tablerows * Tablecols; 584 n -= n % Tablecols; 585 for (i := 0; i < Tablerows; i++) { 586 cmd(top, ".tbl.tf.num" + string i +" configure -text '" 587 + sys->sprint("%4.4X",n+i*Tablecols)); 588 for (j := 0; j < Tablecols; j++) { 589 cname := tablecharpath(j, i); 590 cmd(top, cname + " configure -text '" 591 +sys->sprint("%c", n + i * Tablecols + j)); 592 } 593 } 594 return n; 595} 596 597cnumtoint(s: string): int 598{ 599 if (len s == 0) 600 return 0; 601 if (s[0] == '0' && len s > 1) { 602 n: int; 603 if (s[1] == 'x' || s[1] == 'X') { 604 if (len s < 3) 605 return 0; 606 (n, nil) = str->toint(s[2:], 16); 607 } else 608 (n, nil) = str->toint(s, 8); 609 return n; 610 } 611 return int s; 612} 613 614getfonts(font: string): list of string 615{ 616 f := bio->open(font, bio->OREAD); 617 if (f == nil) 618 return nil; 619 620 # ignore header 621 if (bio->f.gets('\n') == nil) 622 return nil; 623 624 ret: list of string; 625 while ((s := bio->f.gets('\n')) != nil) { 626 (count, wds) := sys->tokenize(s, " \t"); 627 if (count < 3 || count > 4) 628 continue; # ignore malformed lines 629 first := cnumtoint(hd wds); 630 wds = tl wds; 631 last := cnumtoint(hd wds); 632 wds = tl wds; 633 if (tl wds != nil) # if optional third field exists 634 wds = tl wds; # ignore it 635 name := hd wds; 636 if (name != "" && name[len name - 1] == '\n') 637 name = name[0:len name - 1]; 638 ret = sys->sprint("%.4X-%.4X: %s", first, last, name) :: ret; 639 } 640 return ret; 641} 642 643getcategories(): list of string 644{ 645 f := bio->open(UNIBLOCKS, bio->OREAD); 646 if (f == nil) 647 return nil; 648 649 ret: list of string; 650 while ((s := bio->f.gets('\n')) != nil) { 651 if (s[0] == '#') 652 continue; 653 (s, nil) = str->splitr(s, "^\n\r"); 654 if (len s > 0) { 655 start, end: string; 656 (start, s) = str->splitl(s, ";"); 657 s = str->drop(s, "; "); 658 (end, s) = str->splitl(s, ";"); 659 s = str->drop(s, "; "); 660 661 ret = start+"-"+end+": "+s :: ret; 662 } 663 } 664 return ret; 665} 666 667 668tkexpand(s: string): string 669{ 670 if (len s == 0 || s[0] != '$') 671 return s; 672 673 cmd, tp, name: string; 674 (cmd, s) = str->splitl(s, " \t"); 675 cmd = cmd[1:]; 676 677 s = str->drop(s, " \t"); 678 (tp, s) = str->splitl(s, " \t"); 679 s = str->drop(s, " \t"); 680 681 (name, s) = str->splitl(s, " \t"); 682 s = str->drop(s, " \t"); 683 684 font := ""; 685 case tp { 686 "deflt" => font = DEFAULTFONT; 687 "title" => font = TITLEFONT; 688 "data" => font = DATAFONT; 689 "button" => font = BUTTONFONT; 690 "unicode" => font = currfont; 691 } 692 if (font != nil) { 693 if (font[0] != '/') 694 font = "/fonts/"+font+".font"; 695 font = "-font "+font; 696 } 697 698 699 ret := cmd+" "+name+" "+font+" "+s; 700 return ret; 701} 702 703categname(s: string): string 704{ 705 r := "Unknown category"; 706 case s { 707 "Mn" => r = "Mark, Non-Spacing "; 708 "Mc" => r = "Mark, Combining"; 709 "Nd" => r = "Number, Decimal Digit"; 710 "No" => r = "Number, Other"; 711 "Zs" => r = "Separator, Space"; 712 "Zl" => r = "Separator, Line"; 713 "Zp" => r = "Separator, Paragraph"; 714 "Cc" => r = "Other, Control or Format"; 715 "Co" => r = "Other, Private Use"; 716 "Cn" => r = "Other, Not Assigned"; 717 "Lu" => r = "Letter, Uppercase"; 718 "Ll" => r = "Letter, Lowercase"; 719 "Lt" => r = "Letter, Titlecase "; 720 "Lm" => r = "Letter, Modifier"; 721 "Lo" => r = "Letter, Other "; 722 "Pd" => r = "Punctuation, Dash"; 723 "Ps" => r = "Punctuation, Open"; 724 "Pe" => r = "Punctuation, Close"; 725 "Po" => r = "Punctuation, Other"; 726 "Sm" => r = "Symbol, Math"; 727 "Sc" => r = "Symbol, Currency"; 728 "So" => r = "Symbol, Other"; 729 } 730 return r; 731} 732 733 734fields(s: string, sep: int): list of string 735# seperator can't be '^' (see string(2)) 736{ 737 cl := ""; cl[0] = sep; 738 ret: list of string; 739 do { 740 (l, r) := str->splitr(s, cl); 741 ret = r :: ret; 742 if (len l > 0) 743 s = l[0:len l - 1]; 744 else 745 s = nil; 746 } while (s != nil); 747 return ret; 748} 749 750fieldindex(sl: list of string, n: int): string 751{ 752 for (; sl != nil; sl = tl sl) { 753 if (n == 0) 754 return hd sl; 755 n--; 756 } 757 return nil; 758} 759 760push(el: int) 761{ 762 if (initelement(el)) { 763 displ.push(elements[el].name); 764 } 765} 766 767pop(el: int) 768# pop elements until we encounter one matching el. 769{ 770 while (displ.top() != elements[el].name) 771 displ.pop(); 772} 773 774tkchan(nm: string): chan of string 775{ 776 c := chan of string; 777 tk->namechan(top, c, nm); 778 return c; 779} 780 781cmd(top: ref Tk->Toplevel, s: string): string 782{ 783 # sys->print("%s\n", s); 784 e := tk->cmd(top, s); 785 if (e != nil && e[0] == '!') 786 sys->fprint(sys->fildes(2), "tk error on '%s': %s\n", s, e); 787 return e; 788} 789 790labelset(t: ref Tk->Toplevel, name: string, val: string) 791{ 792 cmd(t, name+" configure -text '"+val); 793} 794 795 796choosefont(ctxt: ref Draw->Context): string 797{ 798 font := selectfile->filename(ctxt, top.image, "Select a font", "*.font" :: nil, "/fonts"); 799 if (font != nil) { 800 ret := cmd(top, ".fontlabel configure"+" -font "+font); 801 if (len ret > 0 && ret[0] == '!') { 802 font = nil; 803 notice("Bad font: "+ret[1:]); 804 } 805 } 806 return font; 807} 808 809updatefont() 810{ 811 if (elements[TABLE].doneinit) # only if table is being displayed 812 for (i := 0; i < Tablerows; i++) 813 for (j := 0; j < Tablecols; j++) 814 cmd(top, tablecharpath(j, i) + " configure -font "+currfont); 815 # update the font display table if it's being displayed 816 for (el := displ.stk; el != nil; el = tl el) { 817 if (hd el == elements[BYFONT].name) { 818 initelement(BYFONT); 819 } 820 } 821 inspchan <-= "font"; 822} 823 824 825winorg(t: ref Tk->Toplevel): Draw->Point 826{ 827 return Draw->Point(int cmd(t, ". cget -x"), int cmd(t, ". cget -y")); 828} 829 830Widgetstack.new(wn: string): ref Widgetstack 831{ 832 cmd(top, "frame "+wn+" -borderwidth 4 -relief ridge"); 833 834 return ref Widgetstack(nil, wn); 835} 836 837Widgetstack.push(ws: self ref Widgetstack, w: string) 838{ 839 if (w == nil) 840 return; 841 opts: con " -fill y -side left"; 842 843 if (ws.stk == nil) { 844 cmd(top, "pack "+w+" -in "+ws.name+" "+opts); 845 } else { 846 cmd(top, "pack "+w+" -after "+hd ws.stk+" "+opts); 847 } 848 849 ws.stk = w :: ws.stk; 850} 851 852Widgetstack.pop(ws: self ref Widgetstack): string 853{ 854 if (ws.stk == nil) { 855 sys->fprint(stderr, "widget stack underflow!\n"); 856 exit; 857 } 858 old := hd ws.stk; 859 ws.stk = tl ws.stk; 860 cmd(top, "pack forget "+old); 861 return old; 862} 863 864Widgetstack.top(ws: self ref Widgetstack): string 865{ 866 if (ws.stk == nil) 867 return nil; 868 return hd ws.stk; 869} 870 871# binary search for key in f. 872# code converted from bsd source without permission. 873look(f: ref bio->Iobuf, sep: int, key: string): string 874{ 875 bot := mid := big 0; 876 ktop := bio->f.seek(big 0, Sys->SEEKEND); 877 key = canon(key, sep); 878 879 for (;;) { 880 mid = (ktop + bot) / big 2; 881 bio->f.seek(mid, Sys->SEEKSTART); 882 c: int; 883 do { 884 c = bio->f.getb(); 885 mid++; 886 } while (c != bio->EOF && c != bio->ERROR && c != '\n'); 887 (entry, eof) := getword(f); 888 if (entry == nil && eof) 889 break; 890 entry = canon(entry, sep); 891 case comparewords(key, entry) { 892 -2 or -1 or 0 => 893 if (ktop <= mid) 894 break; 895 ktop = mid; 896 continue; 897 1 or 2 => 898 bot = mid; 899 continue; 900 } 901 break; 902 } 903 bio->f.seek(bot, Sys->SEEKSTART); 904 while (bio->f.seek(big 0, Sys->SEEKRELA) < ktop) { 905 (entry, eof) := getword(f); 906 if (entry == nil && eof) 907 return nil; 908 word := canon(entry, sep); 909 case comparewords(key, word) { 910 -2 => 911 return nil; 912 -1 or 0 => 913 return entry; 914 1 or 2 => 915 continue; 916 } 917 break; 918 } 919 for (;;) { 920 (entry, eof) := getword(f); 921 if (entry == nil && eof) 922 return nil; 923 word := canon(entry, sep); 924 case comparewords(key, word) { 925 -1 or 0 => 926 return entry; 927 } 928 break; 929 } 930 return nil; 931} 932 933comparewords(s, t: string): int 934{ 935 if (s == t) 936 return 0; 937 i := 0; 938 for (; i < len s && i < len t && s[i] == t[i]; i++) 939 ; 940 if (i >= len s) 941 return -1; 942 if (i >= len t) 943 return 1; 944 if (s[i] < t[i]) 945 return -2; 946 return 2; 947} 948 949getword(f: ref bio->Iobuf): (string, int) 950{ 951 ret := ""; 952 for (;;) { 953 c := bio->f.getc(); 954 if (c == bio->EOF || c == bio->ERROR) 955 return (ret, 0); 956 if (c == '\n') 957 break; 958 ret[len ret] = c; 959 } 960 return (ret, 1); 961} 962 963canon(s: string, sep: int): string 964{ 965 if (sep < 0) 966 return s; 967 i := 0; 968 for (; i < len s; i++) 969 if (s[i] == sep) 970 break; 971 return s[0:i]; 972} 973