# kinput.tcl --
#
# This file contains Tcl procedures used to input Japanese text.
#
# $Header: /ext/cvsroot/tk/library/kinput.tcl,v 1.1 1995/12/21 08:31:57 hoshi Exp $
#
# Copyright (c) 1993  Software Research Associates, Inc.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation, and that the name of Software Research Associates not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.  Software Research
# Associates makes no representations about the suitability of this software
# for any purpose.  It is provided "as is" without express or implied
# warranty.
#

# ----------------------------------------------------------------------
# Class bindings for start Japanese text input (Kana-Kanji conversion).
# Use over-the-spot style for text widgets, root style for entry widgets.
# ----------------------------------------------------------------------

#bind Text <Shift-space> {kinput_start %W over}
bind Text <Control-backslash> {kinput_start %W over}
bind Text <Control-Kanji> {kinput_start %W over}
bind Text <Control-Shift_R> {kinput_start %W over}

#bind Entry <Shift-space> {kinput_start %W}
bind Entry <Control-backslash> {kinput_start %W}
bind Entry <Control-Kanji> {kinput_start %W}
bind Entry <Control-Shift_R> {kinput_start %W}


# The procedure below is invoked in order to start Japanese text input
# for the specified widget.  It sends a request to the input server to
# start conversion on that widget.
# Second argument specifies input style.  Valid values are "over" (for
# over-the-spot style) and "root" (for root window style). See X11R5
# Xlib manual for the meaning of these styles). The default is root
# window style.

proc kinput_start {w {style root}} {
    global _kinput_priv
    catch {unset _kinput_priv($w)}
    if {$style=="over"} then {
	set spot [_kinput_spot $w]
	if {"$spot" != ""} then {
	    trace variable _kinput_priv($w) w _kinput_trace_$style
	    kanjiInput start $w \
		-variable _kinput_priv($w) \
		-inputStyle over \
		-foreground [_kinput_attr $w -foreground] \
		-background [_kinput_attr $w -background] \
		-fonts [list [_kinput_attr $w -font] \
			    [_kinput_attr $w -kanjifont]] \
		-clientArea [_kinput_area $w] \
		-spot $spot
	    return
	}
    }
    trace variable _kinput_priv($w) w _kinput_trace_root
    kanjiInput start $w -variable _kinput_priv($w) -inputStyle root
}

# The procedure below is invoked to send the spot location (the XY
# coordinate of the point where characters to be inserted) to the
# input server.  It should be called whenever the location has
# been changed while in over-the-spot conversion mode.

proc kinput_send_spot {w} {
    set spot [_kinput_spot $w]
    if {"$spot" != ""} then {
	kanjiInput attribute $w -spot $spot
    }
}

#
# All of the procedures below are the internal procedures for this
# package.
#

# The following procedure returns the list of XY coordinate of the
# current insertion point of the specified widget.

proc _kinput_spot {w} {
    $w xypos insert
}

# The following procedure returns the list of drawing area of the
# specified widget. { x y width height }

proc _kinput_area {w} {
    set bw [_kinput_attr $w -borderwidth]
    return "$bw $bw [expr {[winfo width $w] - $bw*2}] [expr {[winfo height $w] - $bw*2}]"
}

# The following procedure returns the value of the specified option
# (resource).
proc _kinput_attr {w option} {lindex [$w configure $option] 4}

# The two procedures below are callbacks of a variable tracing.
# The traced variable contains the text string sent from the
# input server as a conversion result.

# for root style
proc _kinput_trace_root {name1 name2 op} {
    upvar #0 $name1 trvar
    $name2 insert insert $trvar($name2)
    unset $trvar($name2)
}

# for over-the-spot style
proc _kinput_trace_over {name1 name2 op} {
    upvar #0 $name1 trvar
    $name2 insert insert $trvar($name2)
    kinput_send_spot $name2
    unset $trvar($name2)
}
