# $Id: translate.tcl 530 2013-02-25 14:02:30Z rejjin $
# Contact: webrenji@gmail.com | rejjin@jabber.dk

lappend ::auto_path [file join [file dirname [info script]] "lib"]

package require http
package require json
package require msgcat
package require BWidget

namespace eval translate {
	
	::msgcat::mcload [file join [file dirname [info script]] msgs]
	
	variable Urls
	set Urls(langList) "http://translate.yandex.net/api/v1/tr.json/getLangs"
	set Urls(detectLang) "http://translate.yandex.net/api/v1/tr.json/detect?text=%text%"
	set Urls(translateText) "http://translate.yandex.net/api/v1/tr.json/translate?lang=%lang%&text=%text%"
	
	variable dLangs
	array set dLangs {} ;# For breaking exception
	
	variable localLang [lindex [split [msgcat::mclocale] _] 0]
	
	proc InitMenu {m chatwin X Y x y} {
		variable dLangs
		variable localLang
		
		set text ""
		catch { set text [$chatwin get sel.first sel.last] }
		
		if {[string length $text] == 0} {
			return ;# If selection text is none
		}
	
		$m add cascade -label [::msgcat::mc "Translate"] \
			-menu [menu $m.translate -tearoff 0]
		$m add separator
		
		$m.translate add command -label [::msgcat::mc "Autodetect"] \
			-command [list [namespace current]::translate $chatwin $localLang]
		$m.translate add separator
		
		foreach lang [array names dLangs] {
			lassign [split $lang -] from to
			lappend lngmap($from) $to
		}
		
		foreach left [lsort [array names lngmap]] {
			$m.translate add cascade -label "$left  " \
				-menu [menu $m.translate.$left -tearoff 0]
			foreach right [lsort $lngmap($left)] {
				$m.translate.$left add command \
					-label "$left -> $right" \
					-command [list [namespace current]::translate $chatwin \
						[join [list $left $right] -] ]
			}
		}
	}
	
	proc translate {chatwin lang} {
		variable Urls
		
		set text [::http::formatQuery [$chatwin get sel.first sel.last]]
		
		regsub "%lang%" $Urls(translateText) $lang url
		regsub "%text%" $url $text url
		
		if {[catch {set token [::http::geturl $url \
				-command [namespace current]::translateClbk]}]} {
			output 0 - -
			return
		}
		
		::http::wait $token		
	}
	
	proc translateClbk {token} {
		set data [::http::data $token]
		set result [::json::json2dict $data]
		
		set code [dict get $result "code"]; set text ""
		if {$code eq "200"} {
			set text [encoding convertfrom utf-8 \
				[lindex [dict get $result "text"] 0]]
			set lang [dict get $result "lang"]
			output $code $text $lang
		} else {
			output $code _ _
		}
		
		::http::cleanup $token
	}
	
	proc output {code text lang} {
		toplevel .translate
		
		.translate configure -borderwidth 2 -relief solid
		
		catch {wm attributes .translate -topmost 1}
		catch {wm overrideredirect .translate 1}
		catch {wm resizable .translate 0 0}
		
		label .translate.header -text [::msgcat::mc "Translate result | %s" $lang]
		text .translate.result -wrap word -height 14
		button .translate.cancel -text [::msgcat::mc "Cancel"] \
			-command {destroy .translate}
			
		pack .translate.header -fill x -expand yes
		pack .translate.result -fill both -expand yes
		pack .translate.cancel -fill x -expand yes -padx 1 -pady 1
		
		BWidget::place .translate 0 0 center
		
		if {$code eq "200"} {
			.translate.result insert 1.0 $text
		} else {
			switch -exact $code {
				413 { 
					set text [::msgcat::mc "Exceeded the maximum size of the text."]
				}
				422 {
					set text [::msgcat::mc "The text may not be transferred."]
				}
				501 {
					set text [::msgcat::mc "The direction of transfer is not supported."]
				}
				0 {
					set text [::msgcat::mc "Error connecting to the server."]
				}
			}
			
			.translate.result insert 1.0 [::msgcat::mc "Error code: %s\nText: %s" $code $text]
			.translate.header configure -text [::msgcat::mc "Error!"]
		}
	}
	
	proc getLanguageList {} {
		variable Urls
		
		if {[catch {set token [::http::geturl $Urls(langList) \
				-command [namespace current]::getLanguageListClbk]}]} {
			return [after idle [list after 60000 [namespace current]::getLanguageList]]
		}
		
		::http::wait $token
	}
	
	proc getLanguageListClbk {token} {
		variable dLangs
		
		set data [::http::data $token]
		
		foreach lang [dict get [::json::json2dict $data] "dirs"] {
			set dLangs($lang) 0
		}
		
		::http::cleanup $token
	}
	
	proc to_tag {text} {
		variable texttag
		variable tagtext
		
		if {[info exists texttag($text)]} {
			return $texttag($text)
		}
		
		regsub -all {[^[:alnum:]]+} $text {} prefix
		set tag $prefix[rand 1000000000]
		while {[info exists tagtext($tag)]} {
			set tag $prefix[rand 1000000000]
		}
		
		set texttag($text) $tag
		set tagtext($tag) $text
		
		return $tag
	}

	proc rand {num} {
		return [expr int(floor(rand()*$num))]
	}

	proc from_tag {tag} {
		variable tagtext

		if {[info exists tagtext($tag)]} {
			return $tagtext($tag)
		}
		
		::error::error "Unknown tag $tag"
	}
	
	hook::add chat_win_popup_menu_hook [namespace current]::InitMenu 1
	hook::add finload_hook [namespace current]::getLanguageList
}