# cyrillize.tcl --
#
#       This file iplements Cyrillize plugin for the Tkabber XMPP client.
#       It allows to fix English words accidentally typed in Russian keyboard
#       layout and vice versa. Only QWERTY/JCUKEN conversion is supported.

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
    }

    custom::defgroup Plugins [::msgcat::mc "Plugins options."] \
        -group Tkabber

    custom::defgroup Cyrillize [::msgcat::mc "Cyrillize plugin options."] \
        -group Plugins
    custom::defvar options(cyr) rus \
        [::msgcat::mc "Cyrillic layout to switch to/from."] -group Cyrillize \
        -type options -values [list rus [::msgcat::mc "Russian"] \
                                    ukr [::msgcat::mc "Ukrainian"]]
}

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

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

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

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

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

proc cyrillize::unload {} {
    variable convert

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

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

    catch {unset convert}
}

proc cyrillize::load_table {filename} {
    variable convert

    set fd [open $filename]
    fconfigure $fd -encoding utf-8
    set convert_table [read $fd]
    close $fd

    foreach {e r u} $convert_table {
        set convert(eng,rus,$e) $r
        set convert(rus,eng,$r) $e
        set convert(eng,ukr,$e) $u
        set convert(ukr,eng,$u) $e
    }
}

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

    if {$from eq "cyr"} {
        set from $options(cyr)
    }

    if {$to eq "cyr"} {
        set to $options(cyr)
    }

    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
}

# vim:ft=tcl:ts=8:sw=4:sts=4:et
