[Tkabber-dev] r799 - in trunk/tkabber: . contrib/extract-translations plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Thu Nov 23 22:17:30 MSK 2006


Author: sergei
Date: 2006-11-23 22:17:10 +0300 (Thu, 23 Nov 2006)
New Revision: 799

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/contrib/extract-translations/extract.tcl
   trunk/tkabber/muc.tcl
   trunk/tkabber/plugins/general/remote.tcl
   trunk/tkabber/trans.tcl
Log:
	* contrib/extract-translations/extract.tcl: Added search
	  of ::trans messages.

	* trans.tcl: Added one-argument ::trans::trans (only to
	  allow searching messages, which are not to be translated
	  immediately).

	* muc.tcl, plugins/general/remote.tcl: Added ::trans::trans
	  calls, which help to search translatable messages.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-11-23 16:59:50 UTC (rev 798)
+++ trunk/tkabber/ChangeLog	2006-11-23 19:17:10 UTC (rev 799)
@@ -1,5 +1,15 @@
 2006-11-23  Sergei Golovan  <sgolovan at nes.ru>
 
+	* contrib/extract-translations/extract.tcl: Added search
+	  of ::trans messages.
+
+	* trans.tcl: Added one-argument ::trans::trans (only to
+	  allow searching messages, which are not to be translated
+	  immediately).
+
+	* muc.tcl, plugins/general/remote.tcl: Added ::trans::trans
+	  calls, which help to search translatable messages.
+
 	* jabberlib-tclxml/jabberlib.tcl: Made get_lang routine
 	  working in Tcl/Tk 8.5 (thanks to Irek Chmielowiec).
 

Modified: trunk/tkabber/contrib/extract-translations/extract.tcl
===================================================================
--- trunk/tkabber/contrib/extract-translations/extract.tcl	2006-11-23 16:59:50 UTC (rev 798)
+++ trunk/tkabber/contrib/extract-translations/extract.tcl	2006-11-23 19:17:10 UTC (rev 799)
@@ -1,142 +1,214 @@
 #!/usr/bin/tclsh
 #
 # Author: Vincent Ricard <vincent at magicninja.org>
-#
+# Modified: Sergei Golovan <sgolovan at nes.ru>
 
 package require fileutil
+package require cmdline
 
