# $Id: cyrillize.tcl 1725 2009-03-13 19:12:07Z sergei $

package require msgcat

namespace eval cyrillize {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered cyrillize]} {
	::plugins::register cyrillize \
			    -namespace [namespace current] \
			    -source [info script] \
			    -description [::msgcat::mc "Whether the Cyrillize plugin is loaded."] \
			    -loadcommand [namespace code \
						    [list load [file join \
								     [file dirname [info script]] \
								     engrus.tbl]]] \
			    -unloadcommand [namespace code unload]
	return
    }
}

proc cyrillize::load {filename} {
    load_table $filename

    event add <<Cyrillize-Eng-Rus>> <Control-quoteright>
    event add <<Cyrillize-Eng-Rus>> <Control-yacute>
    event add <<Cyrillize-Rus-Eng>> <Control-quotedbl>
    event add <<Cyrillize-Rus-Eng>> <Control-Yacute>

    bind Text <<Cyrillize-Eng-Rus>> \
	 [list [namespace current]::wordInText %W eng rus]
    bind Text <<Cyrillize-Eng-Rus>> +break
    bind Text <<Cyrillize-Rus-Eng>> \
	 [list [namespace current]::wordInText %W rus eng]
    bind Text <<Cyrillize-Rus-Eng>> +break

    bind Entry <<Cyrillize-Eng-Rus>> \
	 [list [namespace current]::wordInEntry %W eng rus]
    bind Entry <<Cyrillize-Eng-Rus>> +break
    bind Entry <<Cyrillize-Rus-Eng>> \
	 [list [namespace current]::wordInEntry %W rus eng]
    bind Entry <<Cyrillize-Rus-Eng>> +break

    bind BwEntry <<Cyrillize-Eng-Rus>> \
	 [list [namespace current]::wordInEntry %W eng rus]
    bind BwEntry <<Cyrillize-Eng-Rus>> +break
    bind BwEntry <<Cyrillize-Rus-Eng>> \
	 [list [namespace current]::wordInEntry %W rus eng]
    bind BwEntry <<Cyrillize-Rus-Eng>> +break
}

proc cyrillize::unload {} {
    variable convert

    bind Text <<Cyrillize-Eng-Rus>> {}
    bind Text <<Cyrillize-Rus-Eng>> {}
    bind Entry <<Cyrillize-Eng-Rus>> {}
    bind Entry <<Cyrillize-Rus-Eng>> {}
    bind BwEntry <<Cyrillize-Eng-Rus>> {}
    bind BwEntry <<Cyrillize-Rus-Eng>> {}

    event delete <<Cyrillize-Eng-Rus>> <Control-quoteright>
    event delete <<Cyrillize-Eng-Rus>> <Control-yacute>
    event delete <<Cyrillize-Rus-Eng>> <Control-quotedbl>
    event delete <<Cyrillize-Rus-Eng>> <Control-Yacute>

    catch {unset convert}
}

proc cyrillize::load_table {filename} {
    variable convert

    set fd [open $filename]
    fconfigure $fd -encoding koi8-r
    set convert_table [read $fd]
    close $fd

    foreach {f t} $convert_table {
	set convert(eng,rus,$f) $t
	set convert(rus,eng,$t) $f
    }
}

proc cyrillize::do {s from to} {
    variable convert

    set res ""
    foreach c [split $s ""] {
	if {[info exists convert($from,$to,$c)]} {
	    append res $convert($from,$to,$c)
	} elseif {[info exists convert($from,$to,[string tolower $c])]} {
	    append res [string toupper $convert($from,$to,[string tolower $c])]
	} else {
	    append res $c
	}
    }
    return $res
}

proc cyrillize::wordInText {w from to} {
    if {[$w cget -state] != "normal"} return

    set ins [lindex [split [$w index insert] .] 1]
    set line [$w get "insert linestart" "insert lineend"]
    set wordstart [string wordstart $line [expr {$ins-1}]]
    set wordend [string length \
			[string trimright \
				[string range $line 0 [expr {$wordstart-1}]]]]
    set word [string range $line $wordstart [expr {$ins-1}]]

    set newword [do $word $from $to]
    $w delete "insert linestart +$wordstart chars" insert
    $w insert insert $newword

    $w mark set insert "insert linestart +$wordend chars"
}

proc cyrillize::wordInEntry {w from to} {
    if {[$w cget -state] != "normal"} return

    set ins [$w index insert]
    set line [$w get]
    set wordstart [string wordstart $line [expr {$ins-1}]]
    set wordend [string length \
			[string trimright \
				[string range $line 0 [expr {$wordstart-1}]]]]
    set word [string range $line $wordstart [expr {$ins-1}]]

    set newword [do $word $from $to]
    $w delete $wordstart insert
    $w insert insert $newword

    $w icursor $wordend
}

