bookview 3.2.1-1 / usr / bin / bookview.tcl

#! /usr/bin/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 {"/usr/bin/wish" == ""} {
    exit
}
# This line makes the next one a comment in Tcl \
	exec /usr/bin/wish "$0" ${1+"$@"}

# 2003 Masaki Shinomiya <shino@pos.to> (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 "/usr/share/bookview/message.tcl"
source "/usr/share/bookview/finder.tcl"
source "/usr/share/bookview/ndtp.tcl"
source "/usr/share/bookview/setup.tcl"

#
# Load messages file.
#
message_load_file "/usr/share/bookview"

######################################################################
## 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 "/usr/etc/bookview.conf"
    set user_setup_file "$env(HOME)/.bookview"
} else {
    set system_setup_file "/usr/share/bookview/setup"
    set user_setup_file "/usr/share/bookview/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 3.2.1"
		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 . <Alt-b> $script
    bind . <M-b> $script

    bind . <Destroy> quit
    bind . <Alt-q> quit
    bind . <M-q> 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 . <Alt-m> $script
    bind . <M-m> $script

    bind . <Alt-slash> finder_make_window
    bind . <M-slash> finder_make_window

    set script {
	if {[.toolbar.back cget -state] != "disabled"} {
	    go_history [expr ($history_current - 1) %% $history_size]
	}
    }
    bind . <Alt-Left> $script
    bind . <M-Left> $script
    bind . <Alt-p> $script
    bind . <M-p> $script

    set script {
	if {[.toolbar.next cget -state] != "disabled"} {
	    go_history [expr ($history_current + 1) %% $history_size]
	}
    }
    bind . <Alt-Right> $script
    bind . <M-Right> $script
    bind . <Alt-n> $script
    bind . <M-n> $script

    set script {
	if {[.bottombar.backward cget -state] != "disabled"} {
	    put_new_text $history_book($history_current) "backward"
	}
    }
    bind . <Alt-k> $script
    bind . <M-k> $script

    set script {
	if {[.bottombar.forward cget -state] != "disabled"} {
	    put_new_text $history_book($history_current) "forward"
	}
    }
    bind . <Alt-j> $script
    bind . <M-j> $script

    set script {
	if {[.word.toolbar.query cget -state] != "disabled"} {
	    focus .word.entry
	}
    }
    bind . <Alt-w> $script
    bind . <M-w> $script

    set script {
	if {[.word.toolbar.query cget -state] != "disabled"} {
	    query_selection
	}
    }
    bind . <Alt-Return> $script
    bind . <M-Return> $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 "/usr/share/bookview/prev.gif"
    image create photo bitmap_next -file "/usr/share/bookview/next.gif"
    image create photo bitmap_find -file "/usr/share/bookview/find.gif"
    image create photo bitmap_menu -file "/usr/share/bookview/menu.gif"
    image create photo bitmap_copyright -file "/usr/share/bookview/copyright.gif"
    image create bitmap bitmap_arrow -file "/usr/share/bookview/arrow.xbm"
    image create bitmap bitmap_space -file "/usr/share/bookview/space.xbm"
    image create bitmap bitmap_forward -file "/usr/share/bookview/forward.xbm"
    image create bitmap bitmap_backward -file "/usr/share/bookview/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 <Escape> {
	.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 <Escape> {
	.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 <Return> query_word
    bind .word.entry <Control-m> 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 <Enter> {
	.hits.text configure -cursor hand2}
    .hits.text tag bind anchor <Leave> {
	.hits.text configure -cursor xterm}
    .hits.text tag bind anchor <Button-1> {
	get_entry_text "@%x,%y"
    }
    bind .hits.text <Return> {
	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 <Enter> {.text.text configure -cursor hand2}
    .text.text tag bind anchor <Leave> {.text.text configure -cursor xterm}
    .text.text tag bind anchor <Button-1> {
	put_new_text $history_book($history_current) \
		[lindex [.text.text tag names "@%x,%y"] end]
    }
    bind .text.text <Return> {
	put_new_text $history_book($history_current) \
		[lindex [.text.text tag names insert] end]
    }
    bind .text.text <space> go_next_link_tag
    bind .text.text <BackSpace> go_previous_link_tag

    #
    # For wheel mouse.
    #
    bind Text <Button-5> {%W yview scroll 5 units}
    bind Text <Button-4> {%W yview scroll -5 units}

    #
    # Prevent an user from editing Hits and Text.
    #
    bind Text <KeyPress> {}
    bind Text <Tab> {}
    bind Text <Return> {}
    bind Text <BackSpace> {}
    bind Text <Control-v> {tkTextSetCursor %W [tkTextScrollPages %W 1]}
    bind Text <M-v> {tkTextSetCursor %W [tkTextScrollPages %W -1]}
    bind Text <Control-u> {tkTextSetCursor %W [tkTextScrollPages %W -1]}

    #
    # Add some keybindngs to the Menu widget.
    #
    bind Menu <p> {tkMenuUpArrow %W}
    bind Menu <Control-p> {tkMenuUpArrow %W}
    bind Menu <n> {tkMenuDownArrow %W}
    bind Menu <Control-n> {tkMenuDownArrow %W}

    #
    # Add some keybindngs to the Entry widget.
    #
    bind Entry <Control-y> {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: