1
# Translate 0.3 for aMSN 0.97 - by number-g (g-at-imagination-dot-eu-dot-org)
5
namespace eval ::translate {
7
array set ::translate::languages {
8
Albanian sq Arabic ar Bulgarian bg Chinese_simp zh-cn
9
Chinese_trad zh-tw Catalan ca Croatian hr Czech cs
10
Danish da Dutch nl English en Estonian et Filipino tl
11
Finnish fi French fr Galician gl German de Greek el
12
Hebrew iw Hindi hi Hungarian hu Indonesian id Italian it
13
Japanese ja Korean ko Latvian lv Lithuanian lt Maltese mt
14
Norwegian no Polish pl Portuguese pt Romanian ro Russian ru
15
Spanish es Serbian sr Slovak sk Slovenian sl Swedish sv
16
Thai th Turkish tr Ukrainian uk Vietnamese vi
20
::plugins::RegisterPlugin "Translate"
21
::plugins::RegisterEvent "Translate" new_conversation populate_chatwindow
22
::plugins::RegisterEvent "Translate" chat_msg_send outgoing
23
::plugins::RegisterEvent "Translate" chat_msg_receive incoming
25
# Set config variables per-chatid.
26
set c [::abook::getAllContacts]
29
set ::translate::config($contact) 0
30
set ::translate::config($contact.from) Source
31
set ::translate::config($contact.to) Destination
32
set ::translate::config($contact.hide) 0
33
set ::translate::config($contact.viceversa) 0
37
# Shameless self-promotion
38
set ::translate::configlist [list \
39
[list label "Translate 0.3 for aMSN 0.97"] \
40
[list label "by number-g (g-at-imagination-dot-eu-dot-org)"] \
42
[list label "Hint: starting your sentences with a \".\" will"] \
43
[list label "bypass the translator."] \
45
[list label "If you find this plugin useful, please consider"] \
46
[list label "making a donation by clicking the link below:"] \
48
[list frame ::translate::donatebutton ""] \
52
proc donatebutton {win} {
57
label $frame.donate -text "Donate!" -cursor hand2 -font splainf \
58
-background [::skin::getKey extrastdwindowcolor] -foreground [::skin::getKey extralinkcolor]
60
bind $frame.donate <Enter> "$frame.donate configure -font sunderf -cursor hand2 \
61
-background [::skin::getKey extralinkbgcoloractive] -foreground [::skin::getKey extralinkcoloractive]"
62
bind $frame.donate <Leave> "$frame.donate configure -font splainf -cursor left_ptr \
63
-background [::skin::getKey extrastdwindowcolor] -foreground [::skin::getKey extralinkcolor]"
64
bind $frame.donate <ButtonRelease> "launch_browser https://www.paypal.com/cgi-bin/webscr?cmd=_donations&business=SKCWYSL36RGZW&lc=GB&item_name=Translate_plugin_v0.3-for_aMSN_0.97¤cy_code=GBP&bn=PP%2dDonationsBF%3abtn_donateCC_LG%2egif%3aNonHosted"
70
proc populate_chatwindow {event evpar} {
74
set chatid $args(chatid)
75
set window [::ChatWindow::For $chatid]
77
set placement $window.top.padding
78
pack [create_ui $window $placement $chatid] -fill x
81
proc create_ui {window placement chatid} {
83
set ui $placement.translate
87
set viceversa $ui.viceversa
88
set showhide $ui.showhide
94
label $fl -text "Translate from: "
97
checkbutton $onoff -indicatoron 1 -onvalue 1 -offvalue 0 \
98
-selectcolor green -text "On/Off" -variable ::translate::config($chatid)
100
checkbutton $viceversa -indicatoron 1 -onvalue 1 -offvalue 0 \
101
-selectcolor green -text "Translate incoming messages" -variable ::translate::config($chatid.viceversa)
103
checkbutton $showhide -indicatoron 1 -onvalue 1 -offvalue 0 \
104
-selectcolor green -text "Hide original" -variable ::translate::config($chatid.hide)
107
combobox::combobox $from -editable 0 -width 11 -textvariable ::translate::config($chatid.from)
108
combobox::combobox $to -editable 0 -width 11 -textvariable ::translate::config($chatid.to)
110
# Populate comboboxes.
111
foreach language [lsort [array names ::translate::languages]] {
112
$from list insert end $language
113
$to list insert end $language
116
pack $fl -side left; pack $from -side left
117
pack $tl -side left -padx 5; pack $to -side left
119
pack $onoff -side right -padx 2
120
pack $showhide -side right -padx 2
121
pack $viceversa -side right -padx 2
126
proc outgoing {event evpar} {
128
upvar 2 chatid chatid
131
set from $::translate::languages($::translate::config($chatid.from))
132
set to $::translate::languages($::translate::config($chatid.to))
133
set state $::translate::config($chatid)
136
set msg [translate $chatid $msg $from $to]
143
proc incoming {event evpar} {
145
upvar 2 chatid chatid
146
upvar 2 message message
148
if {$user!=[::config::getKey login]} {
150
if {$::translate::config($chatid.viceversa)==1} {
152
set from $::translate::languages($::translate::config($chatid.from))
153
set to $::translate::languages($::translate::config($chatid.to))
154
set state $::translate::config($chatid)
157
set message [translate $chatid $message $to $from]
168
proc translate {chatid msg from to} {
170
set case [testcase $msg]
172
# A "." at the beginning of a line bypasses translation
173
if {[string range $msg 0 0]!="."} {
176
set query [::http::formatQuery v 1.0 q [convert $msg] langpair $from|$to] ;# See convert proc for explaination.
178
# Include original text, but we don't need to see the emoticons twice.
179
if {$translate::config($chatid.hide)==0} {
180
set original "« $msg »\n- "
181
set query [::http::formatQuery v 1.0 q [convert [stripemoticons $msg]] langpair $from|$to]
184
set tran [::http::geturl http://ajax.googleapis.com/ajax/services/language/translate?$query -query]
185
set tran [::http::data $tran]
187
set tran [split $tran \"] ;# Maybe there is a more elegant way to do this(?)
188
set tran [string trim [replace [lindex $tran 5]]] ;# See replace proc for explaination
191
# Some stuff here to make things feel more natural and avoid needless repetition:
192
# 1: Don't bother with empty strings or dupes.
193
# 2: Google will add a space to (for example) "hi...", returning "hi ..." adding needless repetition to the output.
194
# 3: Can't remember exactly why these are here, but I can remember that it solved something that irritated me.
196
if {$tran!=$msg && $tran!="" \
197
&& [regsub -all { } $tran {}]!=[stripemoticons $msg] \
198
&& [stripemoticons $msg]!=$tran \
199
&& [string tolower $tran]!=$msg} {
201
set msg $original$tran
203
# If I choose to type in lower case, I want the translated text to reflect this:
204
if {$case==0} {return [string tolower $msg]} else {return $msg}
211
# Google returns these as HTML escaped unicode characters. We want them to be legible:
213
proc replace {text} {
247
foreach {char replace} [array get chars] {
248
regsub -all \\\\$char $text $replace text
253
proc stripemoticons {text} {
255
set emoticons [list {:-\)} {:\)} {:-D} {:d} {:-O} {:o} {:\-P} {:p} {;-\)} {;\)} {:-\(} {:\(} {:-S} {:s} {:-\|} {:\|} \
256
{:'\(} {:-\$} {:\$} {\(H\)} {:-@} {:@} {\(A\)} {\(6\)} {:-#} {8o\|} {8-\|} {\^o\)} {:-\*} {\+o\(} \
257
{:\^\)} {\*-\)} {<:o\)} {8-\)} {\|-\)} {\(C\)} {\(Y\)} {\(N\)} {\(B\)} {\(D\)} {\(X\)} {\(Z\)} \
258
{\(\{\)} {\(\}\)} {:-\[} {:\[} {\(\^\)} {\(L\)} {\(U\)} {\(K\)} {\(G\)} {\(F\)} {\(W\)} {\(P\)} \
259
{\(~\)} {\(@\)} {\(&\)} {\(T\)} {\(I\)} {\(8\)} {\(S\)} {\(\*\)} {\(E\)} {\(O\)} {\(M\)} {\(sn\)} \
260
{\(bah\)} {\(pl\)} {\(\|\|\)} {\(pi\)} {\(so\)} {\(au\)} {\(ap\)} {\(um\)} {\(ip\)} {\(co\)} \
261
{\(mp\)} {\(st\)} {\(li\)} {\(mo\)} ]
263
foreach code $emoticons {
264
regsub -all -nocase $code $text {} text
266
return [string trim $text]
269
# Find out if we are typing in lowercase:
270
proc testcase {string} {
272
set x [string length $string]
273
for {set i 0} {$i<$x} {incr i} {
274
if {[string is alpha [string range $string $i $i]]} {append output [string range $string $i $i]}
276
if {[string is lower $output]} {return 0} else {return 1}
280
# Sending the text to Google as-is caused problems with accents for Windows users;
281
# ie - "ça va?" was being sent as "a va?", leading to (sometimes hilarious) mistranslations.
283
# This proc converts each character to HTML escaped unicode before sending to Google.
284
proc convert {string} {
286
set x [string length $string]
287
for {set i 0} {$i<$x} {incr i} {
288
append output "&#[scan [string range $string $i $i] %c];"
added
removed
plugins/Translate/translate.tcl
