1#! @WISH@ 2# 3# tknamazu.tcl - Tcl/Tk front-end for Namazu. 4# 5# $Id: tknamazu.tcl.in,v 1.15 2000-02-29 19:45:06 kenzo- Exp $ 6# 7# Copyright (C) 1998-2000 Ken-ichi Hirose. All rights reserved. 8# This is free software with ABSOLUTELY NO WARRANTY. 9# 10# This program is free software; you can redistribute it and/or modify 11# it under the terms of the GNU General Public License as published by 12# the Free Software Foundation; either versions 2, or (at your option) 13# any later version. 14# 15# This program is distributed in the hope that it will be useful 16# but WITHOUT ANY WARRANTY; without even the implied warranty of 17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18# GNU General Public License for more details. 19# 20# You should have received a copy of the GNU General Public License 21# along with this program; if not, write to the Free Software 22# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 23# 02111-1307, USA 24# 25 26global version; set version "@VERSION@" 27global conf 28global inside 29global siteurl 30 31regsub -all {\\} $argv0 {/} conf(argv0) 32regsub {^(.*)/.*$} $conf(argv0) {\1} conf(basedir) 33 34################ Evaluation and Initialize items 35proc SetDefaultResources {} { 36 global conf 37 38 set conf(NAMAZU) {%NAMAZU%} 39 set conf(BROWSER) {@LYNX@} 40 set conf(EXTBROWSER) {@NETSCAPE@} 41 set conf(UNCOMPRESS) {@ZCAT@} 42 set conf(MANPAGE) {@GROFF@} 43 set conf(MANPAGEFILTER) {} 44 set conf(MANPATH) {/usr/local/man /usr/share/man /usr/bin/man /usr/man /usr/X11R6/man /usr/openwin/man} 45 set conf(GNUINFO) {@INFO@} 46 set conf(GNUINFOFILTER) {} 47 set conf(GNUINFOTMP) {/tmp/.gnuinfotmp} 48 set conf(WIDTH) {80} 49 set conf(HEIGHT) {20} 50 set conf(LANG) {} 51 set conf(WIDGETFONT) {-misc-Fixed-Medium-R-Normal-*-*-120-*-*-*-*-*-*} 52 set conf(TEXTFONT) {-misc-Fixed-Medium-R-Normal-*-*-120-*-*-*-*-*-*} 53 set conf(WIDGETCOLOR) {gray90} 54# set conf(SELECTCOLOR) {blue60} 55# set conf(TROUGHTCOLOR) {gray30} 56# set conf(FONTCOLOR) {black} 57# set conf(MARKCOLOR) {red} 58# set conf(LINKCOLOR) {blue} 59# set conf(REFERENCECOLOR) {green3} 60 set conf(OPTIONS) {} 61 set conf(NAMAZURC) {} 62 set conf(INDEXES) {@INDEXDIR@} 63 set conf(MKNMZ) {%MKNMZ%} 64 set conf(INDEXOUTPUTDIR) {@INDEXDIR@} 65 set conf(TARGETDIR) {./} 66 set conf(MKOPTIONS) {} 67 set conf(SMARTBROWSE) {1} 68 set conf(HEADERWIPE) {ON} 69 set conf(LOCALSITES) {} 70 set conf(THOUGHTFULFIND) {0} 71 72 set conf(tknmzhome) {%PKGDATADIR%} 73 set conf(wishpath) {@WISH@} 74 set conf(viewer) {} 75 set conf(manpagedir) {} 76 set conf(gnuinfofile) {} 77 set conf(commandline) {} 78} 79 80proc LoadResources {} { 81 global conf env 82 83 if {[catch {open "$conf(tknmzhome)/tknamazurc"} input] \ 84 && [catch {open "$conf(tknmzhome)/tknmzrc"} input] \ 85 && [catch {open "$conf(basedir)/tknamazurc"} input] \ 86 && [catch {open "$conf(basedir)/tknmzrc"} input]} { 87 catch {close $input} 88 puts "I can not read resource file ... (T_T)\n" 89 } else { 90 foreach line [split [read $input] \n] { 91 if [regexp {^([^#][0-9A-Z]*)( | )+(.*)$} $line match item dummy value] { 92 set conf($item) "$value" 93 } 94 } 95 catch {close $input} 96 if {$conf(LANG) == ""} { 97 if [info exists env(LANG)] { 98 set conf(LANG) "$env(LANG)" 99 } else { 100 if [info exists env(LC_CTYPE)] { 101 set conf(LANG) "$env(LC_CTYPE)" 102 } else { 103 set conf(LANG) {C} 104 } 105 } 106 } 107 } 108 109 if { [catch {open "$env(TKNAMAZURC)"} input] \ 110 && [catch {open "$env(TKNMZRC)"} input] \ 111 && [catch {open "$env(TKNMZRC)/.tknmzrc"} input] \ 112 && [catch {open "$env(HOME)/.tknamazurc"} input] \ 113 && [catch {open "$env(HOME)/.tknmzrc"} input]} { 114 catch {close $input} 115 } else { 116 foreach line [split [read $input] \n] { 117 if [regexp {^([^#][0-9A-Z]*)( | )+(.*)$} $line match item dummy value] { 118 set conf($item) "$value" 119 } 120 } 121 catch {close $input} 122 } 123} 124 125proc Initialization {} { 126 global conf inside env tcl_version tk_version tcl_patchLevel tk_patchLevel tcl_platform 127 128 set conf(tclversion) "$tcl_version" 129 set conf(tkversion) "$tk_version" 130 set conf(tclpatchlevel) "$tcl_patchLevel" 131 set conf(tkpatchlevel) "$tk_patchLevel" 132 133 if [info exists tcl_platform(os)] { 134 set conf(os) "$tcl_platform(os)" 135 } else { 136 set conf(os) {unknown} 137 } 138 if [info exists tcl_platform(osVersion)] { 139 set conf(osversion) "$tcl_platform(osVersion)" 140 } else { 141 set conf(osversion) {unknown} 142 } 143 if [info exists tcl_platform(machine)] { 144 set conf(machine) "$tcl_platform(machine)" 145 } else { 146 set conf(machine) {unknown} 147 } 148 if [info exists tcl_platform(platform)] { 149 set conf(platform) "$tcl_platform(platform)" 150 } else { 151 set conf(platform) {unknown} 152 } 153 if [info exists env(HOME)] { 154 set conf(userhome) "$env(HOME)" 155 } else { 156 set conf(userhome) {~} 157 } 158 if {[info commands kanji] == "kanji"} { 159 set conf(kanjimode) 1 160 if ![regexp -nocase {unix} $conf(platform)] { 161 kanji internalCode SJIS 162 } 163 } else { 164 set conf(kanjimode) 0 165 } 166 if {$conf(LANG) == "C"} { 167 set conf(language) {en} 168 } else { 169 regsub {^(..).*} $conf(LANG) {\1} conf(language) 170 } 171 if [regexp -nocase {^windows|^os2|^mac|^beos} $conf(os)] { 172 set conf(argv0) "conf(wishpath) conf(argv0)" 173 } 174 175 set inside(keyword) {} 176 set inside(history) {} 177 set inside(lynxauth) {} 178 set inside(clippedurl) {} 179} 180 181################ proc routine 182proc Browse { url } { 183 global conf inside log but 184 185 $log config -cursor watch 186 update idletasks 187 188 if {![string compare $url ""]} { 189 regexp {(kicker[0-9]+)} [$log tag names [$log index current]] \ 190 match urltag 191 set url [$log get $urltag.first $urltag.last] 192 } 193 194 $but config -text {Back to result} -command {Exec $inside(keyword)} 195 switch -regexp $url { 196 {(\.(htm|HTM).*$)|(^http://)|(^ftp://)|(^file://)} { 197 set conf(viewer) {lynx} 198 set inside(history) "URLViewer $url" 199 URLViewer $url 200 } 201 {(\*.*::)|(^\*.*:.*\.)|((Next|Prev|Up): [^,]*,)|((Next|Prev|Up): [^,]*$)} { 202 regsub -all {\* *(.*)::} $url {\1} url 203 regsub -all {^\*.*:(.*)\.} $url {\1} url 204 regsub -all -nocase {^(Note|Next|Prev|Up):* (.*)} $url {\2} url 205 regsub -all {(.*)\. +([0-9]+$)|,$} $url {\1} url 206 regsub -all {^ *(.*) *$} $url {\1} url 207 if [regexp {\((.+)\).*} $url match file] { 208 regexp {(.*/info/)[^/]*$} $conf(gnuinfofile) match infobasedir 209 regsub {^DIR$} $file {dir} file 210 set url {} 211 set conf(gnuinfofile) "$infobasedir$file" 212 if {($file != "dir") && ![regexp {\.info$} $file]} { 213 append conf(gnuinfofile) ".info" 214 } 215 } 216 set conf(viewer) {gnuinfo} 217 set inside(history) "InfoViewer $url" 218 InfoViewer $conf(gnuinfofile) $url 219 } 220 {^[^/][A-Za-z0-9_\-\.]+\([1-9][A-Za-z0-9]*\)} { 221 set conf(viewer) {manpage} 222 regexp {([A-Za-z0-9_\-\.]+)\(([1-9lno])([A-Za-z0-9]*)\)} $url \ 223 match manual section subsection 224 regexp {(.*)/(man|cat)[1-9lno]/[^/]*$} $conf(manpagedir) \ 225 match manbasedir 226 if {$conf(MANPATH) == ""} { 227 set url "$manbasedir/man$section/$manual.$section" 228 set inside(history) "ManViewer $url" 229 ManViewer $url 230 } 231 foreach manpath [split $conf(MANPATH)] { 232 if {[file exists $manpath/$conf(LANG)/cat$section/$manual.$section] \ 233 || [file exists $manpath/$conf(LANG)/cat$section/$manual.$section.gz]} { 234 set url "$manpath/$conf(LANG)/cat$section/$manual.$section" 235 set inside(history) "Viewer $url" 236 Viewer $url {} 237 break 238 } elseif {[file exists $manpath/$conf(LANG)/man$section/$manual.$section] \ 239 || [file exists $manpath/$conf(LANG)/man$section/$manual.$section.gz]} { 240 set url "$manpath/$conf(LANG)/man$section/$manual.$section" 241 set inside(history) "ManViewer $url" 242 ManViewer $url 243 break 244 } elseif {[file exists $manpath/$conf(language)/cat$section/$manual.$section] \ 245 || [file exists $manpath/$conf(language)/cat$section/$manual.$section.gz]} { 246 set url "$manpath/$conf(language)/cat$section/$manual.$section" 247 set inside(history) "Viewer $url" 248 Viewer $url {} 249 break 250 } elseif {[file exists $manpath/$conf(language)/man$section/$manual.$section] \ 251 || [file exists $manpath/$conf(language)/man$section/$manual.$section.gz]} { 252 set url "$manpath/$conf(language)/man$section/$manual.$section" 253 set inside(history) "ManViewer $url" 254 ManViewer $url 255 break 256 } elseif {[file exists $manpath/cat$section/$manual.$section] \ 257 || [file exists $manpath/cat$section/$manual.$section.gz]} { 258 set url "$manpath/cat$section/$manual.$section" 259 set inside(history) "Viewer $url" 260 Viewer $url {} 261 break 262 } elseif {[file exists $manpath/man$section/$manual.$section] \ 263 || [file exists $manpath/man$section/$manual.$section.gz]} { 264 set url "$manpath/man$section/$manual.$section" 265 set inside(history) "ManViewer $url" 266 ManViewer $url 267 break 268 } else { 269 set url "$manbasedir/man$section/$manual.$section" 270 } 271 } 272 } 273 {.*/info/[^/]*$} { 274 set conf(viewer) {gnuinfo} 275 regsub {^/([A-Za-z])\|(/.*)} $url {\1:\2} url 276 regsub -nocase {(,*)(-[1-9]+)(.*)} $url {\1\3} url 277 set inside(history) "InfoViewer $url" 278 InfoViewer $url {} 279 } 280 {.*/man[1-9lno][A-Za-z]*/[^/]*$} { 281 set conf(viewer) {manpage} 282 regsub {^/([A-Za-z])\|(/.*)} $url {\1:\2} url 283 ManViewer $url 284 } 285 {.*/cat[1-9lno][A-Za-z]*/[^/]*$} { 286 set conf(viewer) {manpage} 287 regsub {^/([A-Za-z])\|(/.*)} $url {\1:\2} url 288 Viewer $url {} 289 } 290 default { 291 set conf(viewer) {} 292 regsub {^/([A-Za-z])\|(/.*)} $url {\1:\2} url 293 Viewer $url {} 294 } 295 } 296 focus .tknmz.result.scroll 297 298 $log config -cursor {} 299 update 300} 301 302proc Kick { url x y } { 303 global log conf 304 305 if {$url == ""} { 306 if {($x != "") && ($y != "")} { 307 PopupMenu2 $x $y 308 } 309 return 310 } 311 if [regexp {(kicker[0-9]+)} \ 312 [$log tag names [$log index current]] match urltag] { 313 set url [$log get $urltag.first $urltag.last] 314 } else { 315 return 316 } 317 318 after 100 319 if [regexp {(\.(htm|HTM).*$)|(^http://)|(^ftp://)|(^file://)} $url] { 320 if {![catch {file readlink $conf(userhome)/.netscape/lock}]} { 321 catch {open "|$conf(EXTBROWSER) -remote openURL($url)"} 322 } else { 323 catch {open "|$conf(EXTBROWSER) $url"} 324 } 325 } else { 326 regsub {^/([A-z])\|(/.*)} $url {\1:\2} url 327 catch {open "|$conf(argv0) $url"} 328 } 329} 330 331proc Exec { searchword } { 332 global log but conf inside siteurl 333 334 $log config -cursor watch 335 update idletasks 336 337 if {![string compare $conf(nmzsite) "commandline"]} { 338 set conf(viewer) {} 339 MakeOptions 340 regsub -all {\"([^\"]+)\"} $searchword {{\1}} searchword 341 set conf(commandline) "$conf(NAMAZU) $conf(OPTIONS) \"$searchword\" $conf(INDEXES)" 342 set exec "$conf(NAMAZU) $conf(OPTIONS) \"$searchword\" $conf(INDEXES)" 343 } else { 344 set conf(viewer) {lynx} 345 MakeFormOptions 346 regsub -all { } $searchword {+} searchword 347 regsub -all {[^a-zA-Z0-9~\-\_\.\/\:\%\+]} $searchword \ 348 {[scan \\& %c x ; format "%%%02X" $x]} conf(searchword) 349 set conf(searchword) "query=[subst $conf(searchword)]" 350 set url $siteurl($conf(nmzsite)) 351 if [regexp {\?} $url] { 352 append url "&" 353 } else { 354 append url "?" 355 } 356 set gm [split [wm geometry .tknmz] x+] 357 set conf(WIDTH) [lindex $gm 0] 358 set conf(HIGTH) [lindex $gm 1] 359 set conf(commandline) "$conf(BROWSER) -dump -width=$conf(WIDTH) $url$conf(searchword)$conf(optionsurl)$conf(indexesurl)" 360 if {![string compare $inside(lynxauth) ""]} { 361 set exec "$conf(BROWSER) -dump -width=$conf(WIDTH) $url$conf(searchword)$conf(optionsurl)$conf(indexesurl)" 362 } else { 363 set exec "$conf(BROWSER) -dump -width=$conf(WIDTH) -auth=$inside(lynxauth) $url$conf(searchword)$conf(optionsurl)$conf(indexesurl)" 364 } 365 } 366 367 if [catch {open "|$exec"} input] { 368 $log config -state normal 369 $log delete 1.0 end 370 $log insert end "%$conf(commandline)\n\n" 371 $log insert end $input 372 catch {close $input} 373 $log see 1.0 374 $log config -relief raised -state disabled 375 $log config -cursor {} 376 update 377 } else { 378 $log config -state normal 379 $log delete 1.0 end 380 $log insert end "%$conf(commandline)\n\n" 381 set i 0 382 foreach line [split [read $input] \n] { 383 if [regexp {^(/.*|[A-Za-z]:/.*|http://.*|file://.*|ftp://.*) ((size )*\([0-9\,]+ bytes\))$} \ 384 $line match url tail ] { 385 incr i 386 $log insert end "$url" kicker$i 387 $log insert end " $tail\n" 388 $log tag configure kicker$i -underline true -foreground blue 389 $log tag bind kicker$i <Enter> {$log config -cursor hand2} 390 $log tag bind kicker$i <Leave> {$log config -cursor {} } 391 $log tag bind kicker$i <Button-1> {Browse {}} 392 } else { 393 $log insert end "$line\n" 394 } 395 } 396 catch {close $input} 397 $log see 1.0 398 $log config -relief raised -state disabled 399 } 400 if {($conf(viewer) == "lynx")} { 401 RichEditControl 402 } 403 Mark $searchword 404 set inside(keyword) "$searchword" 405 $but config -text {Search} -command {Exec $inside(keyword)} 406 focus .tknmz.result.scroll 407 408 if {($conf(viewer) == "lynx")} { 409 bind .tknmz.result.scroll <Key-1> {ShortCutJump 1} 410 bind .tknmz.result.scroll <Key-2> {ShortCutJump 2} 411 bind .tknmz.result.scroll <Key-3> {ShortCutJump 3} 412 bind .tknmz.result.scroll <Key-4> {ShortCutJump 4} 413 bind .tknmz.result.scroll <Key-5> {ShortCutJump 5} 414 bind .tknmz.result.scroll <Key-6> {ShortCutJump 6} 415 bind .tknmz.result.scroll <Key-7> {ShortCutJump 7} 416 bind .tknmz.result.scroll <Key-8> {ShortCutJump 8} 417 bind .tknmz.result.scroll <Key-9> {ShortCutJump 9} 418 } else { 419 bind .tknmz.result.scroll <Key-1> {ShortCutReference 1} 420 bind .tknmz.result.scroll <Key-2> {ShortCutReference 2} 421 bind .tknmz.result.scroll <Key-3> {ShortCutReference 3} 422 bind .tknmz.result.scroll <Key-4> {ShortCutReference 4} 423 bind .tknmz.result.scroll <Key-5> {ShortCutReference 5} 424 bind .tknmz.result.scroll <Key-6> {ShortCutReference 6} 425 bind .tknmz.result.scroll <Key-7> {ShortCutReference 7} 426 bind .tknmz.result.scroll <Key-8> {ShortCutReference 8} 427 bind .tknmz.result.scroll <Key-9> {ShortCutReference 9} 428 } 429 430 $log config -cursor {} 431 update 432} 433 434proc Viewer { url offset } { 435 global conf inside log 436 437 if {![file exists $url]} { 438 if {![file exists $url.gz]} { 439 MessageBox info ok "Error occurred" "$url: File not found." 440 return 441 } else { 442 append url ".gz" 443 } 444 } 445 if [regexp {.*\.gz$} $url ] { 446 set conf(commandline) "$conf(UNCOMPRESS) $url" 447 set url "| $conf(UNCOMPRESS) $url" 448 } else { 449 set conf(commandline) "$url" 450 } 451 if {$offset == ""} { 452 set offset 1 453 } 454 455 if [catch {open "$url"} input] { 456 $log config -state normal 457 $log delete 1.0 end 458 $log insert end "%$conf(commandline)\n" 459 $log insert end $input 460 catch {close $input} 461 $log insert end "\n$url: File not found." 462 $log see 1.0 463 $log config -relief raised -state disabled 464 $log config -cursor {} 465 update 466 } else { 467 $log config -state normal 468 $log delete 1.0 end 469 $log insert end "%$conf(commandline)\n" 470 regsub -all {_|..|.} [read $input] {} line 471 catch {close $input} 472 if {[regexp {^[A-Z][A-Za-z\-]+: } $line]} { 473 foreach headers [split $line \n] { 474 if [regexp {^$} $headers] { 475 incr offset 476 break 477 } else { 478 incr offset 479 } 480 } 481 } 482 $log insert end $line 483 $log see 1.0 484 $log config -relief raised -state disabled 485 } 486 RichEditControl 487 Mark $inside(keyword) 488 if {($offset != 1) && ($conf(HEADERWIPE) == "ON")} { 489 set lastline [lindex [split [$log index end] .] 0] 490 set fraction [expr $offset.0 / $lastline.0] 491 if {$fraction > 0.3} { 492 set pading [expr $conf(HEIGHT) - ($lastline - $offset)] 493 $log config -state normal 494 for {set i 0} {$i <= $pading} {incr i} {$log insert end "\n"} 495 $log config -relief raised -state disabled 496 set pading [expr $lastline + $pading] 497 $log yview moveto [expr $offset.0 / $pading.0] 498 } else { 499 $log yview moveto $fraction 500 } 501 } 502 503 bind .tknmz.result.scroll <Key-1> {ShortCutReference 1} 504 bind .tknmz.result.scroll <Key-2> {ShortCutReference 2} 505 bind .tknmz.result.scroll <Key-3> {ShortCutReference 3} 506 bind .tknmz.result.scroll <Key-4> {ShortCutReference 4} 507 bind .tknmz.result.scroll <Key-5> {ShortCutReference 5} 508 bind .tknmz.result.scroll <Key-6> {ShortCutReference 6} 509 bind .tknmz.result.scroll <Key-7> {ShortCutReference 7} 510 bind .tknmz.result.scroll <Key-8> {ShortCutReference 8} 511 bind .tknmz.result.scroll <Key-9> {ShortCutReference 9} 512} 513 514proc URLViewer { url } { 515 global conf inside log 516 517 set gm [split [wm geometry .tknmz] x+] 518 set conf(WIDTH) [lindex $gm 0] 519 set conf(HIGTH) [lindex $gm 1] 520 set conf(commandline) "$conf(BROWSER) -dump -width=$conf(WIDTH) $url" 521 if {![string compare $inside(lynxauth) ""]} { 522 set urlviewer "$conf(BROWSER) -dump -width=$conf(WIDTH) $url" 523 } else { 524 set urlviewer "$conf(BROWSER) -dump -width=$conf(WIDTH) -auth=$inside(lynxauth) $url" 525 } 526 527 if [catch {open "|$urlviewer"} input] { 528 $log config -state normal 529 $log delete 1.0 end 530 $log insert end "%$conf(commandline)\n" 531 $log insert end $input 532 catch {close $input} 533 $log see 1.0 534 $log config -relief raised -state disabled 535 $log config -cursor {} 536 update 537 } else { 538 $log config -state normal 539 $log delete 1.0 end 540 $log insert end "%$conf(commandline)\n" 541 $log insert end [read $input] 542 catch {close $input} 543 $log see 1.0 544 $log config -relief raised -state disabled 545 } 546 RichEditControl 547 Mark $inside(keyword) 548 549 bind .tknmz.result.scroll <Key-1> {ShortCutJump 1} 550 bind .tknmz.result.scroll <Key-2> {ShortCutJump 2} 551 bind .tknmz.result.scroll <Key-3> {ShortCutJump 3} 552 bind .tknmz.result.scroll <Key-4> {ShortCutJump 4} 553 bind .tknmz.result.scroll <Key-5> {ShortCutJump 5} 554 bind .tknmz.result.scroll <Key-6> {ShortCutJump 6} 555 bind .tknmz.result.scroll <Key-7> {ShortCutJump 7} 556 bind .tknmz.result.scroll <Key-8> {ShortCutJump 8} 557 bind .tknmz.result.scroll <Key-9> {ShortCutJump 9} 558} 559 560proc InfoViewer { url node } { 561 global conf inside log but 562 563 if {![string compare $node ""]} { 564 set node {Top} 565 } 566 if {![file exists $url]} { 567 if {![file exists $url.gz]} { 568 MessageBox info ok "Error occurred" "$url: File not found." 569 return 570 } else { 571 append url ".gz" 572 } 573 } 574 set conf(gnuinfofile) "$url" 575 set conf(gnuinfotmp) "$conf(GNUINFOTMP).[pid]" 576 set conf(commandline) "$conf(GNUINFO) -f $url -o $conf(gnuinfotmp) -n \"$node\"" 577 set infoviewer "$conf(GNUINFO) -f $url -o $conf(gnuinfotmp) -n \"$node\"" 578 579 if {$conf(kanjimode)} { 580 set incode [kanji code $node] 581 if {[string compare $incode "ANY"]} { 582 set node [kanji conversion $incode JIS $node] 583 } 584 } 585 586 catch {exec $conf(GNUINFO) -f $url -o $conf(gnuinfotmp) -n "$node"} input 587 if {![file exists $conf(gnuinfotmp)]} { 588 $log config -state normal 589 $log delete 1.0 end 590 $log insert end "%$conf(commandline)\n" 591 $log see 1.0 592 $log config -relief raised -state disabled 593 $log config -cursor {} 594 update 595 return 596 } else { 597 $log config -state normal 598 $log delete 1.0 end 599 catch {open "$conf(gnuinfotmp)"} input 600 $log insert end "%$conf(commandline)\n" 601 $log insert end [read $input] 602 catch {close $input} 603 $log see 1.0 604 $log config -relief raised -state disabled 605 } 606 file delete -force -- $conf(gnuinfotmp) 607 608 RichEditControl 609 Mark $inside(keyword) 610 611 bind .tknmz.result.scroll <Key-1> {ShortCutReference 1} 612 bind .tknmz.result.scroll <Key-2> {ShortCutReference 2} 613 bind .tknmz.result.scroll <Key-3> {ShortCutReference 3} 614 bind .tknmz.result.scroll <Key-4> {ShortCutReference 4} 615 bind .tknmz.result.scroll <Key-5> {ShortCutReference 5} 616 bind .tknmz.result.scroll <Key-6> {ShortCutReference 6} 617 bind .tknmz.result.scroll <Key-7> {ShortCutReference 7} 618 bind .tknmz.result.scroll <Key-8> {ShortCutReference 8} 619 bind .tknmz.result.scroll <Key-9> {ShortCutReference 9} 620} 621 622proc ManViewer { url } { 623 global conf inside log but 624 625 if {![file exists $url]} { 626 if {![file exists $url.gz]} { 627 MessageBox info ok "Error occurred" "$url: File not found." 628 return 629 } else { 630 append url ".gz" 631 } 632 } 633 set conf(manpagedir) "$url" 634 switch $conf(language) { 635 {ja} { 636 set conf(manpage) "$conf(MANPAGE) -man -Tnippon" 637 } 638 default { 639 set conf(manpage) "$conf(MANPAGE) -man -Tascii" 640 } 641 } 642 switch -regexp $url { 643 {.*\.gz$} { 644 set conf(commandline) "$conf(UNCOMPRESS) $url | $conf(manpage) $conf(MANPAGEFILTER)" 645 set manviewer "$conf(UNCOMPRESS) $url | $conf(manpage) $conf(MANPAGEFILTER)" 646 } 647 default { 648 set conf(commandline) "$conf(manpage) $url $conf(MANPAGEFILTER)" 649 set manviewer "$conf(manpage) $url $conf(MANPAGEFILTER)" 650 } 651 } 652 653 if [catch {open "|$manviewer"} input] { 654 $log config -state normal 655 $log delete 1.0 end 656 $log insert end "%$conf(commandline)\n" 657 $log insert end $input 658 catch {close $input} 659 $log see 1.0 660 $log config -relief raised -state disabled 661 $log config -cursor {} 662 update 663 } else { 664 $log config -state normal 665 $log delete 1.0 end 666 $log insert end "%$conf(commandline)\n" 667 regsub -all {_|..|.} [read $input] {} line 668 catch {close $input} 669 $log insert end $line 670 $log see 1.0 671 $log config -relief raised -state disabled 672 } 673 RichEditControl 674 Mark $inside(keyword) 675 676 bind .tknmz.result.scroll <Key-1> {ShortCutReference 1} 677 bind .tknmz.result.scroll <Key-2> {ShortCutReference 2} 678 bind .tknmz.result.scroll <Key-3> {ShortCutReference 3} 679 bind .tknmz.result.scroll <Key-4> {ShortCutReference 4} 680 bind .tknmz.result.scroll <Key-5> {ShortCutReference 5} 681 bind .tknmz.result.scroll <Key-6> {ShortCutReference 6} 682 bind .tknmz.result.scroll <Key-7> {ShortCutReference 7} 683 bind .tknmz.result.scroll <Key-8> {ShortCutReference 8} 684 bind .tknmz.result.scroll <Key-9> {ShortCutReference 9} 685} 686 687proc RichEditControl {} { 688 global conf log 689 690 switch $conf(viewer) { 691 {gnuinfo} { 692 set pattern {http://[^ >)"`']*|file://[^ >)"`']*|ftp://[^ >)"`']*|\*.*::|^\*.*:.*\.|(Next|Prev|Up): [^,]*,|(Next|Prev|Up): [^,]*$} 693 } 694 {manpage} { 695 set pattern {http://[^ >)"`']*|file://[^ >)"`']*|ftp://[^ >)"`']*|[A-Za-z0-9_\-\.]+\([1-9lno][A-Za-z0-9]*\)} 696 } 697 {lynx} { 698 set pattern {http://[^ >)"`']*|file://[^ >)"`']*|ftp://[^ >)"`']*|\[[0-9]+\]} 699 } 700 default { 701 set pattern {http://[^ >)"`']*|file://[^ >)"`']*|ftp://[^ >)"`']*} 702 } 703 } 704 705 set cur 1.0 706 set i 1 707 set j 1 708 $log config -state normal 709 while 1 { 710 set cur [$log search -regexp -count length -- "$pattern" $cur end] 711 if {$cur == ""} { 712 break 713 } 714 set link [$log get $cur "$cur + $length char"] 715 if {($conf(viewer) == "lynx") \ 716 && [regexp {^\[} $link]} { 717 $log tag add jumper$j $cur "$cur + $length char" 718 $log tag configure jumper$j -underline true -foreground green3 719 $log tag bind jumper$j <Enter> {$log config -cursor hand2} 720 $log tag bind jumper$j <Leave> {$log config -cursor {} } 721 $log tag bind jumper$j <Button-1> {Jump {}} 722 incr j 723 } 724 if {($conf(viewer) == "gnuinfo") \ 725 && [regexp {^\*|^Next|^Prev|^Up} $link]} { 726 $log tag add kicker$i $cur "$cur + $length char" 727 $log tag configure kicker$i -underline true -foreground blue 728 $log tag bind kicker$i <Enter> {$log config -cursor hand2} 729 $log tag bind kicker$i <Leave> {$log config -cursor {} } 730 $log tag bind kicker$i <Button-1> {Browse {}} 731 incr i 732 } 733 if {($conf(viewer) == "manpage") \ 734 && [regexp {^[A-Za-z0-9_\-\.]+\(} $link]} { 735 $log tag add kicker$i $cur "$cur + $length char" 736 $log tag configure kicker$i -underline true -foreground blue 737 $log tag bind kicker$i <Enter> {$log config -cursor hand2} 738 $log tag bind kicker$i <Leave> {$log config -cursor {} } 739 $log tag bind kicker$i <Button-1> {Browse {}} 740 incr i 741 } 742 if {[regexp {^http:|^ftp:|^file:} $link]} { 743 $log tag add kicker$i $cur "$cur + $length char" 744 $log tag configure kicker$i -underline true -foreground blue 745 $log tag bind kicker$i <Enter> {$log config -cursor hand2} 746 $log tag bind kicker$i <Leave> {$log config -cursor {} } 747 $log tag bind kicker$i <Button-1> {Browse {}} 748 incr i 749 } 750 set cur [$log index "$cur + $length char"] 751 } 752 $log see 1.0 753 $log config -relief raised -state disabled 754} 755 756proc Mark { markwords } { 757 global conf log 758 759 if {$markwords == ""} { 760 return 761 } 762 regsub -nocase -all { \& | \| | \! |\( | \)| and | or | not } $markwords { } markwords 763 regsub -all { \+[a-z\-]+\:} $markwords { } markwords 764 regsub -all { \"|\" | \/|\/ | \{|\} |^\"|\"$|^\/|\/$|^\{|\}$} $markwords { } markwords 765 regsub -all {^ +| +$} $markwords {} markwords 766 regsub -all { +} $markwords { } markwords 767 768 $log config -state normal 769 foreach markword [split $markwords] { 770 set cur 1.0 771 while 1 { 772 set cur [$log search -nocase -count length -- "$markword" $cur end] 773 if {$cur == ""} { 774 break 775 } 776 $log tag add markit $cur "$cur + $length char" 777 set cur [$log index "$cur + $length char"] 778 } 779 } 780 $log tag configure markit -foreground red 781 $log config -relief raised -state disabled 782} 783 784proc Jump { ref } { 785 global conf log 786 787 $log config -cursor watch 788 update idletasks 789 790 if {![string compare $ref ""]} { 791 regexp {(jumper[0-9]+)} [$log tag names [$log index current]] match reftag 792 set ref [$log get $reftag.first $reftag.last] 793 regsub {\[([0-9]+)\]} $ref {\1} ref 794 } 795 796 $log tag remove references 0.0 end 797 set cur [$log search -regexp -- "^References$" 1.0 end] 798 if {$cur == ""} { 799 MessageBox info ok "Error occurred" "Referenses not found. ;-(" 800 focus .tknmz.result.scroll 801 return 802 } 803 set cur [$log search -regexp -count length -- "^ *$ref\. .*" $cur end] 804 $log tag add references $cur "$cur + $length char" 805 set cur [$log index "$cur + $length char"] 806 $log tag configure references -foreground green3 807 $log tag raise references 808 $log see $cur 809 810 if {$conf(SMARTBROWSE) != 0} { 811 regsub {^([0-9]+)\.[0-9]+} $cur {\1} refx 812 set localsite {} 813 if {$conf(LOCALSITES) != ""} { 814 foreach sites [split $conf(LOCALSITES)] { 815 append localsite "|$sites" 816 } 817 } 818 switch $conf(SMARTBROWSE) { 819 {1} { 820 set cur [$log search -regexp -- \ 821 "file://|http://localhost|http://127.0.0.1$localsite" $refx.0 end] 822 } 823 default { 824 set cur [$log search -regexp -- "file://|http://|ftp://|mailto:" \ 825 $refx.0 end] 826 } 827 } 828 regsub {^([0-9]+)\.[0-9]+} $cur {\1} urltagx 829 if {$refx == $urltagx} { 830 regexp {(kicker[0-9]+)} [$log tag names [$log index $cur]] \ 831 match urltag 832 set url [$log get $urltag.first $urltag.last] 833 if {$url != ""} { 834 Browse $url 835 } 836 } 837 } 838 839 $log config -cursor {} 840 update 841} 842 843proc ShortCutReference { i } { 844 global log 845 846 if {[$log tag ranges kicker$i] != ""} { 847 set url [$log get kicker$i.first kicker$i.last] 848 Browse $url 849 } 850} 851 852proc ShortCutJump { i } { 853 global log 854 855 if {[$log tag ranges jumper$i] != ""} { 856 set url [$log get jumper$i.first jumper$i.last] 857 Jump $url 858 } 859} 860 861proc MakeOptions {} { 862 global conf selnmzidx opt 863 864 regsub -all { \-\-all| \-\-max\=[0-9]+| \-\-short| \-\-late| \-\-early| \-\-sort\=[a-z\:]+| \-\-ascending} $conf(OPTIONS) {} conf(OPTIONS) 865 if {$opt(n) == "ALL"} { 866 append conf(OPTIONS) " --all" 867 } else { 868 append conf(OPTIONS) " --max=$opt(n)" 869 } 870 if {$opt(s) == "ON"} { 871 append conf(OPTIONS) "" 872 } else { 873 append conf(OPTIONS) " --short" 874 } 875 876 switch $opt(l) { 877 {late} { 878 append conf(OPTIONS) " --late" 879 } 880 {early} { 881 append conf(OPTIONS) " --early" 882 } 883 {subject:ascending} { 884 append conf(OPTIONS) " --sort=field:subject --ascending" 885 } 886 {subject:descending} { 887 append conf(OPTIONS) " --sort=field:subject" 888 } 889 {from:ascending} { 890 append conf(OPTIONS) " --sort=field:from --ascending" 891 } 892 {from:descending} { 893 append conf(OPTIONS) " --sort=field:from" 894 } 895 {size:ascending} { 896 append conf(OPTIONS) " --sort=field:size --ascending" 897 } 898 {size:descending} { 899 append conf(OPTIONS) " --sort=field:size" 900 } 901 {uri:ascending} { 902 append conf(OPTIONS) " --sort=field:uri --ascending" 903 } 904 {uri:descending} { 905 append conf(OPTIONS) " --sort=field:uri" 906 } 907 default { 908 append conf(OPTIONS) "" 909 } 910 } 911 912 if {$conf(NAMAZURC) != ""} { 913 regsub -all { \-\-config\=[^ ]+} $conf(OPTIONS) {} conf(OPTIONS) 914 append conf(OPTIONS) " --config=$conf(NAMAZURC)" 915 } 916 917 if {$conf(INDEXOUTPUTDIR) != ""} { 918 regsub -all { \-O [^ ]+} $conf(MKOPTIONS) {} conf(MKOPTIONS) 919 append conf(MKOPTIONS) " -O $conf(INDEXOUTPUTDIR)" 920 } 921 922 set conf(initflag) 1 923 foreach nmzidx [array names selnmzidx] { 924 if {$selnmzidx($nmzidx)} { 925 if {$conf(initflag)} { 926 set conf(INDEXES) {} 927 set conf(initflag) 0 928 } 929 regexp {^([^ ]+) +(.*)$} $conf($nmzidx) match title value 930 append conf(INDEXES) " $value" 931 } 932 } 933} 934 935proc MakeFormOptions {} { 936 global conf opt selnmzidx 937 938 set conf(optionsurl) {} 939 set conf(indexesurl) {} 940 941 if {$opt(n) == "ALL"} { 942 append conf(optionsurl) "&max=100" 943 } else { 944 append conf(optionsurl) "&max=$opt(n)" 945 } 946 if {$opt(s) == "ON"} { 947 append conf(optionsurl) "&result=normal" 948 } else { 949 append conf(optionsurl) "&result=short" 950 } 951 952 switch $opt(l) { 953 {late} { 954 append conf(optionsurl) "&sort=date%3Alate" 955 } 956 {early} { 957 append conf(optionsurl) "&sort=date%3Aearly" 958 } 959 {subject:ascending} { 960 append conf(optionsurl) "&sort=field%3Asubject%3Aascending" 961 } 962 {subject:descending} { 963 append conf(optionsurl) "&sort=field%3Asubject%3Adescending" 964 } 965 {from:ascending} { 966 append conf(optionsurl) "&sort=field%3Afrom%3Aascending" 967 } 968 {from:descending} { 969 append conf(optionsurl) "&sort=field%3Afrom%3Adescending" 970 } 971 {size:ascending} { 972 append conf(optionsurl) "&sort=field%3Asize%3Aascending" 973 } 974 {size:descending} { 975 append conf(optionsurl) "&sort=field%3Asize%3Adescending" 976 } 977 {uri:ascending} { 978 append conf(optionsurl) "&sort=field%3Auri%3Aascending" 979 } 980 {uri:descending} { 981 append conf(optionsurl) "&sort=field%3Auri%3Adescending" 982 } 983 default { 984 append conf(optionsurl) "&sort=score" 985 } 986 } 987 988 set conf(initflag) 1 989 foreach nmzidx [array names selnmzidx] { 990 if {$selnmzidx($nmzidx)} { 991 if {$conf(initflag)} { 992 set conf(indexesurl) {} 993 set conf(initflag) 0 994 } 995 regexp {^([^ ]+) +(.*)$} $conf($nmzidx) match title value 996 append conf(indexesurl) "&$value" 997 } 998 } 999 append conf(optionsurl) {&mode=tknamazu&whence=0} 1000} 1001 1002proc OpenViewer {} { 1003 global conf 1004 1005 set openlocation [tk_getOpenFile -filetypes {{ALL {*}}}] 1006 if {$openlocation == ""} { 1007 return 1008 } 1009 Browse $openlocation 1010} 1011 1012proc OpenURL {} { 1013 global conf openurl urllocation 1014 1015 if [winfo exists .openurl] { 1016 raise .openurl 1017 focus .openurl.entry 1018 return 1019 } else { 1020 toplevel .openurl -borderwidth 10 1021 wm title .openurl "TkNamazu open URL dialog" 1022 wm iconname .openurl "tknamazu" 1023 wm transient .openurl [winfo toplevel [winfo parent .openurl]] 1024 set x [expr [winfo screenwidth .openurl]/2 - [winfo reqwidth .openurl]/2] 1025 set y [expr [winfo screenheight .openurl]/2 - [winfo reqheight .openurl]/2] 1026 wm geom .openurl +$x+$y 1027 } 1028 1029 frame .openurl.entry 1030 label .openurl.entry.ulabel -text {URL:} 1031 entry .openurl.entry.entry -textvariable urllocation -width 70 \ 1032 -font $conf(WIDGETFONT) 1033 pack .openurl.entry.ulabel .openurl.entry.entry -side left 1034 1035 frame .openurl.buttons 1036 pack .openurl.entry .openurl.buttons -side top -fill x 1037 button .openurl.buttons.ok -text OK -command {set openurl(ok) 1} \ 1038 -underline 0 1039 button .openurl.buttons.cancel -text Cancel -command {set openurl(ok) 0} \ 1040 -underline 0 1041 pack .openurl.buttons.cancel .openurl.buttons.ok -side right 1042 1043 bind .openurl <Alt-o> "focus .openurl.buttons.ok ; break" 1044 bind .openurl <Alt-c> "focus .openurl.buttons.cancel ; break" 1045 bind .openurl <Alt-Key> break 1046 bind .openurl <Return> {set openurl(ok) 1} 1047 bind .openurl <Escape> {set openurl(ok) 0} 1048 bind .openurl <Button-3> {PopupMenu %X %Y} 1049 1050 SetColor {.openurl} 1051 1052 while 1 { 1053 focus .openurl.entry.entry 1054 tkwait variable openurl(ok) 1055 if {$openurl(ok)} { 1056 Browse $urllocation 1057 } else { 1058 break 1059 } 1060 } 1061 focus .tknmz.result.scroll 1062 catch {destroy .openurl} 1063} 1064 1065proc SaveFile {} { 1066 global conf log 1067 1068 set openlocation [tk_getSaveFile -filetypes {{ALL {*}}}] 1069 if {![string compare $openlocation ""]} { 1070 return 1071 } 1072 set savefile [open $openlocation "w"] 1073 puts $savefile [$log get 2.0 end] 1074 catch {close $savefile} 1075} 1076 1077proc MakeNamazuIndexLuncher {} { 1078 global conf selnmzidx 1079 1080 menu .tknmz.file.menu.selnmzidx 1081 wm title .tknmz.file.menu "" 1082 foreach nmzidx [lsort [array names conf]] { 1083 if [regexp {^INDEXES([0-9]+)$|^DATABASES([0-9]+)$} $nmzidx ] { 1084 regexp {^([^ ]+) +(.*)$} $conf($nmzidx) match title value 1085 .tknmz.file.menu.selnmzidx add check -label $title \ 1086 -font $conf(WIDGETFONT) -variable selnmzidx($nmzidx) -selectcolor blue 1087 } 1088 } 1089 .tknmz.file.menu.selnmzidx add separator 1090 .tknmz.file.menu.selnmzidx add command -label {Select All} -underline 0 \ 1091 -font $conf(WIDGETFONT) -command {SelectAll} 1092 .tknmz.file.menu.selnmzidx add command -label {Clear All} -underline 0 \ 1093 -font $conf(WIDGETFONT) -command {ClearAll} 1094 .tknmz.file.menu.selnmzidx add command -label {Add Index} -underline 0 \ 1095 -font $conf(WIDGETFONT) -command {AddNamazuIndex} 1096 .tknmz.file.menu.selnmzidx add command -label {Delete Index} -underline 0 \ 1097 -font $conf(WIDGETFONT) -command {DelNamazuIndex} 1098 1099 SetColor {.tknmz.file.menu.selnmzidx} 1100} 1101 1102proc MakeBookMarkLuncher {} { 1103 global conf bookmark 1104 1105 menu .tknmz.go.menu.selbookmark 1106 wm title .tknmz.go.menu "" 1107 foreach bookmark [lsort [array names conf]] { 1108 if [regexp {^BOOKMARKS([0-9]+)$} $bookmark ] { 1109 regexp {^([^ ]+) +(.*)$} $conf($bookmark) match title value 1110 .tknmz.go.menu.selbookmark add command -label $title \ 1111 -command [list Browse $value] 1112 } 1113 } 1114 .tknmz.go.menu.selbookmark add separator 1115 .tknmz.go.menu.selbookmark add command -label {Add BookMark} -underline 0 \ 1116 -font $conf(WIDGETFONT) -command {AddBookMark} 1117 .tknmz.go.menu.selbookmark add command -label {Delete BookMark} -underline 0 \ 1118 -font $conf(WIDGETFONT) -command {DelBookMark} 1119 .tknmz.go.menu.selbookmark add command -label {Inport BookMark} -underline 0 \ 1120 -font $conf(WIDGETFONT) -command {InportBookMark} 1121 1122 SetColor {.tknmz.go.menu.selbookmark} 1123} 1124 1125proc MakeNamazuSiteSelector {} { 1126 global conf siteurl nmzsite nmzsites 1127 1128 set nmzsites {commandline} 1129 foreach nmzsite [lsort [array names conf]] { 1130 if [regexp {^NAMAZUSITES([0-9]+)$} $nmzsite ] { 1131 regexp {^([^ ]+) +(.*)$} $conf($nmzsite) match title value 1132 lappend nmzsites $title 1133 set siteurl($title) $value 1134 } 1135 } 1136 eval tk_optionMenu .tknmz.optionbar.options.opt2.siteselector conf(nmzsite) $nmzsites 1137 1138 SetColor {.tknmz.optionbar.options.opt2.siteselector} 1139} 1140 1141proc SelectAll {} { 1142 global selnmzidx 1143 1144 foreach nmzidx [array names selnmzidx] { 1145 set selnmzidx($nmzidx) 1 1146 } 1147} 1148 1149proc ClearAll {} { 1150 global selnmzidx 1151 1152 foreach nmzidx [array names selnmzidx] { 1153 set selnmzidx($nmzidx) 0 1154 } 1155} 1156 1157proc AddNamazuIndex {} { 1158 global conf selnmzidx 1159 1160 set openlocation [tk_getOpenFile -filetypes {{NMZ.i} {ALL {*}}}] 1161 if {$openlocation == ""} { 1162 return 1163 } 1164 regsub {^(.*)/NMZ.i} $openlocation {\1} openlocation 1165 regexp {^.*/([^/]+)$} $openlocation match opentitle 1166 set max 1 1167 foreach nmzidx [array names selnmzidx] { 1168 regexp {^INDEXES([0-9]+)$} $nmzidx match i 1169 if {$i > $max} { 1170 set max $i 1171 } 1172 } 1173 incr max 1174 set conf(INDEXES$max) "$opentitle $openlocation" 1175 catch {destroy .tknmz.file.menu.selnmzidx} 1176 MakeNamazuIndexLuncher 1177} 1178 1179proc LoadConf {} { 1180 global conf 1181 1182 set conf(NAMAZURC) [tk_getOpenFile -filetypes {{ALL {*}}}] 1183} 1184 1185proc SetAuthorization {} { 1186 global conf auth login password 1187 1188 if [winfo exists .auth] { 1189 raise .auth 1190 focus .auth.login.entry 1191 return 1192 } else { 1193 toplevel .auth -borderwidth 10 1194 wm title .auth "TkNamazu authorization dialog" 1195 wm iconname .auth "tknamazu" 1196 wm transient .auth [winfo toplevel [winfo parent .auth]] 1197 set x [expr [winfo screenwidth .auth]/2 - [winfo reqwidth .auth]/2] 1198 set y [expr [winfo screenheight .auth]/2 - [winfo reqheight .auth]/2] 1199 wm geom .auth +$x+$y 1200 } 1201 1202 frame .auth.login 1203 label .auth.login.msg -borderwidth 10 -text {Login:} -width 10 1204 entry .auth.login.entry -textvariable login -width 17 \ 1205 -font $conf(WIDGETFONT) 1206 pack .auth.login.msg .auth.login.entry -side left -fill x 1207 1208 frame .auth.password 1209 label .auth.password.msg -borderwidth 10 -text {Password:} -width 10 1210 entry .auth.password.entry -textvariable password -width 17 \ 1211 -font $conf(WIDGETFONT) 1212 pack .auth.password.msg .auth.password.entry -side left -fill x 1213 1214 frame .auth.buttons -bd 10 1215 pack .auth.login .auth.password .auth.buttons -side top -fill x 1216 1217 button .auth.buttons.ok -text OK -command {set auth(ok) 1} -underline 0 1218 button .auth.buttons.cancel -text Cancel -command {set auth(ok) 0} \ 1219 -underline 0 1220 pack .auth.buttons.cancel .auth.buttons.ok -side right 1221 1222 bind .auth <Alt-o> "focus .auth.buttons.ok ; break" 1223 bind .auth <Alt-c> "focus .auth.buttons.cancel ; break" 1224 bind .auth <Alt-Key> break 1225 bind .auth <Return> {set auth(ok) 1} 1226 bind .auth <Escape> {set auth(ok) 0} 1227 bind .auth <Button-3> {PopupMenu %X %Y} 1228 1229 SetColor {.auth} 1230 1231 while 1 { 1232 focus .auth.login.entry 1233 tkwait variable auth(ok) 1234 if {($auth(ok)) && ($login != "")} { 1235 set inside(lynxauth) "$login:$password" 1236 break 1237 } else { 1238 set inside(lynxauth) {} 1239 MessageBox info ok "Clear" "Clear input authorization." 1240 break 1241 } 1242 } 1243 focus .tknmz.result.scroll 1244 catch {destroy .auth} 1245} 1246 1247proc RegexpKeywords { regexpkeywords } { 1248 regsub -nocase -all { \& | \| | \! |\( | \)| and | or | not } $regexpkeywords { } regexpkeywords 1249 regsub -all { \+[a-z\-]+\:} $regexpkeywords { } regexpkeywords 1250 regsub -all { \"|\" | \/|\/ | \{|\} |^\"|\"$|^\/|\/$|^\{|\}$} $regexpkeywords { } regexpkeywords 1251 regsub -all {^ +| +$} $regexpkeywords {} regexpkeywords 1252 regsub -all { +} $regexpkeywords {|} regexpkeywords 1253 return $regexpkeywords 1254} 1255 1256proc FindWord {} { 1257 global conf inside log prompt findword 1258 1259 if [winfo exists .prompt] { 1260 raise .prompt 1261 focus .prompt.entry.entry 1262 return 1263 } else { 1264 toplevel .prompt 1265 wm title .prompt "TkNamazu find dialog" 1266 wm iconname .prompt "tknamazu" 1267 set x [expr [winfo screenwidth .prompt]/2 - [winfo reqwidth .prompt]/2] 1268 set y [expr [winfo screenheight .prompt]/2 - [winfo reqheight .prompt]/2] 1269 wm geom .prompt +$x+$y 1270 } 1271 set prompt(aspect) 1 1272 1273 label .prompt.msg -borderwidth 10 -text {Please input pattern.} 1274 1275 frame .prompt.entry 1276 entry .prompt.entry.entry -textvariable findword -width 32 \ 1277 -font $conf(WIDGETFONT) 1278 button .prompt.entry.clear -text Clear -command {set findword {}} \ 1279 -underline 1 1280 pack .prompt.entry.entry .prompt.entry.clear -side left -fill x 1281 1282 frame .prompt.buttons -bd 10 1283 button .prompt.buttons.ok -text OK -command {set prompt(ok) 1} \ 1284 -underline 0 1285 button .prompt.buttons.cancel -text Cancel -command {set prompt(ok) 0} \ 1286 -underline 0 1287 pack .prompt.buttons.cancel .prompt.buttons.ok -side right 1288 button .prompt.buttons.thoughtful -text toRegexp -underline 0 \ 1289 -command {set findword [RegexpKeywords $findword]; set prompt(regexp) 1} \ 1290 1291 pack .prompt.buttons.thoughtful -side left 1292 1293 frame .prompt.options 1294 checkbutton .prompt.options.nocase -text nocase -variable prompt(nocase) \ 1295 -font $conf(WIDGETFONT) -selectcolor blue -underline 0 1296 1297 checkbutton .prompt.options.regexp -text regexp -variable prompt(regexp) \ 1298 -font $conf(WIDGETFONT) -selectcolor blue -underline 0 1299 1300 radiobutton .prompt.options.forward -text forward -variable prompt(aspect) \ 1301 -font $conf(WIDGETFONT) -selectcolor blue -underline 0 -value 1 1302 1303 radiobutton .prompt.options.backward -text backward -variable prompt(aspect) \ 1304 -font $conf(WIDGETFONT) -selectcolor blue -underline 0 -value 0 1305 1306 pack .prompt.options.nocase .prompt.options.regexp \ 1307 .prompt.options.forward .prompt.options.backward -side left 1308 1309 pack .prompt.msg .prompt.entry .prompt.options .prompt.buttons -side top -fill x 1310 1311 if {![catch {selection get} sel]} { 1312 .prompt.entry.entry delete 0 end 1313 .prompt.entry.entry insert insert [selection get -selection PRIMARY] 1314 } else { 1315 .prompt.entry.entry delete 0 end 1316 switch $conf(THOUGHTFULFIND) { 1317 {1} { 1318 set findword $inside(keyword) 1319 } 1320 {2} { 1321 set prompt(regexp) 1 1322 set findword [RegexpKeywords $inside(keyword)] 1323 } 1324 {3} { 1325 set prompt(regexp) 1 1326 set prompt(nocase) 1 1327 set findword [RegexpKeywords $inside(keyword)] 1328 } 1329 } 1330 } 1331 1332 bind .prompt <Alt-l> "focus .prompt.entry.clear ; break" 1333 bind .prompt <Alt-r> "focus .prompt.options.regexp ; break" 1334 bind .prompt <Alt-n> "focus .prompt.options.nocase ; break" 1335 bind .prompt <Alt-f> "focus .prompt.options.forward ; break" 1336 bind .prompt <Alt-b> "focus .prompt.options.backward ; break" 1337 bind .prompt <Alt-t> "focus .prompt.buttons.thoughtful ; break" 1338 bind .prompt <Alt-o> "focus .prompt.buttons.ok ; break" 1339 bind .prompt <Alt-c> "focus .prompt.buttons.cancel ; break" 1340 bind .prompt <Alt-Key> break 1341 bind .prompt <Return> {set prompt(ok) 1} 1342 bind .prompt <Escape> {set prompt(ok) 0} 1343 bind .prompt <Button-3> {PopupMenu %X %Y} 1344 1345 SetColor {.prompt} 1346 1347 set cur 1.0 1348 while 1 { 1349 focus .prompt.entry.entry 1350 tkwait variable prompt(ok) 1351 set options {} 1352 if {$prompt(ok)} { 1353 if {$prompt(nocase)} { 1354 append options { -nocase} 1355 } 1356 if {$prompt(regexp)} { 1357 if {$conf(kanjimode)} { 1358 if {[string compare [kanji code $findword] "ANY"]} { 1359 MessageBox info ok "Error occurred" \ 1360 "regexp no support in japanes" 1361 set prompt(regexp) 0 1362 } else { 1363 append options { -regexp} 1364 } 1365 } else { 1366 append options { -regexp} 1367 } 1368 } 1369 if {[eval "$log search $options -forwards -- {$findword} 1.0 end"] == ""} { 1370 MessageBox info ok "Error occurred" "Pattern not found. ;-(" 1371 } else { 1372 $log tag remove find 0.0 end 1373 1374 if {$prompt(aspect)} { 1375 set cur [eval "$log search $options -forwards -count length \ 1376 -- {$findword} $cur end"] 1377 if {$cur == ""} { 1378 set cur 1.0 1379 set cur [eval "$log search $options -forwards -count length \ 1380 -- {$findword} $cur end"] 1381 MessageBox info ok "Last line" "I scanned all text." 1382 } 1383 $log tag add find $cur "$cur + $length char" 1384 set cur [$log index "$cur + $length char"] 1385 $log tag configure find -foreground red -background blue 1386 $log tag raise find 1387 $log see $cur 1388 } else { 1389 set cur [eval "$log search $options -backwards -count length \ 1390 -- {$findword} $cur 1.0"] 1391 if {$cur == ""} { 1392 set cur end 1393 set cur [eval "$log search $options -backwards -count length \ 1394 -- {$findword} $cur 1.0"] 1395 MessageBox info ok "Last line" "I scanned all text." 1396 } 1397 $log tag add find $cur "$cur + $length char" 1398 set cur [$log index "$cur - $length char"] 1399 $log tag configure find -foreground red -background blue 1400 $log tag raise find 1401 $log see $cur 1402 } 1403 } 1404 } else { 1405 $log tag remove find 0.0 end 1406 break 1407 } 1408 } 1409 focus .tknmz.result.scroll 1410 catch {destroy .prompt} 1411 1412 Mark $inside(keyword) 1413} 1414 1415proc LoadTknmzrc {} { 1416 global log conf selnmzidx 1417 set tknamazurc [tk_getOpenFile -filetypes {{ALL {*}}}] 1418 1419 if [catch {open "$tknamazurc"} input] { 1420 catch {close($input)} 1421 return 1422 } else { 1423 $log config -state normal 1424 $log delete 1.0 end 1425 foreach line [split [read $input] \n] { 1426 if [regexp {^([^#][0-9A-Z]*)( | )+(.*)$} $line match item dummy value] { 1427 $log insert end "$item : $value\n" 1428 } 1429 } 1430 catch {close $input} 1431 $log config -relief raised -state disabled 1432 update 1433 } 1434 1435 set answer [DialogBox .loadtknamazurc {Make sure} \ 1436 "Are you load this parameters? " question 1 {Yes} {No} ] 1437 if {$answer == 1} { 1438 return 1439 } 1440 1441 if [catch {open "$tknamazurc"} input] { 1442 $log insert end $input 1443 catch {close $input} 1444 return 1445 } else { 1446 set answer [DialogBox .eraseenv {Make sure} \ 1447 "Are you erase old parameters? " question 1 {Yes} {No} ] 1448 if {$answer == 0} { 1449 unset conf 1450 unset selnmzidx 1451 } 1452 1453 foreach line [split [read $input] \n] { 1454 if [regexp {^([^#][0-9A-Z]*)( | )+(.*)$} $line match item dummy value] { 1455 set conf($item) "$value" 1456 } 1457 } 1458 catch {close $input} 1459 catch {destroy .tknmz.file.menu.selnmzidx} 1460 MakeNamazuIndexLuncher 1461 1462 catch {destroy .tknmz.go.menu.selbookmark} 1463 MakeBookMarkLuncher 1464 } 1465} 1466 1467proc DisplayConfiguration {} { 1468 global log conf version env 1469 1470 $log config -state normal 1471 $log delete 1.0 end 1472 $log insert end "# TkNamazu version $version\n" 1473 $log insert end "# Date : [clock format [clock seconds]]\n" 1474 foreach item [lsort [array names conf]] { 1475 $log insert end "$item: $conf($item)\n" 1476 } 1477 $log config -relief raised -state disabled 1478 update 1479 1480 if [catch {open "|$conf(BROWSER) -version"} input] { 1481 catch {close $input} 1482 $log config -state normal 1483 $log insert end "#$conf(BROWSER):Command not found.\n" 1484 $log config -relief raised -state disabled 1485 update 1486 } else { 1487 $log config -state normal 1488 foreach line [split [read $input] \n] { 1489 $log insert end "#$line\n" 1490 } 1491 catch {close($input)} 1492 $log config -relief raised -state disabled 1493 update 1494 } 1495 1496 if [catch {open "|$conf(GNUINFO) --version"} input] { 1497 catch {close $input} 1498 $log config -state normal 1499 $log insert end "#$conf(GNUINFO):Command not found.\n" 1500 $log config -relief raised -state disabled 1501 update 1502 } else { 1503 $log config -state normal 1504 foreach line [split [read $input] \n] { 1505 $log insert end "#$line\n" 1506 } 1507 catch {close $input} 1508 $log config -relief raised -state disabled 1509 update 1510 } 1511 1512 if [catch {open "|$conf(NAMAZU) -v"} input] { 1513 catch {close $input} 1514 $log config -state normal 1515 $log insert end "#$conf(NAMAZU):Command not found.\n" 1516 $log config -relief raised -state disabled 1517 update 1518 } else { 1519 $log config -state normal 1520 foreach line [split [read $input] \n] { 1521 $log insert end "#$line\n" 1522 } 1523 catch {close $input} 1524 $log config -relief raised -state disabled 1525 update 1526 } 1527} 1528 1529proc CopyString {} { 1530 if [catch {selection get} sel] { 1531 return 1532 } 1533 if {[selection own] != ""} { 1534 clipboard clear 1535 clipboard append [selection get] 1536 } 1537} 1538 1539proc CopyURL {} { 1540 global inside 1541 1542 if {$inside(clippedurl) != ""} { 1543 clipboard clear 1544 clipboard append $inside(clippedurl) 1545 } 1546} 1547 1548proc CutString {} { 1549 set widget [focus] 1550 1551 if {[catch {selection get} sel] || ![regexp {\.tknmz\.result\.log|\.tknmz\.keyword} $widget]} { 1552 return 1553 } 1554 if {[selection own] != ""} { 1555 clipboard clear 1556 clipboard append [selection get] 1557 $widget delete sel.first sel.last 1558 } 1559} 1560 1561proc PasteString { widget } { 1562 if {![string compare $widget ""]} { 1563 set widget [focus] 1564 } 1565 if {![winfo exists $widget] || \ 1566 ![regexp {\.tknmz\.result\.log|\.tknmz\.keyword|\.prompt\.entry\.entry|\.openurl\.entry\.entry|\.auth\.entry} $widget]} { 1567 return 1568 } 1569 1570 if [catch {selection get} sel] { 1571 if [catch {selection get -selection CLIPBOARD} sel] { 1572 return 1573 } 1574 } 1575 if {[regexp {\.tknmz\.keyword|\.prompt\.entry\.entry} $widget]} { 1576 $widget insert insert " $sel " 1577 } else { 1578 $widget insert insert "$sel" 1579 } 1580} 1581 1582proc FastExec {} { 1583 global inside 1584 1585 if [catch {selection get} sel] { 1586 return 1587 } 1588 set inside(keyword) [selection get] 1589 Exec [selection get] 1590} 1591 1592proc SetColor { w } { 1593 global conf 1594 1595 catch {$w config -background $conf(WIDGETCOLOR)} 1596 catch {$w config -troughcolor $conf(WIDGETCOLOR)} 1597 catch {$w config -highlightbackground $conf(WIDGETCOLOR)} 1598 foreach child [winfo children $w] { 1599 SetColor $child 1600 } 1601} 1602 1603proc MessageBox { icon type title message } { 1604 tk_messageBox -icon $icon -type $type -title $title -message $message 1605} 1606 1607proc DialogBox {w title text bitmap default args} { 1608 global tkPriv conf 1609 1610 catch {destroy $w} 1611 toplevel $w -class Dialog 1612 wm title $w $title 1613 wm iconname $w Dialog 1614 wm protocol $w WM_DELETE_WINDOW { } 1615 1616 wm transient $w [winfo toplevel [winfo parent $w]] 1617 frame $w.bot -relief raised -bd 1 -background $conf(WIDGETCOLOR) 1618 pack $w.bot -side bottom -fill both 1619 frame $w.top -relief raised -bd 1 -background $conf(WIDGETCOLOR) 1620 pack $w.top -side top -fill both -expand 1 1621 1622 option add *Dialog.msg.wrapLength 3i widgetDefault 1623 label $w.msg -justify left -text $text -bg $conf(WIDGETCOLOR) 1624 catch {$w.msg configure -font \ 1625 -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* 1626 } 1627 pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m 1628 if {$bitmap != ""} { 1629 label $w.bitmap -bitmap $bitmap -bg $conf(WIDGETCOLOR) 1630 pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m 1631 } 1632 1633 set i 0 1634 foreach but $args { 1635 button $w.button$i -text $but -command "set tkPriv(button) $i" -bg $conf(WIDGETCOLOR) 1636 if {$i == $default} { 1637 frame $w.default -relief sunken -bd 1 -background $conf(WIDGETCOLOR) 1638 raise $w.button$i $w.default 1639 pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m 1640 pack $w.button$i -in $w.default -padx 2m -pady 2m 1641 } else { 1642 pack $w.button$i -in $w.bot -side left -expand 1 \ 1643 -padx 3m -pady 2m 1644 } 1645 incr i 1646 } 1647 1648 if {$default >= 0} { 1649 bind $w <Return> " 1650 $w.button$default configure -state active -relief sunken 1651 update idletasks 1652 after 100 1653 set tkPriv(button) $default 1654 " 1655 } 1656 1657 bind $w <Destroy> {set tkPriv(button) -1} 1658 1659 wm withdraw $w 1660 update idletasks 1661 set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \ 1662 - [winfo vrootx [winfo parent $w]]] 1663 set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \ 1664 - [winfo vrooty [winfo parent $w]]] 1665 wm geom $w +$x+$y 1666 wm deiconify $w 1667 1668 # 7. Set a grab and claim the focus too. 1669 1670 set oldFocus [focus] 1671 set oldGrab [grab current $w] 1672 if {$oldGrab != ""} { 1673 set grabStatus [grab status $oldGrab] 1674 } 1675 grab $w 1676 if {$default >= 0} { 1677 focus $w.button$default 1678 } else { 1679 focus $w 1680 } 1681 1682 tkwait variable tkPriv(button) 1683 catch {focus $oldFocus} 1684 catch { 1685 bind $w <Destroy> {} 1686 destroy $w 1687 } 1688 if {$oldGrab != ""} { 1689 if {$grabStatus == "global"} { 1690 grab -global $oldGrab 1691 } else { 1692 grab $oldGrab 1693 } 1694 } 1695 return $tkPriv(button) 1696} 1697 1698proc PopupMenu { x y } { 1699 global log conf inside 1700 1701 if [winfo exists .popupmenu] { 1702 catch {destroy .popupmenu} 1703 } else { 1704 after 100 {grab .popupmenu} 1705 } 1706 1707 set inside(clippedurl) {} 1708 if [regexp {(kicker[0-9]+)} [$log tag names [$log index current]] match urltag] { 1709 set inside(clippedurl) [$log get $urltag.first $urltag.last] 1710 } 1711 1712 menu .popupmenu -tearoff no 1713 .popupmenu add command -label {Search this} -underline 0 \ 1714 -command {FastExec} -font $conf(WIDGETFONT) 1715 .popupmenu add separator 1716 .popupmenu add command -label {Copy and Paste to Keyword} -underline 18 \ 1717 -command {CopyString ; PasteString {.tknmz.keyword}} -font $conf(WIDGETFONT) 1718 .popupmenu add command -label {Copy and Paste to Findword} -underline 18 \ 1719 -command {FindWord ; CopyString ; PasteString {.prompt.entry.entry}} -font $conf(WIDGETFONT) 1720 .popupmenu add command -label {Copy this URL} -underline 11 \ 1721 -command {CopyURL} -font $conf(WIDGETFONT) 1722 .popupmenu add separator 1723 .popupmenu add command -label {Copy} -underline 0 \ 1724 -command {CopyString} -font $conf(WIDGETFONT) 1725 .popupmenu add command -label {Paste} -underline 0 \ 1726 -command {PasteString {}} -font $conf(WIDGETFONT) 1727 .popupmenu add command -label {Cut} -underline 1 \ 1728 -command {CutString} -font $conf(WIDGETFONT) 1729 .popupmenu add command -label {Editable} -underline 0 \ 1730 -command {$log config -state normal -relief sunken } -font $conf(WIDGETFONT) 1731 .popupmenu add separator 1732 .popupmenu add command -label {External Browser or Viewer} -underline 1 \ 1733 -command {Kick $inside(clippedurl) {} {}} -font $conf(WIDGETFONT) 1734 .popupmenu add command -label {Other TkNamazu} -underline 1 \ 1735 -command {catch {open "|$conf(argv0) $inside(clippedurl)"}} \ 1736 -font $conf(WIDGETFONT) 1737 .popupmenu add separator 1738 .popupmenu add command -label {Quit} -underline 0 \ 1739 -command {Quit} -font $conf(WIDGETFONT) 1740 1741 SetColor {.popupmenu} 1742 1743 update 1744 tk_popup .popupmenu $x $y 1745} 1746 1747proc PopupMenu2 { x y } { 1748 global conf inside log 1749 1750 if [winfo exists .popupmenu2] { 1751 catch {destroy .popupmenu2} 1752 } else { 1753 after 100 {grab .popupmenu2} 1754 } 1755 1756 menu .popupmenu2 -tearoff no 1757 .popupmenu2 add command -label {0} -underline 0 \ 1758 -command {Exec $inside(keyword)} -font $conf(WIDGETFONT) 1759 if {($conf(viewer) == "lynx")} { 1760 .popupmenu2 add command -label {1} -underline 0 \ 1761 -command {ShortCutJump 1} -font $conf(WIDGETFONT) 1762 .popupmenu2 add command -label {2} -underline 0 \ 1763 -command {ShortCutJump 2} -font $conf(WIDGETFONT) 1764 .popupmenu2 add command -label {3} -underline 0 \ 1765 -command {ShortCutJump 3} -font $conf(WIDGETFONT) 1766 .popupmenu2 add command -label {4} -underline 0 \ 1767 -command {ShortCutJump 4} -font $conf(WIDGETFONT) 1768 .popupmenu2 add command -label {5} -underline 0 \ 1769 -command {ShortCutJump 5} -font $conf(WIDGETFONT) 1770 .popupmenu2 add command -label {6} -underline 0 \ 1771 -command {ShortCutJump 6} -font $conf(WIDGETFONT) 1772 .popupmenu2 add command -label {7} -underline 0 \ 1773 -command {ShortCutJump 7} -font $conf(WIDGETFONT) 1774 .popupmenu2 add command -label {8} -underline 0 \ 1775 -command {ShortCutJump 8} -font $conf(WIDGETFONT) 1776 .popupmenu2 add command -label {9} -underline 0 \ 1777 -command {ShortCutJump 9} -font $conf(WIDGETFONT) 1778 } else { 1779 .popupmenu2 add command -label {1} -underline 0 \ 1780 -command {ShortCutReference 1} -font $conf(WIDGETFONT) 1781 .popupmenu2 add command -label {2} -underline 0 \ 1782 -command {ShortCutReference 2} -font $conf(WIDGETFONT) 1783 .popupmenu2 add command -label {3} -underline 0 \ 1784 -command {ShortCutReference 3} -font $conf(WIDGETFONT) 1785 .popupmenu2 add command -label {4} -underline 0 \ 1786 -command {ShortCutReference 4} -font $conf(WIDGETFONT) 1787 .popupmenu2 add command -label {5} -underline 0 \ 1788 -command {ShortCutReference 5} -font $conf(WIDGETFONT) 1789 .popupmenu2 add command -label {6} -underline 0 \ 1790 -command {ShortCutReference 6} -font $conf(WIDGETFONT) 1791 .popupmenu2 add command -label {7} -underline 0 \ 1792 -command {ShortCutReference 7} -font $conf(WIDGETFONT) 1793 .popupmenu2 add command -label {8} -underline 0 \ 1794 -command {ShortCutReference 8} -font $conf(WIDGETFONT) 1795 .popupmenu2 add command -label {9} -underline 0 \ 1796 -command {ShortCutReference 9} -font $conf(WIDGETFONT) 1797 } 1798 .popupmenu2 add separator 1799 .popupmenu2 add command -label {To Top} -underline 3 \ 1800 -command {$log see 1.0} -font $conf(WIDGETFONT) 1801 .popupmenu2 add command -label {To Bottom} -underline 3 \ 1802 -command {$log see end} -font $conf(WIDGETFONT) 1803 .popupmenu2 add separator 1804 .popupmenu2 add command -label {Help} -underline 0 \ 1805 -command {HelpView} -font $conf(WIDGETFONT) 1806 .popupmenu2 add separator 1807 .popupmenu2 add cascade -label {Bookmark} -underline 4 \ 1808 -menu .popupmenu2.selbookmark -font $conf(WIDGETFONT) 1809 menu .popupmenu2.selbookmark -tearoff no 1810 foreach bookmark [array names conf] { 1811 if [regexp {^BOOKMARKS([0-9]+)$} $bookmark ] { 1812 regexp {^([^ ]+) +(.*)$} $conf($bookmark) match title value 1813 .popupmenu2.selbookmark add command -label $title \ 1814 -command [list Browse $value] 1815 } 1816 } 1817 1818 SetColor {.popupmenu2} 1819 1820 update 1821 tk_popup .popupmenu2 $x $y 1822} 1823 1824proc Quit {} { 1825 global conf inside answer 1826 1827 if [winfo exists .quit] { 1828 raise .quit 1829 return 1830 } else { 1831 toplevel .quit 1832 wm title .quit "TkNamazu Quit dialog" 1833 wm iconname .quit "tknamazu" 1834 wm protocol .quit WM_DELETE_WINDOW { } 1835 set x [expr [winfo screenwidth .quit]/2 - [winfo reqwidth .quit]/2] 1836 set y [expr [winfo screenheight .quit]/2 - [winfo reqheight .quit]/2] 1837 wm geom .quit +$x+$y 1838 after 100 {grab .quit} 1839 } 1840 1841 label .quit.msg -borderwidth 10 -text {Really? ;-(} 1842 1843 frame .quit.buttons -bd 10 1844 button .quit.buttons.yes -text Yes -command {set answer 1} \ 1845 -underline 0 1846 button .quit.buttons.no -text No -command {set answer 0} \ 1847 -underline 0 1848 pack .quit.buttons.no .quit.buttons.yes -side right 1849 1850 pack .quit.msg .quit.buttons -side top -fill x 1851 1852 SetColor {.quit} 1853 1854 while 1 { 1855 focus .quit.buttons.no 1856 tkwait variable answer 1857 if {$answer == 1} { 1858 grab release .quit 1859 destroy .tknmz 1860 focus $inside(oldfocus) 1861 exit 1862 } else { 1863 break 1864 } 1865 } 1866 focus .tknmz.result.scroll 1867 catch {destroy .quit} 1868 1869 Mark $inside(keyword) 1870} 1871 1872proc HelpView {} { 1873 global conf inside log 1874 1875 $log config -cursor watch 1876 update idletasks 1877 1878 set conf(viewer) {lynx} 1879 1880 if {[file exists $conf(tknmzhome)/tknamazu.hlp.$conf(LANG)]} { 1881 Viewer "$conf(tknmzhome)/tknamazu.hlp.$conf(LANG)" {} 1882 } elseif {[file exists $conf(tknmzhome)/tknamazu.hlp.$conf(language)]} { 1883 Viewer "$conf(tknmzhome)/tknamazu.hlp.$conf(language)" {} 1884 } elseif {[file exists $conf(tknmzhome)/tknamazu.hlp.en]} { 1885 Viewer "$conf(tknmzhome)/tknamazu.hlp.en" {} 1886 } 1887 1888 Mark {TKNAMAZU ^^} 1889 $log config -cursor {} 1890 update 1891 1892 bind .tknmz.result.scroll <Key-1> {ShortCutJump 1} 1893 bind .tknmz.result.scroll <Key-2> {ShortCutJump 2} 1894 bind .tknmz.result.scroll <Key-3> {ShortCutJump 3} 1895 bind .tknmz.result.scroll <Key-4> {ShortCutJump 4} 1896 bind .tknmz.result.scroll <Key-5> {ShortCutJump 5} 1897 bind .tknmz.result.scroll <Key-6> {ShortCutJump 6} 1898 bind .tknmz.result.scroll <Key-7> {ShortCutJump 7} 1899 bind .tknmz.result.scroll <Key-8> {ShortCutJump 8} 1900 bind .tknmz.result.scroll <Key-9> {ShortCutJump 9} 1901} 1902 1903proc AboutTknamazu {} { 1904 global version conf 1905 1906 if [winfo exists .about] { 1907 raise .about 1908 focus .about.ok.b 1909 return 1910 } else { 1911 toplevel .about 1912 wm title .about "TkNamazu about" 1913 wm iconname .about "tknamazu" 1914 set x [expr [winfo screenwidth .about]/2 - [winfo reqwidth .about]/2] 1915 set y [expr [winfo screenheight .about]/2 - [winfo reqheight .about]/2] 1916 wm geom .about +$x+$y 1917 after 100 {grab .about} 1918 } 1919 1920 1921 frame .about.msg1 -relief flat -borderwidth 2 -bg white 1922 image create photo tknmzlogo -file "$conf(tknmzhome)/tknamazu_logo.ppm" 1923 pack .about.msg1 -fill both 1924 label .about.msg1.title1 -text {Tcl/Tk Namazu client} \ 1925 -font $conf(WIDGETFONT) -background white 1926 label .about.msg1.title2 -text "version $version" \ 1927 -font $conf(WIDGETFONT) -background white 1928 button .about.msg1.title3 -image tknmzlogo -background white \ 1929 -highlightbackground white -command {HelpView ; Jump {0}} 1930 label .about.msg1.title4 -text {- GPL2 software -} \ 1931 -font $conf(WIDGETFONT) -background white 1932 label .about.msg1.title5 -text {Copyright (C) 1998} \ 1933 -font $conf(WIDGETFONT) -background white 1934 label .about.msg1.title6 -text {Ken-ichi Hirose.} \ 1935 -font $conf(WIDGETFONT) -background white 1936 label .about.msg1.title7 -text {All rights reserved.} \ 1937 -font $conf(WIDGETFONT) -background white 1938 1939 pack .about.msg1.title1 .about.msg1.title2 1940 pack .about.msg1.title3 1941 pack .about.msg1.title4 .about.msg1.title5 .about.msg1.title6 .about.msg1.title7 1942 1943 frame .about.info -bg white 1944 pack .about.info -fill both 1945 set m1 {.about.info.list1} 1946 set m2 {.about.info.list2} 1947 1948 listbox $m1 -bg white -height 7 -width 12 -font $conf(WIDGETFONT) -borderwidth 0 1949 $m1 insert end "TKNMZPATH" 1950 $m1 insert end "HOME" 1951 $m1 insert end "Tcl/Tk" 1952 $m1 insert end "PatchLevel" 1953 $m1 insert end "OS" 1954 $m1 insert end "Machine" 1955 $m1 insert end "Platform" 1956 1957 listbox $m2 -bg white -height 7 -width 28 -font $conf(WIDGETFONT) -borderwidth 0 1958 $m2 insert end $conf(tknmzhome) 1959 $m2 insert end $conf(userhome) 1960 $m2 insert end "$conf(tclversion) / $conf(tkversion)" 1961 $m2 insert end "$conf(tclpatchlevel) / $conf(tkpatchlevel)" 1962 $m2 insert end "$conf(os) $conf(osversion)" 1963 $m2 insert end $conf(machine) 1964 $m2 insert end $conf(platform) 1965 1966 pack $m1 $m2 -side left -expand yes -fill both 1967 1968 frame .about.ok -bg white 1969 pack .about.ok -fill both 1970 1971 button .about.ok.b -text { OK } -font $conf(WIDGETFONT) -background gray \ 1972 -highlightbackground gray -command { grab release .about ; destroy .about } 1973 pack .about.ok.b -expand yes 1974 1975 focus .about.ok.b 1976} 1977 1978proc SetResources {} { 1979 global conf resources 1980 1981 if [winfo exists .resources] { 1982 raise .resources 1983 focus .options.ok.b 1984 return 1985 } else { 1986 toplevel .resources 1987 wm title .resources "TkNamazu resources" 1988 wm iconname .resources "tknamazu" 1989 wm transient .resources [winfo toplevel [winfo parent .resources]] 1990 set x [expr [winfo screenwidth .resources]/2 - [winfo reqwidth .resources]/2] 1991 set y [expr [winfo screenheight .resources]/2 - [winfo reqheight .resources]/2] 1992 wm geom .resources +$x+$y 1993 } 1994 1995# set initialColor [$button cget -$name] 1996# set color [tk_chooseColor -title "Choose a $name color" -parent $w -initialcolor $initialColor] 1997 1998 frame .resources.namazu 1999 label .resources.namazu.label -borderwidth 10 -text {NAMAZU path: } 2000 entry .resources.namazu.entry -textvariable conf(NAMAZU) -width 32 \ 2001 -font $conf(WIDGETFONT) 2002 button .resources.namazu.browse -text {Browse} -font $conf(WIDGETFONT) \ 2003 -underline 0 -command {set conf(NAMAZU) [tk_getOpenFile \ 2004 -filetypes {{ALL {*}}}]} 2005 pack .resources.namazu.label .resources.namazu.entry \ 2006 .resources.namazu.browse -side left -fill both -expand true 2007 2008 frame .resources.browser 2009 label .resources.browser.label -borderwidth 10 -text {BROWSER path: } 2010 entry .resources.browser.entry -textvariable conf(BROWSER) -width 32 \ 2011 -font $conf(WIDGETFONT) 2012 button .resources.browser.browse -text {Browse} -font $conf(WIDGETFONT) \ 2013 -underline 0 -command {set conf(BROWSER) [tk_getOpenFile \ 2014 -filetypes {{ALL {*}}}]} 2015 pack .resources.browser.label .resources.browser.entry \ 2016 .resources.browser.browse -side left -fill both -expand true 2017 2018 frame .resources.extbrowser 2019 label .resources.extbrowser.label -borderwidth 10 -text {EXTBROWSER path:} 2020 entry .resources.extbrowser.entry -textvariable conf(EXTBROWSER) -width 32 \ 2021 -font $conf(WIDGETFONT) 2022 button .resources.extbrowser.browse -text {Browse} -font $conf(WIDGETFONT) \ 2023 -underline 0 -command {set conf(EXTBROWSER) [tk_getOpenFile \ 2024 -filetypes {{ALL {*}}}]} 2025 pack .resources.extbrowser.label .resources.extbrowser.entry \ 2026 .resources.extbrowser.browse -side left -fill both -expand true 2027 2028 frame .resources.extviewer 2029 label .resources.extviewer.label -borderwidth 10 -text {EXTVIEWER path: } 2030 entry .resources.extviewer.entry -textvariable conf(EXTVIEWER) -width 32 \ 2031 -font $conf(WIDGETFONT) 2032 button .resources.extviewer.browse -text {Browse} -font $conf(WIDGETFONT) \ 2033 -underline 0 -command {set conf(EXTVIEWER) [tk_getOpenFile \ 2034 -filetypes {{ALL {*}}}]} 2035 pack .resources.extviewer.label .resources.extviewer.entry \ 2036 .resources.extviewer.browse -side left -fill both -expand true 2037 2038 frame .resources.uncompress 2039 label .resources.uncompress.label -borderwidth 10 -text {UNCOMPRESS path:} 2040 entry .resources.uncompress.entry -textvariable conf(UNCOMPRESS) -width 32 \ 2041 -font $conf(WIDGETFONT) 2042 button .resources.uncompress.browse -text {Browse} -font $conf(WIDGETFONT) \ 2043 -underline 0 -command {set conf(UNCOMPRESS) [tk_getOpenFile \ 2044 -filetypes {{ALL {*}}}]} 2045 pack .resources.uncompress.label .resources.uncompress.entry \ 2046 .resources.uncompress.browse -side left -fill both -expand true 2047 2048 frame .resources.manpage 2049 label .resources.manpage.label -borderwidth 10 -text {MANPAGE path: } 2050 entry .resources.manpage.entry -textvariable conf(MANPAGE) -width 32 \ 2051 -font $conf(WIDGETFONT) 2052 button .resources.manpage.browse -text {Browse} -font $conf(WIDGETFONT) \ 2053 -underline 0 -command {set conf(MANPAGE) [tk_getOpenFile \ 2054 -filetypes {{ALL {*}}}]} 2055 pack .resources.manpage.label .resources.manpage.entry \ 2056 .resources.manpage.browse -side left -fill both -expand true 2057 2058 frame .resources.gnuinfo 2059 label .resources.gnuinfo.label -borderwidth 10 -text {GNUINFO path: } 2060 entry .resources.gnuinfo.entry -textvariable conf(GNUINFO) -width 32 \ 2061 -font $conf(WIDGETFONT) 2062 button .resources.gnuinfo.browse -text {Browse} -font $conf(WIDGETFONT) \ 2063 -underline 0 -command {set conf(GNUINFO) [tk_getOpenFile \ 2064 -filetypes {{ALL {*}}}]} 2065 pack .resources.gnuinfo.label .resources.gnuinfo.entry \ 2066 .resources.gnuinfo.browse -side left -fill both -expand true 2067 2068 frame .resources.mknmz 2069 label .resources.mknmz.label -borderwidth 10 -text {MKNMZ path: } 2070 entry .resources.mknmz.entry -textvariable conf(MKNMZ) -width 32 \ 2071 -font $conf(WIDGETFONT) 2072 button .resources.mknmz.browse -text {Browse} -font $conf(WIDGETFONT) \ 2073 -underline 0 -command {set conf(MKNMZ) [tk_getOpenFile \ 2074 -filetypes {{ALL {*}}}]} 2075 pack .resources.mknmz.label .resources.mknmz.entry \ 2076 .resources.mknmz.browse -side left -fill both -expand true 2077 2078 frame .resources.wdnmz 2079 label .resources.wdnmz.label -borderwidth 10 -text {WDNMZ path: } 2080 entry .resources.wdnmz.entry -textvariable conf(WDNMZ) -width 32 \ 2081 -font $conf(WIDGETFONT) 2082 button .resources.wdnmz.browse -text {Browse} -font $conf(WIDGETFONT) \ 2083 -underline 0 -command {set conf(WDNMZ) [tk_getOpenFile \ 2084 -filetypes {{ALL {*}}}]} 2085 pack .resources.wdnmz.label .resources.wdnmz.entry \ 2086 .resources.wdnmz.browse -side left -fill both -expand true 2087 2088 frame .resources.buttons 2089 button .resources.buttons.ok -text OK -command {set resources(ok) 1} \ 2090 -underline 0 2091 button .resources.buttons.cancel -text Cancel -command {set resources(ok) 0} \ 2092 -underline 0 2093 button .resources.buttons.apply -text Apply -command {set resources(ok) 2} \ 2094 -underline 0 2095 pack .resources.buttons.apply .resources.buttons.cancel \ 2096 .resources.buttons.ok -side right 2097 2098 pack .resources.namazu .resources.browser .resources.extbrowser \ 2099 .resources.extviewer .resources.uncompress .resources.manpage \ 2100 .resources.gnuinfo .resources.mknmz .resources.mknmz \ 2101 .resources.mknmz .resources.buttons -side top -fill x 2102 2103 bind .resources <Return> {set resources(ok) 1} 2104 bind .resources <Escape> {set resources(ok) 0} 2105 bind .resources <Button-3> {PopupMenu %X %Y} 2106 2107 SetColor {.resources} 2108 2109 while 1 { 2110 focus .resources.buttons.cancel 2111 tkwait variable resources(ok) 2112 if {$resources(ok)} { 2113 break 2114 } else { 2115 break 2116 } 2117 } 2118 focus .tknmz.result.scroll 2119 catch {destroy .resources} 2120} 2121 2122################ replace proc routine 2123proc bgerror {devnull} {} 2124 2125################ helper proc routine 2126proc MknmzHelper {} { 2127 global mklog mkbut conf 2128 2129 if [winfo exists .tkmknmz] { 2130 raise .tkmknmz 2131 focus .tkmknmz.input.location 2132 return 2133 } else { 2134 toplevel .tkmknmz 2135 wm title .tkmknmz "TkNamazu mknmz" 2136 wm iconname .tkmknmz "tknamazu" 2137 } 2138 2139 frame .tkmknmz.input -borderwidth 1 2140 pack .tkmknmz.input -side top -fill x 2141 label .tkmknmz.input.l -text {Location:} -padx 0 -font $conf(WIDGETFONT) 2142 entry .tkmknmz.input.location -width 20 -font $conf(WIDGETFONT) \ 2143 -relief sunken -textvariable conf(TARGETDIR) 2144 pack .tkmknmz.input.l -side left 2145 pack .tkmknmz.input.location -side left -fill x -expand true 2146 set mkbut [button .tkmknmz.input.execute -text {Execute} -font $conf(WIDGETFONT) \ 2147 -underline 1 -command {ExecMknmz}] 2148 button .tkmknmz.input.browse -text {Browse} -font $conf(WIDGETFONT) \ 2149 -underline 0 -command {DirectoryExplorer} 2150 pack .tkmknmz.input.browse .tkmknmz.input.execute -side right 2151 2152 bind .tkmknmz.input.location <Return> {ExecMknmz} 2153 bind .tkmknmz.input.location <Control-c> {Break} 2154 bind .tkmknmz <Alt-x> {focus .tkmknmz.input.execute ; break} 2155 bind .tkmknmz <Alt-b> {focus .tkmknmz.input.browse ; break} 2156 bind .tkmknmz <Button-3> {PopupMenu %X %Y} 2157 2158 frame .tkmknmz.result 2159 pack .tkmknmz.result -side top -fill both -expand true 2160 set mklog [text .tkmknmz.result.log \ 2161 -width $conf(WIDTH) -height [expr $conf(HEIGHT) / 2] -font $conf(WIDGETFONT) \ 2162 -borderwidth 2 -relief sunken -setgrid true -state normal \ 2163 -yscrollcommand {.tkmknmz.result.scroll set}] 2164 scrollbar .tkmknmz.result.scroll -command {.tkmknmz.result.log yview} 2165 pack .tkmknmz.result.scroll -side right -fill y 2166 pack .tkmknmz.result.log -side left -fill both -expand true 2167 2168 focus .tkmknmz.input.location 2169 2170 SetColor {.tkmknmz} 2171} 2172 2173proc ExecMknmz {} { 2174 global mklog mkinput mkbut conf 2175 2176 MakeOptions 2177 $mklog delete 1.0 end 2178 if [catch {open "|$conf(MKNMZ) $conf(MKOPTIONS) \"$conf(TARGETDIR)\""} mkinput] { 2179 $mklog insert end "$mkinput\n" 2180 } else { 2181 fileevent $mkinput readable { 2182 if [eof $mkinput] { 2183 BreakMknmz 2184 } else { 2185 gets $mkinput mkline 2186 $mklog insert end "$mkline\n" 2187 $mklog see end 2188 update 2189 } 2190 } 2191 set conf(commandline) "$conf(MKNMZ) $conf(MKOPTIONS) $conf(TARGETDIR)" 2192 $mklog insert end "%$conf(commandline)\n" 2193 $mkbut config -text {Stop} -command {BreakMknmz} 2194 } 2195} 2196 2197proc BreakMknmz {} { 2198 global mkinput mkbut 2199 2200 catch {close $mkinput} 2201 $mkbut config -text {Execute} -command {ExecMknmz} 2202} 2203 2204proc DirectoryExplorer {} { 2205 global conf 2206 2207 set conf(TARGETDIR) [tk_getOpenFile -filetypes {{ALL {*}}}] 2208 regsub {^(.*/).*} $conf(TARGETDIR) {\1} conf(TARGETDIR) 2209} 2210 2211proc MainWidget {} { 2212global conf inside version log but 2213 2214set inside(oldfocus) [focus] 2215wm withdraw . 2216toplevel .tknmz -class TkNamazu 2217wm minsize .tknmz 40 5 2218wm title .tknmz "TkNamazu version $version" 2219wm iconname .tknmz "tknamazu" 2220wm protocol .tknmz WM_DELETE_WINDOW {exit} 2221 2222frame .tknmz.menubar 2223pack .tknmz.menubar -side top -fill x 2224 menubutton .tknmz.file -text {File} -menu .tknmz.file.menu -underline 0 \ 2225 -font $conf(WIDGETFONT) 2226 menu .tknmz.file.menu -tearoff no 2227 .tknmz.file.menu add command -label {Open} -underline 0 \ 2228 -font $conf(WIDGETFONT) -command {OpenViewer} 2229 .tknmz.file.menu add command -label {Open URL} -underline 5 \ 2230 -font $conf(WIDGETFONT) -command {OpenURL} 2231 .tknmz.file.menu add command -label {Save As} -underline 2 \ 2232 -font $conf(WIDGETFONT) -command {SaveFile} 2233 .tknmz.file.menu add separator 2234 .tknmz.file.menu add command -label {Load namazurc} -underline 0 \ 2235 -font $conf(WIDGETFONT) -command {LoadConf} 2236 .tknmz.file.menu add separator 2237 .tknmz.file.menu add cascade -label {Select Indexes} -underline 0 \ 2238 -menu .tknmz.file.menu.selnmzidx -font $conf(WIDGETFONT) 2239 MakeNamazuIndexLuncher 2240 .tknmz.file.menu add separator 2241 .tknmz.file.menu add command -label {Quit} -underline 0 \ 2242 -font $conf(WIDGETFONT) -command {Quit} 2243 2244 menubutton .tknmz.edit -text {Edit} -menu .tknmz.edit.menu -underline 0 \ 2245 -font $conf(WIDGETFONT) 2246 menu .tknmz.edit.menu -tearoff no 2247 .tknmz.edit.menu add command -label {Editable} -underline 0 \ 2248 -font $conf(WIDGETFONT) -command {$log config -state normal -relief sunken } 2249 .tknmz.edit.menu add command -label {Copy} -underline 0 \ 2250 -font $conf(WIDGETFONT) -command {CopyString} 2251 .tknmz.edit.menu add command -label {Cut} -underline 1 \ 2252 -font $conf(WIDGETFONT) -command {CutString} 2253 .tknmz.edit.menu add command -label {Paste} -underline 0 \ 2254 -font $conf(WIDGETFONT) -command {PasteString {}} 2255 .tknmz.edit.menu add separator 2256 .tknmz.edit.menu add command -label {Find} -underline 0 \ 2257 -font $conf(WIDGETFONT) -command {FindWord} 2258 .tknmz.edit.menu add separator 2259 .tknmz.edit.menu add command -label {Set authorization} -underline 4 \ 2260 -font $conf(WIDGETFONT) -command {SetAuthorization} 2261 .tknmz.edit.menu add separator 2262 .tknmz.edit.menu add command -label {Display configuration} -underline 0 \ 2263 -font $conf(WIDGETFONT) -command {DisplayConfiguration} 2264 .tknmz.edit.menu add command -label {Load tknamazurc} -underline 0 \ 2265 -font $conf(WIDGETFONT) -command {LoadTknmzrc} 2266# .tknmz.edit.menu add command -label {Option} -underline 0 \ 2267# -font $conf(WIDGETFONT) -command {SetResources} 2268 2269 menubutton .tknmz.go -text {Go} -menu .tknmz.go.menu -underline 0 \ 2270 -font $conf(WIDGETFONT) 2271 menu .tknmz.go.menu -tearoff no 2272 .tknmz.go.menu add command -label {To Top} -underline 3 \ 2273 -font $conf(WIDGETFONT) -command {$log see 1.0} 2274 .tknmz.go.menu add command -label {To Bottom} -underline 3 \ 2275 -font $conf(WIDGETFONT) -command {$log see end} 2276 .tknmz.go.menu add separator 2277 .tknmz.go.menu add cascade -label {Bookmark} -underline 4 \ 2278 -menu .tknmz.go.menu.selbookmark -font $conf(WIDGETFONT) 2279 MakeBookMarkLuncher 2280# .tknmz.go.menu add separator 2281# .tknmz.go.menu add cascade -label {History} -underline 1 \ 2282# -font $conf(WIDGETFONT) -command {} 2283 2284 menubutton .tknmz.mknmz -text {Mknmz} -menu .tknmz.mknmz.menu -underline 0 \ 2285 -font $conf(WIDGETFONT) 2286 menu .tknmz.mknmz.menu -tearoff no 2287 .tknmz.mknmz.menu add command -label {Execute mknmz} -underline 0 \ 2288 -font $conf(WIDGETFONT) -command {MknmzHelper} 2289 2290# menubutton .tknmz.utilities -text {Utilities} -menu .tknmz.utilities.menu -underline 1 \ 2291# -font $conf(WIDGETFONT) 2292# menu .tknmz.utilities.menu -tearoff no 2293# .tknmz.utilities.menu add command -label {Execute clnmz} -underline 8 \ 2294# -font $conf(WIDGETFONT) -command {ClnmzHelper} 2295# .tknmz.utilities.menu add command -label {Execute gcnmz} -underline 8 \ 2296# -font $conf(WIDGETFONT) -command {GcnmzHelper} 2297# .tknmz.utilities.menu add command -label {Execute mailutime} -underline 8 \ 2298# -font $conf(WIDGETFONT) -command {MailutimeHelper} 2299# .tknmz.utilities.menu add command -label {Execute rvnmz} -underline 8 \ 2300# -font $conf(WIDGETFONT) -command {RvnmzHelper} 2301# .tknmz.utilities.menu add command -label {Execute vfnmz} -underline 8 \ 2302# -font $conf(WIDGETFONT) -command {VfnmzHelper} 2303# .tknmz.utilities.menu add command -label {Execute wdnmz} -underline 8 \ 2304# -font $conf(WIDGETFONT) -command {WdnmzHelper} 2305 2306 pack .tknmz.file .tknmz.edit .tknmz.go .tknmz.mknmz \ 2307 -side left -in .tknmz.menubar 2308 2309 menubutton .tknmz.help -text {Help} -menu .tknmz.help.menu -underline 0 \ 2310 -font $conf(WIDGETFONT) 2311 menu .tknmz.help.menu -tearoff no 2312 .tknmz.help.menu add command -label {Help} -underline 0 \ 2313 -font $conf(WIDGETFONT) -command {HelpView} 2314 .tknmz.help.menu add command -label {Version} -underline 0 \ 2315 -font $conf(WIDGETFONT) -command {AboutTknamazu} 2316 2317 pack .tknmz.help -side right -in .tknmz.menubar 2318 2319frame .tknmz.input 2320pack .tknmz.input -side top -fill x 2321 label .tknmz.input.l -text {Keyword:} -padx 0 -font $conf(WIDGETFONT) -underline 0 2322 entry .tknmz.keyword -width 20 -relief sunken -font $conf(WIDGETFONT) -textvariable inside(keyword) 2323 2324 pack .tknmz.input.l -side left 2325 pack .tknmz.keyword -side left -fill x -expand true -in .tknmz.input 2326 2327 set but [button .tknmz.input.search -text {Search} -font $conf(WIDGETFONT) \ 2328 -underline 0 -command {Exec $inside(keyword)}] 2329 button .tknmz.input.quit -text {Quit} -font $conf(WIDGETFONT) \ 2330 -underline 0 -command {Quit} 2331 2332 pack .tknmz.input.quit .tknmz.input.search -side right 2333 2334frame .tknmz.optionbar 2335pack .tknmz.optionbar -side top -fill x 2336 2337 image create photo tknmzicon -file "$conf(tknmzhome)/tknamazu_icon.ppm" 2338 button .tknmz.optionbar.icon -image tknmzicon -command {AboutTknamazu} 2339 2340 pack .tknmz.optionbar.icon -side right 2341 2342frame .tknmz.optionbar.options 2343pack .tknmz.optionbar.options -side top -fill x 2344 2345 pack .tknmz.optionbar.options -side left 2346 2347frame .tknmz.optionbar.options.opt1 2348pack .tknmz.optionbar.options.opt1 -side top -fill x 2349 label .tknmz.optionbar.options.opt1.displaylabel -text {DisplayCount:} \ 2350 -font $conf(WIDGETFONT) -underline 7 2351 tk_optionMenu .tknmz.optionbar.options.opt1.display opt(n) 9 10 20 30 50 100 ALL 2352 .tknmz.optionbar.options.opt1.display configure -width 3 2353 2354 pack .tknmz.optionbar.options.opt1.displaylabel .tknmz.optionbar.options.opt1.display \ 2355 -side left -fill x 2356 2357 label .tknmz.optionbar.options.opt1.summarylabel -text {Summary:} \ 2358 -font $conf(WIDGETFONT) -underline 1 2359 tk_optionMenu .tknmz.optionbar.options.opt1.summary opt(s) ON OFF 2360 .tknmz.optionbar.options.opt1.summary configure -width 3 2361 2362 pack .tknmz.optionbar.options.opt1.summarylabel .tknmz.optionbar.options.opt1.summary \ 2363 -side left -fill x 2364 2365 label .tknmz.optionbar.options.opt1.sortlabel -text {Sort:} -font $conf(WIDGETFONT) -underline 1 2366 tk_optionMenu .tknmz.optionbar.options.opt1.sort opt(l) score \ 2367 late early subject:ascending subject:descending from:ascending from:descending \ 2368 size:ascending size:descending uri:ascending uri:descending 2369 .tknmz.optionbar.options.opt1.sort configure -width 7 2370 2371 pack .tknmz.optionbar.options.opt1.sortlabel .tknmz.optionbar.options.opt1.sort \ 2372 -side left -fill x 2373 2374frame .tknmz.optionbar.options.opt2 2375pack .tknmz.optionbar.options.opt2 -side bottom -fill x 2376# button .tknmz.optionbar.options.opt2.backward -text {<} -font $conf(WIDGETFONT) -command {BackHistory} 2377 2378# button .tknmz.optionbar.options.opt2.forward -text {>} -font $conf(WIDGETFONT) -command {ForwardHistory} 2379 2380# pack .tknmz.optionbar.options.opt2.backward .tknmz.optionbar.options.opt2.forward -side left -fill x 2381 2382 label .tknmz.optionbar.options.opt2.smartbrowselabel -text {SmartBrowse:} \ 2383 -font $conf(WIDGETFONT) -underline 1 2384 tk_optionMenu .tknmz.optionbar.options.opt2.smartbrowse conf(SMARTBROWSE) 0 1 2 2385 2386 pack .tknmz.optionbar.options.opt2.smartbrowselabel .tknmz.optionbar.options.opt2.smartbrowse \ 2387 -side left -fill x 2388 2389 label .tknmz.optionbar.options.opt2.headerwarplabel -text {HeaderWipe:} \ 2390 -font $conf(WIDGETFONT) -underline 6 2391 tk_optionMenu .tknmz.optionbar.options.opt2.headerwarp conf(HEADERWIPE) ON OFF 2392 .tknmz.optionbar.options.opt2.headerwarp configure -width 3 2393 2394 pack .tknmz.optionbar.options.opt2.headerwarplabel .tknmz.optionbar.options.opt2.headerwarp \ 2395 -side left -fill x 2396 2397 label .tknmz.optionbar.options.opt2.siteselectorlabel -text {Site:} \ 2398 -font $conf(WIDGETFONT) -underline 1 2399 MakeNamazuSiteSelector 2400 2401 pack .tknmz.optionbar.options.opt2.siteselectorlabel .tknmz.optionbar.options.opt2.siteselector \ 2402 -side left -fill x 2403 2404frame .tknmz.result 2405pack .tknmz.result -side top -fill both -expand true 2406 set log [text .tknmz.result.log -width $conf(WIDTH) -height $conf(HEIGHT) \ 2407 -borderwidth 1 -relief raised -setgrid true -font $conf(TEXTFONT) \ 2408 -state disabled -yscrollcommand {.tknmz.result.scroll set}] 2409 scrollbar .tknmz.result.scroll -command {.tknmz.result.log yview} 2410 2411 pack .tknmz.result.scroll -side right -fill y 2412 pack .tknmz.result.log -side left -fill both -expand true 2413} 2414 2415proc MainKeyBind {} { 2416 global conf inside 2417 2418 bind .tknmz <Control-f> {FindWord} 2419 bind .tknmz <Control-q> {destroy .tknmz ; exit} 2420 bind .tknmz <Alt-k> {focus .tknmz.keyword ; break} 2421 bind .tknmz <Alt-s> {focus .tknmz.input.search ; break} 2422 bind .tknmz <Alt-b> {focus .tknmz.input.search ; break} 2423 bind .tknmz <Alt-q> {focus .tknmz.input.quit ; break} 2424 bind .tknmz <Alt-c> {focus .tknmz.optionbar.options.opt1.display ; break} 2425 bind .tknmz <Alt-u> {focus .tknmz.optionbar.options.opt1.summary ; break} 2426 bind .tknmz <Alt-o> {focus .tknmz.optionbar.options.opt1.sort ; break} 2427 bind .tknmz <Alt-m> {focus .tknmz.optionbar.options.opt2.smartbrowse ; break} 2428 bind .tknmz <Alt-w> {focus .tknmz.optionbar.options.opt2.headerwarp ; break} 2429 bind .tknmz <Alt-i> {focus .tknmz.optionbar.options.opt2.siteselector ; break} 2430 bind .tknmz <Control-u> {PopupMenu %X %Y} 2431 bind .tknmz <Control-n> {.tknmz.result.log yview scroll 1 unit} 2432 bind .tknmz <Control-p> {.tknmz.result.log yview scroll -1 unit} 2433 bind .tknmz <Control-v> {.tknmz.result.log yview scroll 1 page} 2434 bind .tknmz <Control-z> {.tknmz.result.log yview scroll -1 page} 2435 2436 if {$conf(kanjimode) && [regexp -nocase {unix} $conf(platform)] \ 2437 && ($conf(tkversion) < 8.1)} { 2438 bind Entry <Control-o> {kinput_start %W over} 2439 bind Entry <Shift-space> {kinput_start %W over} 2440 } 2441 2442 bind .tknmz.keyword <Return> {Exec $inside(keyword)} 2443 bind .tknmz.keyword <Button-3> {PopupMenu %X %Y} 2444 bind .tknmz.result.log <Button-1> {focus .tknmz.result.scroll} 2445 bind .tknmz.result.log <Button-2> {Kick {} %X %Y} 2446 bind .tknmz.result.log <Button-3> {PopupMenu %X %Y} 2447 bind .tknmz.result.log <Control-Button-3> {Kick {} %X %Y} 2448 bind .tknmz.result.log <Button-4> [list %W yview scroll -5 units] 2449 bind .tknmz.result.log <Button-5> [list %W yview scroll 5 units] 2450 bind .tknmz.result.log <Shift-Button-4> [list %W yview scroll -1 units] 2451 bind .tknmz.result.log <Shift-Button-5> [list %W yview scroll 1 units] 2452 bind .tknmz.result.log <Control-Button-4> [list %W yview scroll -1 pages] 2453 bind .tknmz.result.log <Control-Button-5> [list %W yview scroll 1 pages] 2454 bind .tknmz.result.scroll <Button-1> {focus .tknmz.result.scroll} 2455 bind .tknmz.result.scroll <space> {.tknmz.result.log yview scroll 1 page} 2456 bind .tknmz.result.scroll <BackSpace> {.tknmz.result.log yview scroll -1 page} 2457 bind .tknmz.result.scroll <Return> {.tknmz.result.log yview scroll 1 unit} 2458 bind .tknmz.result.scroll <Key-0> {Exec $inside(keyword)} 2459} 2460 2461################ main routine and .tknmz widget 2462SetDefaultResources 2463LoadResources 2464Initialization 2465 2466MainWidget 2467MainKeyBind 2468SetColor {.tknmz} 2469 2470if {$argc > 0} { 2471 Browse [lindex $argv 0] 2472} else { 2473 HelpView 2474} 2475 2476catch {selection clear} 2477focus .tknmz.keyword 2478 2479if {$tk_version < 4.0} { 2480 puts \ 2481"Warning: the script are based on Tk 8.1a2. You have 2482Tk $tk_version, so script may not work. 2483 2484Please see <URL:http://www.scriptics.com/> 2485" 2486} 2487