-set sourceDir [lindex $argv 0]
-if {[lindex $argv 1] == "-v"} {
-    set invertMatch true
-    set argv [lreplace $argv 1 1]
-} else {
-    set invertMatch false
+set msgcat_regexp0 \
+    {::msgcat::mcset [a-zA-Z]+[ \t\r\n]+\"(([^\"]|\\\")*)\"}
+set msgcat_regexp1 \
+    {\[::msgcat::mc[ \t\r\n]+\"(([^\"]|\\\")*)\"}
+set msgcat_regexp2 \
+    {\[::msgcat::mc[ \t\r\n]+{([^\}]*)}}
+set msgcat_regexp3 \
+    {\[::msgcat::mc[ \t\r\n]+([^ \t\r\n\{\"\[\]]*)}
+
+set trans_regexp0 \
+    {::trans::trset [a-zA-Z]+[ \t\r\n]+\"(([^\"]|\\\")*)\"}
+set trans_regexp1 \
+    {\[::trans::trans[ \t\r\n]+(\$[^ \t\r\n]+[ \t\r\n]+)?\"(([^\"]|\\\")*)\"}
+set trans_regexp2 \
+    {\[::trans::trans[ \t\r\n]+(\$[^ \t\r\n]+[ \t\r\n]+)?{([^\}]*)}}
+set trans_regexp3 \
+    {\[::trans::trans[ \t\r\n]+(\$[^ \t\r\n]+[ \t\r\n]+)?([^ \t\r\n\{\"\[\]]*)}
+
+set options {
+    {trans       "Extract ::trans messages (::msgcat messages by default)"}
+    {unused      "Show unused translated messages"}
+    {lang.arg ?? "Prepare messages for specified language, default is"}
 }
+set usage ": extract.tcl \[options\] directory \[msgfile\]\noptions:"
+if {[catch {
+	 array set params [::cmdline::getoptions argv $options $usage]
+     } msg]} {
+    puts stderr $msg
+    exit 1
+}
+
 switch -- [llength $argv] {
-    3 {
-	set translationFile [lindex $argv 1]
-	set lang [lindex $argv 2]
+    1 {
+	set sourceDir [lindex $argv 0]
+	set translationFile ""
     }
     2 {
-	set lang "??"
+	set sourceDir [lindex $argv 0]
 	set translationFile [lindex $argv 1]
-	regexp {([-a-z]+)\.msg$} $translationFile -> lang
     }
-    1 {
-	if {$invertMatch == "true"} {
-	    puts stderr {extract sourceDir [[-v ] translationFile [lang]]}
-	    exit 1
-	}
-	set lang "??"
-	set translationFile ""
-    }
     default {
-	# -v: show useless translations
-	puts stderr {extract sourceDir [[-v ] translationFile [lang]]}
+	puts stderr [::cmdline::usage $options $usage]
 	exit 1
     }
 }
 
+set sourceDir [lindex $argv 0]
+set trans $params(trans)
+set invertMatch $params(unused)
+set lang $params(lang)
+if {$lang == "??"} {
+    # take lang from the message file name
+    regexp {([-a-z]+)\.msg$} $translationFile -> lang
+}
+
+
 # Read all tcl file from sourceDir
 set tclFileList [::fileutil::findByPattern $sourceDir -glob -- *tcl]
 foreach filename $tclFileList {
     set fd [open $filename]
 
     while {-1 < [gets $fd line]} {
-	while {[string match {*\\} $line] && \
-		    ![string match {*\\\\} $line] && \
-		    [gets $fd line1] >= 0} {
+	while {[regexp {(^|[^\B])(\B\B)*\B$} $line] && [gets $fd line1] >= 0} {
 	    set line [string replace $line end end " [string trimleft $line1]"]
 	}
+
+	set line1 $line
         # Search: [ ::msgcat::mc "translation key"
-        while {[regexp -- {\[::msgcat::mc[ \t\r\n]+\"(([^\"]|\\\")*)\"} $line whole key] || \
-		    [regexp -- {\[::msgcat::mc[ \t\r\n]+{([^\}]*)}} $line whole key] || \
-		    [regexp -- {\[::msgcat::mc[ \t\r\n]+([^ \t\r\n\{\"\[\]]*)} $line whole key]} {
+        while {[regexp -- $msgcat_regexp1 $line1 whole key] || \
+		    [regexp -- $msgcat_regexp2 $line1 whole key] || \
+		    [regexp -- $msgcat_regexp3 $line1 whole key]} {
 	    if {$key != ""} {
-		if {![info exists keyHash($filename)]} {
+		if {![info exists mkeyHash($filename)]} {
 		    # Create a new list (with the current key) for this file
-		    set keyHash($filename) [list $key]
-		} elseif {[lsearch -exact $keyHash($filename) $key]<0} {
+		    set mkeyHash($filename) [list $key]
+		} elseif {[lsearch -exact $mkeyHash($filename) $key]<0} {
 		    # key doesn't exist for this file
-		    lappend keyHash($filename) $key
+		    lappend mkeyHash($filename) $key
 		}
 	    }
-	    set idx [string first $whole $line]
-	    set line [string replace $line 0 [expr {$idx + [string length $whole] - 1}]]
+	    set idx [string first $whole $line1]
+	    set line1 [string replace $line1 0 [expr {$idx + [string length $whole] - 1}]]
         }
+
+	set line1 $line
+        # Search: [ ::trans::trans "translation key"
+        while {[regexp -- $trans_regexp1 $line1 whole _lang key] || \
+		    [regexp -- $trans_regexp2 $line1 whole _lang key] || \
+		    [regexp -- $trans_regexp3 $line1 whole _lang key]} {
+	    if {$key != ""} {
+		if {![info exists tkeyHash($filename)]} {
+		    # Create a new list (with the current key) for this file
+		    set tkeyHash($filename) [list $key]
+		} elseif {[lsearch -exact $tkeyHash($filename) $key]<0} {
+		    # key doesn't exist for this file
+		    lappend tkeyHash($filename) $key
+		}
+	    }
+	    set idx [string first $whole $line1]
+	    set line1 [string replace $line1 0 [expr {$idx + [string length $whole] - 1}]]
+        }
     }
     close $fd
 }
 
-# Remove duplicated keys (through all files)
-set fileList [array names keyHash]
-for {set i 0} {$i < [llength $fileList]} {incr i} {
-    for {set j [expr $i + 1]} {$j < [llength $fileList]} {incr j} {
-        foreach k $keyHash([lindex $fileList $i]) {
-            set J [lindex $fileList $j]
-            set ix [lsearch -exact $keyHash($J) $k]
-            if {-1 < $ix} {
-                set keyHash($J) [lreplace $keyHash($J) $ix $ix]
-            }
-        }
+proc remove_duplicate_keys {hashname} {
+    upvar 1 $hashname hash
+
+    set fileList [array names hash]
+    for {set i 0} {$i < [llength $fileList]} {incr i} {
+	for {set j [expr $i + 1]} {$j < [llength $fileList]} {incr j} {
+	    foreach k $hash([lindex $fileList $i]) {
+		set J [lindex $fileList $j]
+		set ix [lsearch -exact $hash($J) $k]
+		if {-1 < $ix} {
+		    set hash($J) [lreplace $hash($J) $ix $ix]
+		}
+	    }
+	}
     }
 }
 
-if {0 != [string compare "" $translationFile] && [file exists $translationFile]} {
+# Remove duplicated keys (through all files)
+remove_duplicate_keys mkeyHash
+remove_duplicate_keys tkeyHash
+
+proc read_translation_file {filename regexp} {
     # Read translation file
-    set fd [open $translationFile]
+    set fd [open $filename]
     set translated [list]
 
-    while {-1 < [gets $fd line]} {
-        # Search: ::msgcat::mcset lang "translation key"
-        if {[regexp -- {::msgcat::mcset [a-zA-Z]+[ \t\r\n]+\"(([^\"]|\\\")*)\"} $line whole key]} {
-            lappend translated $key
-        }
+    while {[gets $fd line] >= 0} {
+	if {[regexp -- $regexp $line whole key]} {
+	    lappend translated $key
+	}
     }
     close $fd
 
-    if {false == $invertMatch} {
+    return $translated
+}
+
+proc print_all_results {hashname prefix lang} {
+    upvar 1 $hashname hash
+
+    foreach f [array names hash] {
+	if {[llength $hash($f)] > 0} {
+	    puts "# $f"
+	    foreach k [lsort $hash($f)] {
+                puts "$prefix $lang \"$k\""
+	    }
+	    puts ""
+	}
+    }
+}
+
+if {$trans} {
+    upvar 0 tkeyHash hash
+    set regexp $trans_regexp0
+    set prefix ::trans::trset
+} else {
+    upvar 0 mkeyHash hash
+    set regexp $msgcat_regexp0
+    set prefix ::msgcat::mcset
+}
+
+if {$translationFile != "" && [file readable $translationFile]} {
+
+    set translated [read_translation_file $translationFile $regexp]
+
+    if {!$invertMatch} {
         # Display untranslated keys
-        foreach f [array names keyHash] {
-            set displayFileName true
-            foreach k $keyHash($f) {
-                if {-1 == [lsearch -exact $translated $k] } {
-                    if {true == $displayFileName} {
-                        set displayFileName false
+        foreach f [array names hash] {
+            set displayFileName 1
+            foreach k [lsort $hash($f)] {
+                if {[lsearch -exact $translated $k] < 0} {
+                    if {$displayFileName} {
+                        set displayFileName 0
                         puts "# $f"
                     }
                     puts "::msgcat::mcset $lang \"$k\""
                 }
             }
-            if {false == $displayFileName} {
+            if {!$displayFileName} {
                 puts ""
             }
         }
     } else {
         # Remove useless keys
-        foreach t $translated {
-            set found false
-            foreach f [array names keyHash] {
-                if {-1 < [lsearch -exact $keyHash($f) $t] } {
-                    set found true
+        foreach t [lsort $translated] {
+            set found 0
+            foreach f [array names hash] {
+                if {[lsearch -exact $hash($f) $t] >= 0} {
+                    set found 1
                 }
             }
-            if {false == $found} {
+            if {!$found} {
                 puts "\"$t\""
             }
         }
     }
 } else {
-    if {false == $invertMatch} {
+    if {!$invertMatch} {
 	# Print result
-	foreach f [array names keyHash] {
-	    if {0 < [llength $keyHash($f)]} {
-		puts "# $f"
-		foreach k $keyHash($f) {
-                    puts "::msgcat::mcset $lang \"$k\""
-		}
-		puts ""
-	    }
-	}
+	print_all_results hash $prefix $lang
     }
 }

Modified: trunk/tkabber/muc.tcl
===================================================================
--- trunk/tkabber/muc.tcl	2006-11-23 16:59:50 UTC (rev 798)
+++ trunk/tkabber/muc.tcl	2006-11-23 19:17:10 UTC (rev 799)
@@ -1517,7 +1517,8 @@
 }
 
 hook::add postload_hook \
-    [list disco::register_node $::NS(muc#rooms) muc::disco_reply "Current rooms"]
+    [list disco::register_node $::NS(muc#rooms) muc::disco_reply \
+	  [::trans::trans "Current rooms"]]
 
 ###############################################################################
 

Modified: trunk/tkabber/plugins/general/remote.tcl
===================================================================
--- trunk/tkabber/plugins/general/remote.tcl	2006-11-23 16:59:50 UTC (rev 798)
+++ trunk/tkabber/plugins/general/remote.tcl	2006-11-23 19:17:10 UTC (rev 799)
@@ -132,7 +132,7 @@
 
 ::disco::register_feature $::NS(commands)
 ::disco::register_node $::NS(commands) \
-		       ::remote::commands_list_handler "Remote control"
+    ::remote::commands_list_handler [::trans::trans "Remote control"]
 
 #######################################
 # Base engine.
@@ -353,10 +353,11 @@
 namespace eval ::remote::change_status {}
 
 proc ::remote::change_status::scheduler {session action children} {
-    return [::remote::standart_scheduler 1 "[namespace current]::" $session $action $children]
+    return [::remote::standart_scheduler 1 "[namespace current]::" \
+					 $session $action $children]
 }
 ::remote::register_command "http://jabber.org/protocol/rc#set-status" \
-			   ::remote::change_status::scheduler "Change status"
+    ::remote::change_status::scheduler [::trans::trans "Change status"]
 
 # step1:
 # send standart form
@@ -382,13 +383,14 @@
 				     status message"]]
 
     set options {}
-    foreach {status statusdesc} {available   "Available"
-				 chat        "Free to chat"
-				 away        "Away"
-				 xa          "Extended away"
-				 dnd         "Do not disturb"
-				 unavailable "Unavailable"} {
-	lappend options [list $status [::trans::trans $lang $statusdesc]]
+    foreach {status statusdesc} \
+	    [list available   [::trans::trans $lang "Available"]      \
+		  chat        [::trans::trans $lang "Free to chat"]   \
+		  away        [::trans::trans $lang "Away"]           \
+		  xa          [::trans::trans $lang "Extended away"]  \
+		  dnd         [::trans::trans $lang "Do not disturb"] \
+		  unavailable [::trans::trans $lang "Unavailable"]] {
+	lappend options [list $status $statusdesc]
     }
     lappend fields [data::createfieldtag list-single \
 			-var status \
@@ -478,7 +480,7 @@
     return [::remote::standart_scheduler 1 "[namespace current]::" $session $action $children]
 }
 ::remote::register_command "http://jabber.org/protocol/rc#leave-groupchats" \
-			   ::remote::leave_groupchats::scheduler "Leave groupchats"
+    ::remote::leave_groupchats::scheduler [::trans::trans "Leave groupchats"]
 
 # step1:
 # allow users to choose which chats to leave
@@ -497,7 +499,8 @@
 
 	set nick [get_our_groupchat_nick $chatid]
 
-	lappend options [list $jid [format "%s at %s" $nick $jid]]
+	lappend options [list $jid [format [::trans::trans $lang "%s at %s"] \
+					   $nick $jid]]
     }
     if {[expr [llength $options] == 0]} {
 	return [list completed [jlib::wrapper:createtag note \
@@ -612,7 +615,7 @@
     return [::remote::standart_scheduler 1 "[namespace current]::" $session $action $children]
 }
 ::remote::register_command "http://jabber.org/protocol/rc#forward" \
-			   ::remote::forward::scheduler "Forward unread messages"
+    ::remote::forward::scheduler [::trans::trans "Forward unread messages"]
 
 # step1:
 # form with list of unreaded correspondence
@@ -639,11 +642,15 @@
 
 	set count [llength $unread($id)]
 
-	lappend options \
-		[list $id \
-		      [format \
-			   [::trans::trans $lang "%s: %s $type message(s)"] \
-			   $name $count]]
+	switch -- $type {
+	    chat      { set msg [::trans::trans $lang "%s: %s chat message(s)"] }
+	    groupchat { set msg [::trans::trans $lang "%s: %s groupchat message(s)"] }
+	    headline  { set msg [::trans::trans $lang "%s: %s headline message(s)"] }
+	    normal    { set msg [::trans::trans $lang "%s: %s normal message(s)"] }
+	    default   { set msg [::trans::trans $lang "%s: %s unknown message(s)"] }
+	}
+
+	lappend options [list $id [format $msg $name $count]]
     }
     if {[expr [llength $options] == 0]} {
 	return [list completed [jlib::wrapper:createtag note \

Modified: trunk/tkabber/trans.tcl
===================================================================
--- trunk/tkabber/trans.tcl	2006-11-23 16:59:50 UTC (rev 798)
+++ trunk/tkabber/trans.tcl	2006-11-23 19:17:10 UTC (rev 799)
@@ -6,6 +6,7 @@
     array set trans {}
 }
 
+# Load message file. It must be in UTF-8 encoding.
 proc ::trans::loadfile {filepath} {
     set fd [open $filepath "r"]
     fconfigure $fd -encoding utf-8
@@ -13,12 +14,14 @@
     close $fd
 }
 
+# Load all message files in the directory.
 proc ::trans::load {dirpath} {
     foreach filepath [glob -nocomplain -directory $dirpath *.msg] {
 	loadfile $filepath
     }
 }
 
+# Set translated message.
 proc ::trans::trset {lang msgfrom {msgto ""}} {
     variable trans
 
@@ -27,19 +30,35 @@
     }
 }
 
-proc ::trans::trans {lang msg} {
-    variable trans
+# ::trans::trans lang msg
+# ::trans::trans msg
+# Translate message 'msg' to language 'lang'. If there is only one
+# argument (no lang), then return unchanged message.
+proc ::trans::trans {args} {
+    switch -- [llength $args] {
+	1 {
+	    # Dummy call for searching translations in the source.
+	    return [lindex $args 0]
+	}
+	2 {
+	    lassign $args lang msg
+	    variable trans
 
-    set langlist [split [string tolower $lang] -]
-    set shortlang [lindex $langlist 0]
-    set longlang [join $langlist _]
+	    set langlist [split [string tolower $lang] -]
+	    set shortlang [lindex $langlist 0]
+	    set longlang [join $langlist _]
 
-    if {[info exists trans($longlang,$msg)]} {
-	return $trans($longlang,$msg)
-    } elseif {[info exists trans($shortlang,$msg)]} {
-	return $trans($shortlang,$msg)
-    } else {
-	return $msg
+	    if {[info exists trans($longlang,$msg)]} {
+		return $trans($longlang,$msg)
+	    } elseif {[info exists trans($shortlang,$msg)]} {
+		return $trans($shortlang,$msg)
+	    } else {
+		return $msg
+	    }
+	}
+	default {
+	    return -code error "::trans::trans: Too many arguments"
+	}
     }
 }
 



More information about the Tkabber-dev mailing list