[Tkabber-dev] r802 - in trunk/tkabber: . contrib/extract-translations jabberlib-tclxml plugins/filetransfer plugins/richtext

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Nov 24 22:14:39 MSK 2006


Author: sergei
Date: 2006-11-24 22:14:19 +0300 (Fri, 24 Nov 2006)
New Revision: 802

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/contrib/extract-translations/extract.tcl
   trunk/tkabber/jabberlib-tclxml/stanzaerror.tcl
   trunk/tkabber/plugins/filetransfer/http.tcl
   trunk/tkabber/plugins/filetransfer/jidlink.tcl
   trunk/tkabber/plugins/filetransfer/si.tcl
   trunk/tkabber/plugins/richtext/emoticons.tcl
   trunk/tkabber/si.tcl
   trunk/tkabber/trans.tcl
Log:
	* contrib/extract-translations/extract.tcl: Changed the only
	  defined variable when checking for variables in strings to
	  less common name. Added hidden key -showvars to show all
	  strings with embedded variables.

	* jabberlib-tclxml/stanzaerror.tcl: Added extra braces to
	  eval arguments to fix the hypothetical case of error type
	  and condition with spaces.

	* plugins/filetransfer/http.tcl, plugins/filetransfer/jidlink.tcl,
	  plugins/filetransfer/si.tcl, si.tcl: Added translations
	  of error messages, sent to the peer.

	* plugins/richtext/emoticons.tcl: Removed list search options,
	  which aren't in Tcl 8.3.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/ChangeLog	2006-11-24 19:14:19 UTC (rev 802)
@@ -1,3 +1,21 @@
+2006-11-24  Sergei Golovan  <sgolovan at nes.ru>
+
+	* contrib/extract-translations/extract.tcl: Changed the only
+	  defined variable when checking for variables in strings to
+	  less common name. Added hidden key -showvars to show all
+	  strings with embedded variables.
+
+	* jabberlib-tclxml/stanzaerror.tcl: Added extra braces to
+	  eval arguments to fix the hypothetical case of error type
+	  and condition with spaces.
+
+	* plugins/filetransfer/http.tcl, plugins/filetransfer/jidlink.tcl,
+	  plugins/filetransfer/si.tcl, si.tcl: Added translations
+	  of error messages, sent to the peer.
+
+	* plugins/richtext/emoticons.tcl: Removed list search options,
+	  which aren't in Tcl 8.3.
+
 2006-11-23  Sergei Golovan  <sgolovan at nes.ru>
 
 	* contrib/extract-translations/extract.tcl: Added search

Modified: trunk/tkabber/contrib/extract-translations/extract.tcl
===================================================================
--- trunk/tkabber/contrib/extract-translations/extract.tcl	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/contrib/extract-translations/extract.tcl	2006-11-24 19:14:19 UTC (rev 802)
@@ -28,6 +28,7 @@
     {trans       "Extract ::trans messages (::msgcat messages by default)"}
     {unused      "Show unused translated messages"}
     {lang.arg ?? "Prepare messages for specified language, default is"}
