#! @WISH@ # -*- Tcl -*- # Copyright (C) 1997, 98, 99, 2000 Motoyuki Kasahara # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # to avoid execute myself if {"@WISH@" == ""} { exit } # This line makes the next one a comment in Tcl \ exec @WISH@ "$0" ${1+"$@"} # 2003 Masaki Shinomiya (supporting Tcl/Tk8.1 and higher) # detect Tcl8.0.x_jp # Does it support kanji commnads? set tcl_jp [expr ![catch {kanji code ""}]] global tcl_jp # kinput for Tcl/Tk8.3 catch {tk useinputmethods 1} # # If the system is UNIX, set internal kanji code to EUC. # Otherwise set it to SJIS. # if {$tcl_jp} { if {$tcl_platform(platform) == "unix"} { kanji internalCode EUC } else { kanji internalCode SJIS } } # # Include sources. # source "@pkgdatadir@/message.tcl" source "@pkgdatadir@/finder.tcl" source "@pkgdatadir@/ndtp.tcl" source "@pkgdatadir@/setup.tcl" # # Load messages file. # message_load_file "@pkgdatadir@" ###################################################################### ## BookView ###################################################################### # History table. set history_book(-1) {} set history_position(-1) {} set history_fraction(-1) {} set history_cursor(-1) {} # History size. set history_size 16 set history_current -1 set history_top -1 set history_bottom -1 # Setup Filename. if {$tcl_platform(platform) == "unix"} { set system_setup_file "@sysconfdir@/bookview.conf" set user_setup_file "$env(HOME)/.bookview" } else { set system_setup_file "@pkgdatadir@/setup" set user_setup_file "@pkgdatadir@/setup" } # Server list and the maximum number of servers. set server_names {localhost} set server_ports {ndtp} set server_options {} set server_starts {nodict} set server_demand_loads {} set server_book_groups {} set max_servers 3 # Whether connect to server1 at start of BookView. set start_server1 0 # Word input by an user. set input_word {} # Current index of the hit entries. set current_hit_index "" # Selections of radio and check buttons. set server_radiobutton {} set method_radiobutton "exactword" set book_radiobutton "nodict" set go_radiobutton {} set bitmap_checkbutton 1 # Widget focused in previous. set saved_focus "." # Window configurations. set toolbar_checkbutton 1 set hits_height 4 set text_spacing 0 # Method titles. set method_titles(exactword) [_ "Exact-Word Search"] set method_titles(word) [_ "Word Search"] set method_titles(endword) [_ "End-Word Search"] set method_titles(keyword) [_ "Keyword Search"] # Bitmap size. set bitmap_size 16 # # Startup # proc startup {} { global argc global argv global argv0 global server_names global server_ports global start_server1 global server_radiobutton global method_radiobutton # # Set default fonts. # set font "" set kanjifont "" set deffont [option get . tkDefaultFont *] if {$deffont != ""} { set c "" catch {set c [font conf $deffont -compound]} if {$c == ""} { option add *font $deffont } set font [lindex $c 0] set kanjifont [lindex $c 1] } # # Parse command line options. # set iconic 0 set title "" for {set i 0} {$i < $argc} {incr i} { set argi [lindex $argv $i] switch -regexp -- $argi { {^-(bg|background)$} { incr i if {$argc <= $i} { puts stderr [format \ [_ "%s: option \`%s\' requires an argument"] \ $argv0 $argi] } option add "*background" [lindex $argv $i] option add "*hilightColor" [lindex $argv $i] } {^-(fg|foreground)$} { incr i if {$argc <= $i} { puts stderr [format \ [_ "%s: option \`%s\' requires an argument"] \ $argv0 $argi] } set fg [lindex $argv $i] option add "*foreground" [lindex $argv $i] } {^-(fn|font)$} { incr i if {$argc <= $i} { puts stderr [format \ [_ "%s: option \`%s\' requires an argument"] \ $argv0 $argi] } set font [lindex $argv $i] if {$kanjifont == ""} { set kanjifont "Mincho" } } {^-(fk|kanjifont)$} { incr i if {$argc <= $i} { puts stderr [format \ [_ "%s: option \`%s\' requires an argument"] \ $argv0 $argi] } set kanjifont [lindex $argv $i] if {$font == ""} { set font "Helvetica-12" } } {^-iconic$} { set iconic 1 } {^-title$} { incr i if {$argc <= $i} { puts stderr ["%s: option \`%s\' requires an argument" \ $argv0 $argi] } set title [lindex $argv $i] } {^-version$} { puts stderr "BookView version @VERSION@" puts stderr "Copyright (c) 1997, 98, 99, 2000, 02 Motoyuki Kasahara\n" exit } {^-} { puts stderr [format [_ "Unknown option \`%s\'"] $argi] exit 1 } default { break } } } if {$i < $argc} { puts stderr [_ "Too many arguments"] exit 1 } # # Set fonts. # if {$font != "" && $kanjifont != ""} { catch {font delete default} catch {font create default -compound "$font $kanjifont"} option add "*font" default } # # Make a main window. # make_main_window if {$title != ""} { wm title . $title } if {$iconic} { wm iconify . } wm iconname . [wm title .] # # Load a setup file. If failed, pop the Setup window up. # if {![setup_load_file]} { setup } set_server_menu select_method $method_radiobutton if {$start_server1 == 1} { select_server 1 } reconfigure_main_window } # # Make a main window. # proc make_main_window {} { global history_size global history_book global history_current global input_word global method_radiobutton global book_radiobutton global bitmap_checkbutton global toolbar_checkbutton global hits_height global text_spacing global method_titles # # Toplevel # set script { if {[.book.menubutton.menu entrycget 0 -label] != ""} { .book.menubutton.menu post [winfo rootx .book.menubutton] \ [expr [winfo rooty .book.menubutton] \ + [winfo height .book.menubutton]] set saved_focus [focus] focus .book.menubutton.menu grab .book.menubutton.menu update .book.menubutton.menu activate 0 } } bind . $script bind . $script bind . quit bind . quit bind . quit set script { .method.menubutton.menu post [winfo rootx .method.menubutton] \ [expr [winfo rooty .method.menubutton] \ + [winfo height .method.menubutton]] set saved_focus [focus] focus .method.menubutton.menu grab .method.menubutton.menu update .method.menubutton.menu activate 0 } bind . $script bind . $script bind . finder_make_window bind . finder_make_window set script { if {[.toolbar.back cget -state] != "disabled"} { go_history [expr ($history_current - 1) %% $history_size] } } bind . $script bind . $script bind . $script bind . $script set script { if {[.toolbar.next cget -state] != "disabled"} { go_history [expr ($history_current + 1) %% $history_size] } } bind . $script bind . $script bind . $script bind . $script set script { if {[.bottombar.backward cget -state] != "disabled"} { put_new_text $history_book($history_current) "backward" } } bind . $script bind . $script set script { if {[.bottombar.forward cget -state] != "disabled"} { put_new_text $history_book($history_current) "forward" } } bind . $script bind . $script set script { if {[.word.toolbar.query cget -state] != "disabled"} { focus .word.entry } } bind . $script bind . $script set script { if {[.word.toolbar.query cget -state] != "disabled"} { query_selection } } bind . $script bind . $script # # Menu bar # frame .menubar \ -relief raised \ -borderwidth 2 pack .menubar -side top -fill x menubutton .menubar.file \ -text [_ "File"] \ -menu .menubar.file.menu \ -underline [__ 0 "-underline .menubar.file.menu"] pack .menubar.file -side left menubutton .menubar.view \ -text [_ "View"] \ -menu .menubar.view.menu \ -underline [__ 0 "-underline .menubar.view.menu"] pack .menubar.view -side left menubutton .menubar.server \ -text [_ "Server"] \ -menu .menubar.server.menu \ -underline [__ 0 "-underline .menubar.server.menu"] pack .menubar.server -side left menubutton .menubar.go \ -text [_ "Go"] \ -menu .menubar.go.menu \ -underline [__ 0 "-underline .menubar.go.menu"] pack .menubar.go -side left # # Menu `File' # menu .menubar.file.menu \ -tearoff 0 .menubar.file.menu add command \ -label [_ "Setup..."] \ -command setup \ -underline [__ 0 "-underline .menubar.file.menu.setup"] .menubar.file.menu add separator .menubar.file.menu add command \ -label [_ "Quit"] \ -command quit \ -underline [__ 0 "-underline .menubar.file.menu.quit"] \ -accelerator "Alt+Q" # # Menu `View' # menu .menubar.view.menu -tearoff 0 .menubar.view.menu add command \ -label [_ "Book List"] \ -state disabled \ -command {put_new_text nodict "booklist"} \ -underline [__ 5 "-underline .menubar.view.menu.book_list"] .menubar.view.menu add command \ -label [_ "Menu"] -state disabled \ -command {put_new_text $book_radiobutton "menu"} \ -underline [__ 0 "-underline .menubar.view.menu.menu"] .menubar.view.menu add command \ -label [_ "Copyright"] \ -state disabled \ -command {put_new_text $book_radiobutton "copyright"} \ -underline [__ 0 "-underline .menubar.view.menu.copyright"] .menubar.view.menu add command -label [_ "Query Selection"] \ -state disabled \ -command query_selection \ -accelerator "Alt+Return" .menubar.view.menu add separator .menubar.view.menu add command \ -label [_ "Find in Text..."] \ -underline [__ 0 "-underline .menubar.view.menu.find_in_text"] \ -accelerator "Alt+/" \ -command finder_make_window .menubar.view.menu add separator .menubar.view.menu add checkbutton \ -label [_ "Display Toolbar"] \ -command {reconfigure_main_window} \ -underline [__ 8 "-underline .menubar.view.menu.display_toolbar"] \ -variable toolbar_checkbutton .menubar.view.menu add checkbutton \ -label [_ "Display Bitmaps"] \ -underline [__ 8 "-underline .menubar.view.menu.display_bitmaps"] \ -variable bitmap_checkbutton \ -onvalue 1 \ -offvalue 0 \ -command {if {0 <= $history_current} {go_history $history_current}} .menubar.view.menu add cascade \ -label [_ "Text Spacing"] \ -underline [__ 5 "-underline .menubar.view.menu.text_spacing"] \ -menu .menubar.view.menu.spacing # # Cascade menu for `View -> Text Spacing'. # set script { .text.text configure \ -spacing1 $text_spacing \ -spacing2 $text_spacing } menu .menubar.view.menu.spacing \ -tearoff 0 .menubar.view.menu.spacing add radiobutton \ -label [_ "0 pixel"] \ -value 0 \ -variable text_spacing \ -underline [__ 0 "-underline .menubar.view.menu.spacing.0"] \ -command $script .menubar.view.menu.spacing add radiobutton \ -label [_ "2 pixels"] \ -value 2 \ -variable text_spacing \ -underline [__ 0 "-underline .menubar.view.menu.spacing.2"] \ -command $script .menubar.view.menu.spacing add radiobutton \ -label [_ "4 pixels"] \ -value 4 \ -variable text_spacing \ -underline [__ 0 "-underline .menubar.view.menu.spacing.4"] \ -command $script .menubar.view.menu.spacing add radiobutton \ -label [_ "6 pixels"] \ -value 6 \ -variable text_spacing \ -underline [__ 0 "-underline .menubar.view.menu.spacing.6"] \ -command $script .menubar.view.menu.spacing add radiobutton \ -label [_ "8 pixels"] \ -value 8 \ -variable text_spacing \ -underline [__ 0 "-underline .menubar.view.menu.spacing.8"] \ -command $script # # Menu `Server' # menu .menubar.server.menu \ -tearoff 0 .menubar.server.menu add command \ -label [_ "(not selected)"] \ -command setup .menubar.server.menu add separator # # Menu `Go' # menu .menubar.go.menu \ -tearoff 0 .menubar.go.menu add command \ -label [_ "Previous history"] \ -state disabled \ -underline [__ 0 "-underline .menubar.go.menu.previous"] \ -accelerator "Alt+P" \ -command {go_history [expr ($history_current - 1) % $history_size]} .menubar.go.menu add command \ -label [_ "Next history"] \ -state disabled \ -underline [__ 0 "-underline .menubar.go.menu.next"] \ -accelerator "Alt+N" \ -command {go_history [expr ($history_current + 1) % $history_size]} .menubar.go.menu add separator .menubar.go.menu add command \ -label [_ "Backward paragraph"] \ -state disabled \ -underline [__ 0 "-underline .menubar.go.menu.backward"] \ -accelerator "Alt+k" \ -command {put_new_text $history_book($history_current) "backward"} .menubar.go.menu add command \ -label [_ "Forward paragraph"] \ -state disabled \ -underline [__ 0 "-underline .menubar.go.menu.forward"] \ -accelerator "Alt+j" \ -command {put_new_text $history_book($history_current) "forward"} .menubar.go.menu add separator # # Create Images. # image create photo bitmap_prev -file "@pkgdatadir@/prev.gif" image create photo bitmap_next -file "@pkgdatadir@/next.gif" image create photo bitmap_find -file "@pkgdatadir@/find.gif" image create photo bitmap_menu -file "@pkgdatadir@/menu.gif" image create photo bitmap_copyright -file "@pkgdatadir@/copyright.gif" image create bitmap bitmap_arrow -file "@pkgdatadir@/arrow.xbm" image create bitmap bitmap_space -file "@pkgdatadir@/space.xbm" image create bitmap bitmap_forward -file "@pkgdatadir@/forward.xbm" image create bitmap bitmap_backward -file "@pkgdatadir@/backward.xbm" # # Toolbar. # frame .toolbar pack .toolbar -side top -anchor w -pady 2 -fill x button .toolbar.back \ -image bitmap_prev \ -relief raised \ -borderwidth 2 \ -state disabled \ -takefocus 0 \ -command {go_history [expr ($history_current - 1) % $history_size]} pack .toolbar.back -side left button .toolbar.next \ -image bitmap_next \ -relief raised \ -borderwidth 2 \ -state disabled \ -takefocus 0 \ -command {go_history [expr ($history_current + 1) % $history_size]} pack .toolbar.next -side left button .toolbar.menu \ -image bitmap_menu \ -relief raised \ -borderwidth 2 \ -state disabled \ -takefocus 0 \ -command {put_new_text $book_radiobutton "menu"} pack .toolbar.menu -side left button .toolbar.copyright \ -image bitmap_copyright \ -relief raised \ -borderwidth 2 \ -state disabled \ -takefocus 0 \ -command {put_new_text $book_radiobutton "copyright"} pack .toolbar.copyright -side left button .toolbar.find \ -image bitmap_find \ -relief raised \ -borderwidth 2 \ -state normal \ -takefocus 0 \ -command finder_make_window pack .toolbar.find -side left # # Book title # frame .book \ -relief flat pack .book -side top -fill x label .book.label \ -text [_ "Book: "] \ -relief flat \ -underline [__ 0 "-underline .book.label"] pack .book.label -side left menubutton .book.menubutton \ -text [ndtp_title 0] \ -relief raised \ -borderwidth 2 -menu .book.menubutton.menu \ -width 45 pack .book.menubutton -side left -pady 2 -expand 1 -anchor w menu .book.menubutton.menu \ -tearoff 0 bind .book.menubutton.menu { .book.menubutton.menu unpost focus $saved_focus } # # Method list menu button. # frame .method \ -relief flat pack .method -side top -fill x label .method.label \ -text [_ "Method:"] \ -relief flat \ -underline [__ 0 "-underline .method.label"] pack .method.label \ -side left menubutton .method.menubutton \ -relief raised \ -state disabled \ -text $method_titles($method_radiobutton) \ -borderwidth 2 \ -menu .method.menubutton.menu \ -width 25 pack .method.menubutton \ -side left \ -pady 2 \ -expand 1 \ -anchor w menu .method.menubutton.menu \ -tearoff 0 bind .method.menubutton.menu { .method.menubutton.menu unpost focus $saved_focus } # # Method list. # .method.menubutton.menu add radiobutton -state disabled \ -command "select_method exactword" \ -label [format "%-25s" [_ $method_titles(exactword)]] \ -variable method_radiobutton -value "exactword" .method.menubutton.menu add radiobutton -state disabled \ -command "select_method word" \ -label [format "%-25s" [_ $method_titles(word)]] \ -variable method_radiobutton -value "word" .method.menubutton.menu add radiobutton -state disabled \ -command "select_method endword" \ -label [format "%-25s" [_ $method_titles(endword)]] \ -variable method_radiobutton -value "endword" .method.menubutton.menu add radiobutton -state disabled \ -command "select_method keyword" \ -label [format "%-25s" [_ $method_titles(keyword)]] \ -variable method_radiobutton -value "keyword" # # Word # frame .word -relief flat pack .word -side top -fill x label .word.label \ -text [_ "Word: "] \ -relief flat \ -underline [__ 0 "-underline .word.label"] pack .word.label \ -side left frame .word.toolbar \ -relief flat pack .word.toolbar -side right -expand 1 -fill x -padx 4 -pady 2 button .word.toolbar.query -text [_ "Query"] -relief raised \ -borderwidth 2 -state disabled -takefocus 0 \ -command query_word pack .word.toolbar.query -side left -anchor w button .word.toolbar.qsel \ -text [_ "Q Sel"] \ -relief raised \ -borderwidth 2 \ -state disabled \ -takefocus 0 \ -command query_selection pack .word.toolbar.qsel \ -side left \ -anchor w button .word.toolbar.clear \ -text [_ "Clear"] \ -relief raised \ -borderwidth 2 \ -state disabled \ -takefocus 0 \ -command clear_word pack .word.toolbar.clear \ -side left \ -anchor w entry .word.entry \ -width 36 \ -relief sunken \ -borderwidth 2 \ -textvariable input_word \ -takefocus 0 pack .word.entry -side left -pady 2 bind .word.entry query_word bind .word.entry query_word # # Information # frame .bottombar \ -relief flat pack .bottombar \ -side bottom \ -anchor w \ -fill x label .bottombar.information pack .bottombar.information -side left -fill x -anchor w button .bottombar.forward \ -image bitmap_forward \ -state disabled \ -command {put_new_text $history_book($history_current) "forward"} pack .bottombar.forward -side right button .bottombar.backward \ -image bitmap_backward \ -state disabled \ -command {put_new_text $history_book($history_current) "backward"} pack .bottombar.backward -side right # # Hits # frame .hits \ -relief flat pack .hits -side top -fill both scrollbar .hits.scroll \ -command ".hits.text yview" \ -takefocus 0 pack .hits.scroll -side right -fill y text .hits.text \ -relief sunken \ -borderwidth 2 \ -height $hits_height \ -yscrollcommand ".hits.scroll set" pack .hits.text -side left -fill both -expand 1 .hits.text tag configure anchor \ -foreground blue \ -underline 1 .hits.text tag bind anchor { .hits.text configure -cursor hand2} .hits.text tag bind anchor { .hits.text configure -cursor xterm} .hits.text tag bind anchor { get_entry_text "@%x,%y" } bind .hits.text { get_entry_text "insert lineend - 1 chars" } # # Text # frame .text \ -relief flat pack .text -side top -fill both -expand 1 scrollbar .text.scroll \ -command ".text.text yview" \ -takefocus 0 pack .text.scroll \ -side right \ -fill y text .text.text \ -relief sunken \ -borderwidth 2 \ -height 9 \ -yscrollcommand ".text.scroll set" pack .text.text -side left -fill both -expand 1 .text.text tag configure anchor \ -foreground blue \ -underline 1 .text.text tag bind anchor {.text.text configure -cursor hand2} .text.text tag bind anchor {.text.text configure -cursor xterm} .text.text tag bind anchor { put_new_text $history_book($history_current) \ [lindex [.text.text tag names "@%x,%y"] end] } bind .text.text { put_new_text $history_book($history_current) \ [lindex [.text.text tag names insert] end] } bind .text.text go_next_link_tag bind .text.text go_previous_link_tag # # For wheel mouse. # bind Text {%W yview scroll 5 units} bind Text {%W yview scroll -5 units} # # Prevent an user from editing Hits and Text. # bind Text {} bind Text {} bind Text {} bind Text {} bind Text {tkTextSetCursor %W [tkTextScrollPages %W 1]} bind Text {tkTextSetCursor %W [tkTextScrollPages %W -1]} bind Text {tkTextSetCursor %W [tkTextScrollPages %W -1]} # # Add some keybindngs to the Menu widget. # bind Menu