+    {showvars.secret "Show translatable strings with variables only"}
 }
 set usage ": extract.tcl \[options\] directory \[msgfile\]\noptions:"
 if {[catch {
@@ -60,9 +61,12 @@
     # take lang from the message file name
     regexp {([-a-z]+)\.msg$} $translationFile -> lang
 }
+set showvars $params(showvars)
 
-proc key_with_var {key} {
-    catch [list eval list $key]
+proc key_with_var {___key} {
+    # The only variable which is defined here is ___key, but
+    # it isn't likely to appear in translatable messages
+    catch [list eval list $___key]
 }
 
 # Read all tcl file from sourceDir
@@ -80,7 +84,8 @@
         while {[regexp -- $msgcat_regexp1 $line1 whole key] || \
 		    [regexp -- $msgcat_regexp2 $line1 whole key] || \
 		    [regexp -- $msgcat_regexp3 $line1 whole key]} {
-	    if {$key != "" && ![key_with_var $key]} {
+	    if {$key != "" && ((![key_with_var $key] && !$showvars) || \
+			       ([key_with_var $key] && $showvars))} {
 		if {![info exists mkeyHash($filename)]} {
 		    # Create a new list (with the current key) for this file
 		    set mkeyHash($filename) [list $key]
@@ -98,7 +103,8 @@
         while {[regexp -- $trans_regexp1 $line1 whole _lang key] || \
 		    [regexp -- $trans_regexp2 $line1 whole _lang key] || \
 		    [regexp -- $trans_regexp3 $line1 whole _lang key]} {
-	    if {$key != "" && ![key_with_var $key]} {
+	    if {$key != "" && ((![key_with_var $key] && !$showvars) || \
+			       ([key_with_var $key] && $showvars))} {
 		if {![info exists tkeyHash($filename)]} {
 		    # Create a new list (with the current key) for this file
 		    set tkeyHash($filename) [list $key]
@@ -164,6 +170,12 @@
     }
 }
 
+if {$showvars} {
+    print_all_results mkeyHash ::msgcat::mcset $lang
+    print_all_results tkeyHash ::trans::trset $lang
+    exit 0
+}
+
 if {$trans} {
     upvar 0 tkeyHash hash
     set regexp $trans_regexp0

Modified: trunk/tkabber/jabberlib-tclxml/stanzaerror.tcl
===================================================================
--- trunk/tkabber/jabberlib-tclxml/stanzaerror.tcl	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/jabberlib-tclxml/stanzaerror.tcl	2006-11-24 19:14:19 UTC (rev 802)
@@ -151,7 +151,7 @@
 ##########################################################################
 
 proc stanzaerror::error {type condition args} {
-    return [eval xmpp_error $type $condition $args]
+    return [eval {xmpp_error $type $condition} $args]
 }
 
 ##########################################################################

Modified: trunk/tkabber/plugins/filetransfer/http.tcl
===================================================================
--- trunk/tkabber/plugins/filetransfer/http.tcl	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/plugins/filetransfer/http.tcl	2006-11-24 19:14:19 UTC (rev 802)
@@ -14,10 +14,6 @@
 	[::msgcat::mc "HTTP options."] \
 	-group {File Transfer}
 
-    custom::defvar options(enable) 1 \
-	[::msgcat::mc "Enable HTTP transport for outgoing file transfers."] \
-	-group HTTP -type boolean
-
     custom::defvar options(port) 0 \
         [::msgcat::mc "Port for outgoing HTTP file transfers (0 for assigned\
 		       automatically). This is useful when sending files from\
@@ -169,7 +165,7 @@
 ###############################################################################
 ###############################################################################
 
-proc http::recv_file_dialog {from urls desc} {
+proc http::recv_file_dialog {from lang urls desc} {
     variable winid
     variable result
 
@@ -221,11 +217,11 @@
     grid rowconfigure $f 1 -weight 1
     
     $w add -text [::msgcat::mc "Receive"] \
-	-command [list [namespace current]::recv_file_start $winid $from $url]
+	-command [list [namespace current]::recv_file_start $winid $from $lang $url]
     $w add -text [::msgcat::mc "Cancel"] \
 	-command [list destroy $w]
     bind .ftrfd$winid <Destroy> \
-	[list [namespace current]::recv_file_cancel $winid]
+	[list [namespace current]::recv_file_cancel $winid $lang]
 
     $w draw
     vwait [namespace current]::result($winid)
@@ -246,7 +242,7 @@
 
 package require http
 
-proc http::recv_file_start {winid from url} {
+proc http::recv_file_start {winid from lang url} {
     variable saveas$winid
     variable chunk_size
     variable result
@@ -275,15 +271,21 @@
 	bind .ftrfd$winid <Destroy> {}
 	destroy .ftrfd$winid
 	# TODO: More precise error messages?
-	set result($winid) {error cancel item-not-found -text "File Not Found"}
+	set result($winid) \
+	    [list error cancel item-not-found \
+		  -text [::trans::trans $lang "File not found"]]
 	after idle [list MessageDlg .ftrecv_error$winid \
-			 -aspect 50000 -icon error \
-			 -message [format [::msgcat::mc \
-			 "Can't receive file: %s"] $token] -type user \
-			 -buttons ok -default 0 -cancel 0]
+			 -aspect 50000 \
+			 -icon error \
+			 -message [::msgcat::mc \
+				       "Can't receive file: %s" $token] \
+			 -type user \
+			 -buttons ok \
+			 -default 0 \
+			 -cancel 0]
     } else {
 	bind .ftrfd$winid <Destroy> \
-	    [list [namespace current]::recv_file_cancel $winid $token]
+	    [list [namespace current]::recv_file_cancel $winid $lang $token]
     }
 }
 
@@ -311,7 +313,7 @@
     set result($winid) {result {}}
 }
 
-proc http::recv_file_cancel {winid {token ""}} {
+proc http::recv_file_cancel {winid lang {token ""}} {
     variable result
     variable fds
 
@@ -325,7 +327,9 @@
     if {![cequal $token ""]} {
 	::http::reset $token cancelled
     }
-    set result($winid) {error cancel not-allowed -text "File Transfer Refused"}
+    set result($winid) \
+	[list error cancel not-allowed \
+	      -text [::trans::trans $lang "File transfer is refused"]]
 }
 
 ###############################################################################
@@ -344,7 +348,7 @@
 	}
     }
 
-    return [recv_file_dialog $from $urls $desc]
+    return [recv_file_dialog $from $lang $urls $desc]
 }
 
 iq::register_handler set query jabber:iq:oob \

Modified: trunk/tkabber/plugins/filetransfer/jidlink.tcl
===================================================================
--- trunk/tkabber/plugins/filetransfer/jidlink.tcl	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/plugins/filetransfer/jidlink.tcl	2006-11-24 19:14:19 UTC (rev 802)
@@ -13,10 +13,6 @@
     custom::defgroup Jidlink \
 	[::msgcat::mc "Jidlink options."] \
 	-group {File Transfer}
-
-    custom::defvar options(enable) 0 \
-	[::msgcat::mc "Enable Jidlink transport for outgoing file transfers (it is obsolete)."] \
-	-group Jidlink -type boolean
 }
 
 ###############################################################################
@@ -60,22 +56,25 @@
 
 ###############################################################################
 
-proc ftjl::send_file_request {connid from id offset} {
+proc ftjl::send_file_request {connid from lang id offset} {
     variable files
 
     if {![info exists files(token,$id)]} {
-	return [list error cancel not-allowed -text "Invalid file ID"]
+	return [list error cancel not-allowed \
+		     -text [::trans::trans $lang "Invalid file ID"]]
     }
 
     set token $files(token,$id)
     upvar #0 $token state
 
     if {![info exists state(fd)]} {
-	return [list error cancel not-allowed -text "Transfer is expired"]
+	return [list error cancel not-allowed \
+		     -text [::trans::trans $lang "Transfer is expired"]]
     }
 
     if {$state(connid) != $connid || $state(jid) != $from} {
-	return [list error cancel not-allowed -text "Invalid file ID"]
+	return [list error cancel not-allowed \
+		     -text [::trans::trans $lang "Invalid file ID"]]
     }
 
     set state(key) [random 1000000000]
@@ -147,7 +146,7 @@
 ###############################################################################
 ###############################################################################
 
-proc ftjl::recv_file_dialog {connid from id name size date hash desc} {
+proc ftjl::recv_file_dialog {connid from lang id name size date hash desc} {
     variable winid
     variable files
     variable result
@@ -206,11 +205,11 @@
     grid rowconfigure $f 2 -weight 1
     
     $w add -text [::msgcat::mc "Receive"] -command \
-	[list [namespace current]::recv_file_start $winid $size $pbvar $connid $from $id]
+	[list [namespace current]::recv_file_start $winid $size $pbvar $connid $from $lang $id]
     $w add -text [::msgcat::mc "Cancel"] -command \
-	[list [namespace current]::recv_file_cancel $winid]
+	[list [namespace current]::recv_file_cancel $winid $lang]
     bind .rfd$winid <Destroy> \
-            [list [namespace current]::recv_file_failed $winid]
+            [list [namespace current]::recv_file_failed $winid $lang]
 
     $w draw
     vwait [namespace current]::result($winid)
@@ -233,7 +232,7 @@
 
 ###############################################################################
 
-proc ftjl::recv_file_start {winid size pbvar connid user id} {
+proc ftjl::recv_file_start {winid size pbvar connid user lang id} {
     variable saveas$winid
     variable files
 
@@ -251,17 +250,17 @@
 				 -vars [list id $id]]]] \
 	-to $user \
 	-command [list [namespace current]::recv_file_reply \
-		       $winid $size $pbvar $user $id $filename] \
+		       $winid $size $pbvar $user $lang $id $filename] \
 	-connection $connid
 }
 
 ###############################################################################
 
-proc ftjl::recv_file_reply {winid size pbvar user id filename res child} {
+proc ftjl::recv_file_reply {winid size pbvar user lang id filename res child} {
     variable files
 
     if {$res != "OK"} {
-	recv_file_failed $winid
+	recv_file_failed $winid $lang
 	after idle \
 	    [list MessageDlg .auth_err -aspect 50000 -icon error \
 		  -message [format [::msgcat::mc "Receiving file failed: %s"] \
@@ -321,12 +320,13 @@
 
 ###############################################################################
 
-proc ftjl::recv_file_failed {winid} {
+proc ftjl::recv_file_failed {winid lang} {
     variable result
 
     bind .rfd$winid <Destroy> {}
     set result($winid) \
-	{error modify undefined-condition -text "File Transfer Failed"}
+	[list error modify undefined-condition \
+	      -text [::trans::trans $lang "File transfer is failed"]]
 }
 
 ###############################################################################
@@ -365,7 +365,7 @@
 
 ###############################################################################
 
-proc ftjl::recv_file_cancel {winid} {
+proc ftjl::recv_file_cancel {winid lang} {
     variable result
 
     catch {
@@ -373,7 +373,8 @@
 	destroy .rfd$winid
     }
     set result($winid) \
-	{error cancel not-allowed -text "File Transfer Refused"}
+	[list error cancel not-allowed \
+	      -text [::trans::trans $lang "File transfer is refused"]]
 }
 
 ###############################################################################
@@ -391,7 +392,7 @@
 	jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
 	if {$tag1 == "file"} {
 	    if {[jlib::wrapper:getattr $vars1 name] != ""} {
-		return [recv_file_dialog $connid $from \
+		return [recv_file_dialog $connid $from $lang \
 		       [jlib::wrapper:getattr $vars1 id] \
 		       [jlib::wrapper:getattr $vars1 name] \
 		       [jlib::wrapper:getattr $vars1 size] \
@@ -399,7 +400,7 @@
 		       [jlib::wrapper:getattr $vars1 hash] \
 		       $chdata1]
 	    } else {
-		return [send_file_request $connid $from \
+		return [send_file_request $connid $from $lang \
 			    [jlib::wrapper:getattr $vars1 id] \
 			    [jlib::wrapper:getattr $vars1 offset]]
 	    }

Modified: trunk/tkabber/plugins/filetransfer/si.tcl
===================================================================
--- trunk/tkabber/plugins/filetransfer/si.tcl	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/plugins/filetransfer/si.tcl	2006-11-24 19:14:19 UTC (rev 802)
@@ -13,10 +13,6 @@
     custom::defgroup {Stream Initiation} \
 	[::msgcat::mc "Stream initiation options."] \
 	-group {File Transfer}
-
-    custom::defvar options(enable) 1 \
-	[::msgcat::mc "Enable SI transport for outgoing file transfers."] \
-	-group {Stream Initiation} -type boolean
 }
 
 set ::NS(file-transfer) http://jabber.org/protocol/si/profile/file-transfer
@@ -104,7 +100,7 @@
 ###############################################################################
 ###############################################################################
 
-proc si::recv_file_dialog {connid from id name size date hash desc} {
+proc si::recv_file_dialog {connid from lang id name size date hash desc} {
     variable winid
 
     set token [namespace current]::[incr winid]
@@ -115,6 +111,7 @@
 
     set state(connid) $connid
     set state(jid) $from
+    set state(lang) $lang
     set state(id) $id
 
     Dialog $w -title [format [::msgcat::mc "Receive file from %s"] $from] \
@@ -209,7 +206,8 @@
     upvar #0 $token state
 
     set state(result) [list 1 [list error cancel not-allowed \
-					  -text "Transfer is rejecterd"]]
+					  -text [::trans::trans $state(lang) \
+						     "File transfer is refused"]]]
 }
 
 ###############################################################################
@@ -233,7 +231,8 @@
 	# Return error to the sender but leave transfer window with disabled
 	# 'Receive' button and error message.
 	set state(result) [list 0 [list error modify bad-request \
-					    -text "Stream ID is in use"]]
+					    -text [::trans::trans $state(lang) \
+						       "Stream ID is in use"]]]
 	ft::report_error $state(f) \
 	    [error_to_string [::msgcat::mc "Receive error: Stream ID is in use"]]
 	return
@@ -297,7 +296,7 @@
 ###############################################################################
 ###############################################################################
 
-proc si::si_handler {connid from id mimetype child} {
+proc si::si_handler {connid from lang id mimetype child} {
     debugmsg filetransfer "SI set: [list $from $child]"
 
     jlib::wrapper:splitxml $child tag vars isempty chdata children
@@ -314,6 +313,7 @@
 	recv_file_dialog \
 	    $connid \
 	    $from \
+	    $lang \
 	    $id \
 	    [jlib::wrapper:getattr $vars name] \
 	    [jlib::wrapper:getattr $vars size] \

Modified: trunk/tkabber/plugins/richtext/emoticons.tcl
===================================================================
--- trunk/tkabber/plugins/richtext/emoticons.tcl	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/plugins/richtext/emoticons.tcl	2006-11-24 19:14:19 UTC (rev 802)
@@ -548,7 +548,7 @@
 
     set theme_names [lsort [array names themes]]
 
-    set idx [lsearch -sorted $theme_names Default]
+    set idx [lsearch -exact $theme_names Default]
     if {$idx > 0} {
 	set theme_names [linsert [lreplace $theme_names $idx $idx] 0 Default]
     }
@@ -559,11 +559,11 @@
 
     set values [linsert $values 0 "" $options(no_theme)]
 
-    set idx [lsearch -sorted $theme_names $options(theme)]
+    set idx [lsearch -exact $theme_names $options(theme)]
     if {$idx >= 0} {
 	set theme [lindex $theme_names $idx]
     } else {
-	set idx [lsearch -sorted $theme_names Default]
+	set idx [lsearch -exact $theme_names Default]
 	if {$idx >= 0} {
 	    set theme [lindex $theme_names [expr {$idx - 1}]]
 	} else {

Modified: trunk/tkabber/si.tcl
===================================================================
--- trunk/tkabber/si.tcl	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/si.tcl	2006-11-24 19:14:19 UTC (rev 802)
@@ -334,7 +334,7 @@
 	    set xmlns [jlib::wrapper:getattr $vars1 xmlns]
 	    if {[string equal $xmlns $profile]} {
 		set profile_res [$profiledata($profile) \
-				     $connid $from $id $mimetype $item]
+				     $connid $from $lang $id $mimetype $item]
 	    } elseif {[string equal $xmlns \
 			   http://jabber.org/protocol/feature-neg]} {
 		set options [parse_negotiation $item]

Modified: trunk/tkabber/trans.tcl
===================================================================
--- trunk/tkabber/trans.tcl	2006-11-23 21:51:37 UTC (rev 801)
+++ trunk/tkabber/trans.tcl	2006-11-24 19:14:19 UTC (rev 802)
@@ -36,6 +36,9 @@
 # argument (no lang), then return unchanged message.
 proc ::trans::trans {args} {
     switch -- [llength $args] {
+	0 {
+	    return -code error "::trans::trans: Too few arguments"
+	}
 	1 {
 	    # Dummy call for searching translations in the source.
 	    return [lindex $args 0]



More information about the Tkabber-dev mailing list