{tkMenuUpArrow %W} bind Menu {tkMenuUpArrow %W} bind Menu {tkMenuDownArrow %W} bind Menu {tkMenuDownArrow %W} # # Add some keybindngs to the Entry widget. # bind Entry {catch {%W insert insert [selection get]}} } # # Reconfigure the main window. # proc reconfigure_main_window {} { global toolbar_checkbutton global information_checkbutton global text_spacing pack forget .toolbar .hits .text .bottombar pack .menubar -side top -fill x if {$toolbar_checkbutton} { pack .toolbar -side top -anchor w -pady 2 -fill x -before .book } pack .book -side top -fill x pack .method -side top -fill x pack .word -side top -fill x pack .bottombar -side bottom -anchor w -fill x pack .hits -side top -fill both pack .text -side top -fill both -expand 1 .text.text configure -spacing1 $text_spacing -spacing2 $text_spacing } # # Output an information message at the bottom of the main window. # proc output_information {message} { .bottombar.information configure -text $message update } # # Quit. # proc quit {} { ndtp_close setup_save_file set widgets {.} for {set i 0} {$i < [llength $widgets]} {incr i} { foreach j [winfo children [lindex $widgets $i]] { bindtags $j dummy lappend widgets $j } } bindtags . dummy destroy . } # # Set `Server' menu. # proc set_server_menu {} { global server_names global server_ports global server_radiobutton # # Set a radio button in `Server' menu to `nodict'. # set server_radiobutton 0 # # Clear the widget. # .menubar.server.menu delete 0 end # # Set `Server' menu. # .menubar.server.menu add radiobutton -command {select_server 0} \ -label [_ "(not selected)"] -variable server_radiobutton -value 0 .menubar.server.menu add separator set length [llength $server_names] for {set i 1} {$i <= $length} {incr i} { set hostname [lindex $server_names [expr $i - 1]] set port [lindex $server_ports [expr $i - 1]] .menubar.server.menu add radiobutton -command "select_server $i" \ -label "$hostname:$port" -variable server_radiobutton \ -value $i } } # # Select a server. # proc select_server {server} { global server_names global server_ports global server_starts global server_book_groups global history_current global history_top global history_bottom global history_size global ndtp_error_message global server_radiobutton global book_radiobutton global go_radiobutton set server_radiobutton 0 set book_radiobutton 0 set go_radiobutton {} # # Close an old connection. # if {[ndtp_is_active]} { output_information [_ "Disconnected."] ndtp_close } # # Disable and clear widgets. # .book.menubutton.menu delete 0 end if {0 <= $history_current} { .menubar.go.menu delete 6 end } .word.entry configure -state normal .word.entry delete 0 end .word.entry configure -state disabled -takefocus 0 .hits.text delete 1.0 end .toolbar.back configure -state disabled .toolbar.next configure -state disabled .menubar.go.menu entryconfigure 0 -state disabled .menubar.go.menu entryconfigure 1 -state disabled .menubar.go.menu entryconfigure 3 -state disabled .menubar.go.menu entryconfigure 4 -state disabled .word.toolbar.query configure -state disabled .word.toolbar.qsel configure -state disabled .word.toolbar.clear configure -state disabled .toolbar.menu configure -state disabled .toolbar.copyright configure -state disabled .menubar.view.menu entryconfigure 0 -state disabled .menubar.view.menu entryconfigure 1 -state disabled .menubar.view.menu entryconfigure 2 -state disabled .menubar.view.menu entryconfigure 3 -state disabled .book.menubutton configure -text [ndtp_title 0] .method.menubutton configure -state disabled .method.menubutton.menu entryconfigure 0 -state disabled .method.menubutton.menu entryconfigure 1 -state disabled .method.menubutton.menu entryconfigure 2 -state disabled .method.menubutton.menu entryconfigure 3 -state disabled .bottombar.backward configure -state disabled .bottombar.forward configure -state disabled focus . # # Initialize history. # set history_current -1 set history_bottom -1 set history_top -1 # # Return if the server 0 is selected. # if {$server == 0} { return } # # Clear `Text:' area. # .text.text delete 1.0 end # # Connect to the server. # set hostname [lindex $server_names [expr $server - 1]] set port [lindex $server_ports [expr $server - 1]] set start [lindex $server_starts [expr $server - 1]] output_information [format [_ "Connect to %s..."] "$hostname:$port"] set books {} if {![ndtp_open $hostname $port books]} { output_information $ndtp_error_message set server_radiobutton 0 return } # # Update `Book' menu. # .book.menubutton.menu add radiobutton \ -command "select_book 0" \ -label [format "%-45s" [ndtp_title 0]] \ -variable book_radiobutton -value 0 .book.menubutton.menu add separator foreach i $books { .book.menubutton.menu add radiobutton \ -command "select_book $i" \ -label [format "%-45s" [ndtp_title $i]] \ -variable book_radiobutton -value $i } .book.menubutton.menu add separator foreach i [lindex $server_book_groups [expr $server - 1]] { set group_name [lindex $i 0] .book.menubutton.menu add radiobutton \ -command "select_book $group_name" \ -label [format "%-45s" [lindex $i 1]] \ -variable book_radiobutton -value $group_name } .book.menubutton.menu add radiobutton \ -command "select_book @all" \ -label [format "%-45s" "all"] \ -variable book_radiobutton -value @all # # Enable widgets. # .book.menubutton configure -state normal .menubar.view.menu entryconfigure 0 -state normal output_information [format [_ "Connect to %s...done."] "$hostname:$port"] set server_radiobutton $server if {$start != "" && $start != "nodict"} { select_book $start } else { put_new_text nodict booklist } } # # Select a book in `Book' menu. # proc select_book {book} { global ndtp_error_message global server_radiobutton global book_radiobutton global bitmap_checkbutton global bitmap_size global server_demand_loads global server_book_groups set book_is_group [string match {@*} $book] # # Get title of $book. # set book_title [get_book_title $book] # # Disable and clear widgets. # .hits.text delete 1.0 end .word.toolbar.query configure -state disabled .word.toolbar.qsel configure -state disabled .word.toolbar.clear configure -state disabled .toolbar.menu configure -state disabled .toolbar.copyright configure -state disabled .menubar.view.menu entryconfigure 1 -state disabled .menubar.view.menu entryconfigure 2 -state disabled .menubar.view.menu entryconfigure 3 -state disabled .menubar.go.menu entryconfigure 3 -state disabled .menubar.go.menu entryconfigure 4 -state disabled .word.entry configure -state disabled -takefocus 0 .book.menubutton configure -text [ndtp_title 0] .method.menubutton configure -state disabled .method.menubutton.menu entryconfigure 0 -state disabled .method.menubutton.menu entryconfigure 1 -state disabled .method.menubutton.menu entryconfigure 2 -state disabled .method.menubutton.menu entryconfigure 3 -state disabled .bottombar.backward configure -state disabled .bottombar.forward configure -state disabled focus . # # Select a book. # output_information [format [_ "Select %s..."] $book_title] if {!$book_is_group && ![ndtp_select_book $book]} { output_information $ndtp_error_message set book_radiobutton 0 .book.menubutton configure -text [ndtp_title 0] if {![ndtp_is_active]} { select_server 0 } return } .book.menubutton configure -text $book_title set book_radiobutton $book if {$book != 0 && !$book_is_group && $bitmap_checkbutton == 1} { # # Set bitmap size. # if {![ndtp_select_bitmap_size $bitmap_size [bitmap_mode $book]]} { output_information $ndtp_error_message if {![ndtp_is_active]} { select_server 0 return } } } # # Set book title on the menu-button. # .book.menubutton configure -text $book_title .method.menubutton configure -state normal # # Enable widgets. # if {!$book_is_group && [ndtp_have_menu $book]} { .toolbar.menu configure -state normal .menubar.view.menu entryconfigure 1 -state normal } if {!$book_is_group && [ndtp_have_copyright $book]} { .toolbar.copyright configure -state normal .menubar.view.menu entryconfigure 2 -state normal } if {$book_is_group || [ndtp_have_word_search $book]} { .word.entry configure -state normal -takefocus 1 .word.toolbar.query configure -state normal .word.toolbar.qsel configure -state normal .word.toolbar.clear configure -state normal .method.menubutton configure -state normal .method.menubutton.menu entryconfigure 0 -state normal .method.menubutton.menu entryconfigure 1 -state normal .menubar.view.menu entryconfigure 3 -state normal focus .word.entry } if {$book_is_group || [ndtp_have_endword_search $book]} { .word.entry configure -state normal -takefocus 1 .word.toolbar.query configure -state normal .word.toolbar.qsel configure -state normal .word.toolbar.clear configure -state normal .method.menubutton configure -state normal .method.menubutton.menu entryconfigure 2 -state normal .menubar.view.menu entryconfigure 3 -state normal focus .word.entry } if {$book_is_group || [ndtp_have_keyword_search $book]} { .word.entry configure -state normal -takefocus 1 .word.toolbar.query configure -state normal .word.toolbar.qsel configure -state normal .word.toolbar.clear configure -state normal .method.menubutton configure -state normal .method.menubutton.menu entryconfigure 3 -state normal .menubar.view.menu entryconfigure 3 -state normal focus .word.entry } output_information [format [_ "Select %s...done."] $book_title] } # # Select a method type in `Method' menu. # proc select_method {method} { global method_titles global method_radiobutton ndtp_set_default_method $method set method_radiobutton $method .method.menubutton configure -text $method_titles($method) } # # Query a word to a server. # proc query_word {} { global current_hit_index global input_word global ndtp_error_message global server_radiobutton global book_radiobutton global bitmap_checkbutton global bitmap_size global server_demand_loads set hit_positions {} set current_hit_index "" set hit_headings {} set books [expand_book_name $book_radiobutton] regsub -all "\n" $input_word "" input_word if {$input_word == ""} { output_information [_ "The word is empty."] return 0 } # # Disable and clear widgets. # .hits.text delete 1.0 end set total_length 0 foreach book $books { # # Select book. # if {![ndtp_select_book $book]} { output_information $ndtp_error_message if {![ndtp_is_active]} { select_server 0 } continue } # # Select bitmap size. # if {$bitmap_checkbutton == 1} { if {![ndtp_select_bitmap_size $bitmap_size [bitmap_mode $book]]} { output_information $ndtp_error_message if {![ndtp_is_active]} { select_server 0 return 0 } } } # # Query a word to a server. # output_information [format [_ "Query %s..."] $input_word] if {![ndtp_query_word $input_word hit_positions hit_headings]} { output_information $ndtp_error_message if {![ndtp_is_active]} { select_server 0 } continue } set length [llength $hit_positions] if {$length == 0} { continue } # # Output book title. # if {$length < 2} { .hits.text insert end [format [_ "%s (%d entry):\n"] \ [ndtp_title $book] $length] } else { .hits.text insert end [format [_ "%s (%d entries):\n"] \ [ndtp_title $book] $length] } # # Output hit entries received from a server. # for {set i 0} {$i < $length} {incr i} { .hits.text image create end -image bitmap_space set heading [lindex $hit_headings $i] set position [lindex $hit_positions $i] while {[regexp {([^<]*)<(.*)} $heading dummy head rest]} { if {[regexp {^gaiji:([0-9A-Za-z]+)>(.*)} $rest dummy imageid \ tail]} { .hits.text insert end $head if {[ndtp_get_bitmap $imageid]} { .hits.text image create end -image "$book/$imageid" } set heading $tail } else { .hits.text insert end "$head<" set heading $rest } } .hits.text insert end $heading .hits.text insert end [_ " (->text)\n"] \ [list {anchor} $book $position] } incr total_length $length } .hits.text mark set insert 1.0 # # Get text of the first entry in the listbox. # if {$total_length != 0} { set tag_range [.hits.text tag nextrange anchor 1.0] get_entry_text "[lindex $tag_range 0] + 1 chars" } if {$total_length < 2} { output_information [format [_ "Found %d entry."] $total_length] } else { output_information [format [_ "Found %d entries."] $total_length] } } # # Get text of an hit entry. # proc get_entry_text {index} { global current_hit_index if {$index == ""} { return } set index [.hits.text index $index] set tag [.hits.text tag names $index] set insert_index [.hits.text index insert] # # Replace an arrow at the current hit entry to a space. # if {$current_hit_index != ""} { .hits.text delete $current_hit_index .hits.text image create $current_hit_index -image bitmap_space } # # Replace a space at the new current hit entry with an arrow. # set current_hit_index [.hits.text index "$index linestart"] .hits.text delete $current_hit_index .hits.text image create $current_hit_index -image bitmap_arrow # # Put text. # put_new_text [lindex $tag 1] [lindex $tag 2] .hits.text mark set insert $insert_index } # # Query a word in X selection. # proc query_selection {} { global input_word if {[catch {set input_word [selection get]}]} { set input_word "" } query_word } # # Clear the word entry space. # proc clear_word {} { global input_word set input_word {} } # # Get new text. # proc put_new_text {book position} { global history_book global history_position global history_fraction global history_cursor global history_insertion global history_size global history_current global history_top global history_bottom global go_radiobutton global tcl_jp if {$book == "" || $position == ""} { return } # # Save the current fraction and cursor of the text widget. # if {0 <= $history_current} { set history_fraction($history_current) [lindex [.text.scroll get] 0] set history_cursor($history_current) [.text.text index insert] .toolbar.back configure -state normal .menubar.go.menu entryconfigure 0 -state normal } # # Put text. # if {![put_text $book $position]} { return } # # Update history. # The top three elements in .menubar.go.menu are `Back', `Next' and # a separator. We don't remove them. # if {0 <= $history_current} { while {$history_top != $history_current} { .menubar.go.menu delete 6 set history_top [expr ($history_top - 1) % $history_size] } set history_top [expr ($history_top + 1) % $history_size] if {$history_top == $history_bottom} { .menubar.go.menu delete [expr 6 + $history_size - 1] set history_bottom [expr ($history_bottom + 1) % $history_size] } } else { set history_top 0 set history_bottom 0 } set history_current $history_top # use kstring in case Tcl/Tk8.0jp if {$tcl_jp} { set headline [kstring range [.text.text get 1.0 1.end] 0 40] } else { set headline [string range [.text.text get 1.0 1.end] 0 40] } set history_book($history_current) $book set history_position($history_current) $position set history_fraction($history_current) 0.0 set history_cursor($history_current) 1.0 .menubar.go.menu insert 6 radiobutton -label $headline \ -command "go_history $history_current" \ -variable go_radiobutton -value $history_top set go_radiobutton $history_current # # Setup `next' and `back' buttons. # .toolbar.next configure -state disabled .menubar.go.menu entryconfigure 1 -state disabled if {$history_current == $history_bottom} { .toolbar.back configure -state disabled .menubar.go.menu entryconfigure 0 -state disabled } else { .toolbar.back configure -state normal .menubar.go.menu entryconfigure 0 -state normal } } # # Go to the specified entry in history. # proc go_history {history_id} { global history_book global history_position global history_fraction global history_cursor global history_current global history_top global history_bottom global go_radiobutton # # Update history. # set history_fraction($history_current) [lindex [.text.scroll get] 0] set history_cursor($history_current) [.text.text index insert] set history_current $history_id set go_radiobutton $history_current # # Put text. # if {![put_text $history_book($history_current) \ $history_position($history_current) \ $history_fraction($history_current) \ $history_cursor($history_current)]} { return } # # Setup `next' and `back' buttons. # if {$history_current == $history_top} { .toolbar.next configure -state disabled .menubar.go.menu entryconfigure 1 -state disabled } else { .toolbar.next configure -state normal .menubar.go.menu entryconfigure 1 -state normal } if {$history_current == $history_bottom} { .toolbar.back configure -state disabled .menubar.go.menu entryconfigure 0 -state disabled } else { .toolbar.back configure -state normal .menubar.go.menu entryconfigure 0 -state normal } } # # Get a text. # proc put_text {book position {fraction 0.0} {cursor 1.0}} { global ndtp_error_message global server_radiobutton global bitmap_checkbutton global bitmap_size global server_demand_loads .menubar.go.menu entryconfigure 3 -state disabled .menubar.go.menu entryconfigure 4 -state disabled .bottombar.backward configure -state disabled .bottombar.forward configure -state disabled if {$position == "booklist"} { return [put_book_list $fraction $cursor] } # # Disable and clear widget. # .text.text delete 1.0 end # # Select book. # if {![ndtp_select_book $book]} { output_information $ndtp_error_message if {![ndtp_is_active]} { select_server 0 } return 0 } # # Select bitmap size. # if {$bitmap_checkbutton == 1} { if {![ndtp_select_bitmap_size $bitmap_size [bitmap_mode $book]]} { output_information $ndtp_error_message if {![ndtp_is_active]} { select_server 0 return 0 } } } # # Send a request to the current server. # output_information [_ "Get text..."] if {![ndtp_get_text $position text]} { output_information $ndtp_error_message if {![ndtp_is_active]} { select_server 0 } return 0 } # # Collect link tags. # while {[regexp {([^<]*)<(.*)} $text dummy head rest]} { if {[regexp {^([0-9A-Fa-f]+:[0-9A-Fa-f]+)>(.*)} $rest dummy \ ref_position tail]} { .text.text insert end $head .text.text insert end [_ "(->link)"] [list {anchor} $ref_position] set text $tail } elseif {[regexp {^gaiji:([0-9A-Za-z]+)>(.*)} $rest dummy imageid \ tail]} { .text.text insert end $head if {[ndtp_get_bitmap $imageid]} { .text.text image create end -image "$book/$imageid" } set text $tail } else { .text.text insert end "$head<" set text $rest } } .text.text insert end "$text\n" .text.text yview moveto $fraction .text.text mark set insert $cursor if {[string match {*:*} $position] \ || $position == "forward" || $position == "backward"} { .menubar.go.menu entryconfigure 3 -state normal .menubar.go.menu entryconfigure 4 -state normal .bottombar.backward configure -state normal .bottombar.forward configure -state normal } output_information [_ "Get text...done."] return 1 } # # Put book list. # proc put_book_list {{fraction 0.0} {cursor 1.0}} { set length [.book.menubutton.menu index end] # # Disable and clear widget. # .text.text delete 1.0 end .text.text insert end [_ "Book list of this server\n"] set books [ndtp_books] foreach i $books { set title [ndtp_title $i] .text.text insert end [format [_ " book title = %s\n"] $title] .text.text insert end [format [_ " book ID = %s\n\n"] $i] } .text.text yview moveto $fraction .text.text mark set insert $cursor return 1 } # # Move insertion cursor on Text to the next link tag. # proc go_next_link_tag {} { set tag_range [.text.text tag nextrange anchor insert] if {$tag_range != ""} { .text.text mark set insert "[lindex $tag_range 0] + 1 chars" } .text.text see insert } # # Move the insertion cursor on Text to the previous link tag. # proc go_previous_link_tag {} { set tag_range [.text.text tag prevrange anchor "insert - 2 chars"] if {$tag_range != ""} { .text.text mark set insert "[lindex $tag_range 0] + 1 chars" } .text.text see insert } # # Get title of $book. $book may a book group. # proc get_book_title {book} { global server_radiobutton global server_book_groups if {$server_radiobutton == 0} { return "" } elseif {$book == "@all"} { return "all" } foreach i [lindex $server_book_groups [expr $server_radiobutton - 1]] { if {[lindex $i 0] == $book} { return [lindex $i 1] } } return [ndtp_title $book] } # # Expand $book to a list of real book names. # If $book is not a book group, it returns $book. # proc expand_book_name {book} { global server_radiobutton global server_book_groups if {$server_radiobutton == 0} { return {} } elseif {$book == "@all"} { return [ndtp_books] } foreach i [lindex $server_book_groups [expr $server_radiobutton - 1]] { if {[lindex $i 0] == $book} { return [lindex $i 2] } } return $book } # # Return mode of bitmap loading for $book ("pre-load" or "demand-load"). # proc bitmap_mode {book} { global server_radiobutton global server_demand_loads global server_book_groups if {$server_radiobutton == 0} { return "pre-load" } foreach demand_load \ [lindex $server_demand_loads [expr $server_radiobutton - 1]] { if {$demand_load == "@all"} { # # All books in the book group "@all" are specified as # "demand-load". # return "demand-load" } elseif {[string match {@*} $demand_load]} { # # All books in the book group $demand_load are specified as # "demand-load". # if {[lsearch [expand_book_name $demand_load] $book] != -1} { return "demand-load" } } elseif {$demand_load == $book} { # # The book $demand_load is specified as "demand-load". # return "demand-load" } } return "pre-load" } startup # Local Variables: # mode: tcl # End: