tip#404 file locale mcset: mc(fl)(m)set

5 files changed, 161 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index 68f2441..036cd21 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2012-09-07  Harald Oehlmann  <oehhar@users.sf.net>
+
+	IMPLEMENTATION OF TIP#404.
+
+	* library/msgcat.tcl: [FRQ 3544988]: add commands
+	[mcflset] and [mcflmset] to set mc entries with implicit message file
+	locale. Package version is now 1.5.0.
+
 2012-08-25  Donal K. Fellows  <dkf@users.sf.net>
 
 	* library/msgs/uk.msg: [Bug 3561330]: Use the correct full name of
@@ -186,7 +194,7 @@
 
 	* library/msgcat/msgcat.tcl:   Add tn, ro_MO and ru_MO to msgcat.
 
-2012-06-29  Harald Oehlmann <harald.oehlmann@elmicron.de>
+2012-06-29  Harald Oehlmann <oehhar@users.sf.net>
 
 	* library/msgcat/msgcat.tcl:	[Bug 3536888]: Locale guessing of
 	* library/msgcat/pkgIndex.tcl:	msgcat fails on (some) Windows 7. Bump
diff --git a/doc/msgcat.n b/doc/msgcat.n
index 595c85f..af6be7f 100644
--- a/doc/msgcat.n
+++ b/doc/msgcat.n
@@ -13,7 +13,7 @@ msgcat \- Tcl message catalog
 .SH SYNOPSIS
 \fBpackage require Tcl 8.5\fR
 .sp
-\fBpackage require msgcat 1.4.5\fR
+\fBpackage require msgcat 1.5.0\fR
 .sp
 \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
 .sp
@@ -29,6 +29,12 @@ msgcat \- Tcl message catalog
 .sp
 \fB::msgcat::mcmset \fIlocale src-trans-list\fR
 .sp
+.VS "TIP 404"
+\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
+.sp
+\fB::msgcat::mcflmset \fIsrc-trans-list\fR
+.VE "TIP 404"
+.sp
 \fB::msgcat::mcunknown \fIlocale src-string\fR
 .BE
 .SH DESCRIPTION
@@ -131,6 +137,26 @@ translate-string ...\fR?} \fB::msgcat::mcmset\fR can be significantly
 faster than multiple invocations of \fB::msgcat::mcset\fR. The function
 returns the number of translations set.
 .TP
+\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
+.VS "TIP 404"
+Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the
+current namespace for the locale implied by the name of the message catalog
+being loaded via \fB::msgcat::mcload\fR.  If \fItranslate-string\fR is not
+specified, \fIsrc-string\fR is used for both.  The function returns
+\fItranslate-string\fR.
+.VE "TIP 404"
+.TP
+\fB::msgcat::mcflmset \fIsrc-trans-list\fR
+.VS "TIP 404"
+Sets the translation for multiple source strings in \fIsrc-trans-list\fR in
+the current namespace for the locale implied by the name of the message
+catalog being loaded via \fB::msgcat::mcload\fR. \fIsrc-trans-list\fR must
+have an even number of elements and is in the form {\fIsrc-string
+translate-string\fR ?\fIsrc-string translate-string ...\fR?}
+\fB::msgcat::mcflmset\fR can be significantly faster than multiple invocations
+of \fB::msgcat::mcflset\fR. The function returns the number of translations set.
+.VE "TIP 404"
+.TP
 \fB::msgcat::mcunknown \fIlocale src-string\fR
 .
 This routine is called by \fB::msgcat::mc\fR in the case when
@@ -286,15 +312,15 @@ cause peculiar behavior, such as marking the message file as
 .QW hidden
 on Unix file systems.
 .IP [3]
-The file contains a series of calls to \fBmcset\fR and
-\fBmcmset\fR, setting the necessary translation strings
+The file contains a series of calls to \fBmcflset\fR and
+\fBmcflmset\fR, setting the necessary translation strings
 for the language, likely enclosed in a \fBnamespace eval\fR
 so that all source strings are tied to the namespace of
 the package. For example, a short \fBes.msg\fR might contain:
 .PP
 .CS
 namespace eval ::mypackage {
-    \fB::msgcat::mcset\fR es "Free Beer!" "Cerveza Gracias!"
+    \fB::msgcat::mcflset\fR "Free Beer!" "Cerveza Gracias!"
 }
 .CE
 .SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES"
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 3377b47..112507a 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -13,11 +13,11 @@
 package require Tcl 8.5
 # When the version number changes, be sure to update the pkgIndex.tcl file,
 # and the installation directory in the Makefiles.
-package provide msgcat 1.4.5
+package provide msgcat 1.5.0
 
 namespace eval msgcat {
     namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
-	    mcunknown
+	    mcunknown mcflset mcflmset
 
     # Records the current locale as passed to mclocale
     variable Locale ""
@@ -25,6 +25,9 @@ namespace eval msgcat {
     # Records the list of locales to search
     variable Loclist {}
 
+    # Records the locale of the currently sourced message catalogue file
+    variable FileLocale
+
     # Records the mapping between source strings and translated strings.  The
     # dict key is of the form "<locale> <namespace> <src>", where locale and
     # namespace should be themselves dict values and the value is
@@ -277,6 +280,11 @@ proc msgcat::mcpreferences {} {
 #	Returns the number of message catalogs that were loaded.
 
 proc msgcat::mcload {langdir} {
+    variable FileLocale
+    # Save the file locale if we are recursively called
+    if {[info exists FileLocale]} {
+	set nestedFileLocale $FileLocale
+    }
     set x 0
     foreach p [mcpreferences] {
 	if { $p eq {} } {
@@ -285,9 +293,17 @@ proc msgcat::mcload {langdir} {
 	set langfile [file join $langdir $p.msg]
 	if {[file exists $langfile]} {
 	    incr x
+	    set FileLocale [string tolower [file tail [file rootname $langfile]]]
+	    if {"root" eq $FileLocale} {
+		set FileLocale ""
+	    }
 	    uplevel 1 [list ::source -encoding utf-8 $langfile]
+	    unset FileLocale
 	}
     }
+    if {[info exists nestedFileLocale]} {
+	set FileLocale $nestedFileLocale
+    }
     return $x
 }
 
@@ -318,6 +334,35 @@ proc msgcat::mcset {locale src {dest ""}} {
     return $dest
 }
 
+# msgcat::mcflset --
+#
+#	Set the translation for a given string in the current file locale.
+#
+# Arguments:
+#	src		The source string.
+#	dest		(Optional) The translated string.  If omitted,
+#			the source string is used.
+#
+# Results:
+#	Returns the new locale.
+
+proc msgcat::mcflset {src {dest ""}} {
+    variable FileLocale
+    variable Msgs
+
+    if {![info exists FileLocale]} {
+	return -code error \
+	    "must only be used inside a message catalog loaded with ::msgcat::mcload"
+    }
+    if {[llength [info level 0]] == 2} { ;# dest not specified
+	set dest $src
+    }
+
+    set ns [uplevel 1 [list ::namespace current]]
+    dict set Msgs $FileLocale $ns $src $dest
+    return $dest
+}
+
 # msgcat::mcmset --
 #
 #	Set the translation for multiple strings in a specified locale.
@@ -345,7 +390,38 @@ proc msgcat::mcmset {locale pairs } {
 	dict set Msgs $locale $ns $src $dest
     }
 
-    return $length
+    return [expr {$length / 2}]
+}
+
+# msgcat::mcflmset --
+#
+#	Set the translation for multiple strings in the mc file locale.
+#
+# Arguments:
+#	pairs		One or more src/dest pairs (must be even length)
+#
+# Results:
+#	Returns the number of pairs processed
+
+proc msgcat::mcflmset {pairs} {
+    variable FileLocale
+    variable Msgs
+
+    if {![info exists FileLocale]} {
+	return -code error \
+	    "must only be used inside a message catalog loaded with ::msgcat::mcload"
+    }
+    set length [llength $pairs]
+    if {$length % 2} {
+	return -code error "bad translation list:\
+		should be \"[lindex [info level 0] 0] locale {src dest ...}\""
+    }
+
+    set ns [uplevel 1 [list ::namespace current]]
+    foreach {src dest} $pairs {
+	dict set Msgs $FileLocale $ns $src $dest
+    }
+    return [expr {$length / 2}]
 }
 
 # msgcat::mcunknown --
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 60c2d3c..832bf81 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
 if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded msgcat 1.4.5 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.5.0 [list source [file join $dir msgcat.tcl]]
diff --git a/tests/msgcat.test b/tests/msgcat.test
index bbcd023..d75bf8e 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -17,8 +17,8 @@ if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
     return
 }
-if {[catch {package require msgcat 1.4.5}]} {
-    puts stderr "Skipping tests in [info script].  No msgcat 1.4.5 found to test."
+if {[catch {package require msgcat 1.5.0}]} {
+    puts stderr "Skipping tests in [info script].  No msgcat 1.5.0 found to test."
     return
 }
 
@@ -611,6 +611,46 @@ namespace eval ::msgcat::test {
 	mc "this is a %s" "good test"
     } -result "this is a good test"
 
+    # Tests msgcat-8.*: [mcflset]
+
+    set msgdir1 [makeDirectory msgdir1]
+    makeFile {::msgcat::mcflset k1 v1} l1.msg $msgdir1
+
+	test msgcat-8.1 {mcflset} -setup {
+	    variable locale [mclocale]
+	    mclocale l1
+	    mcload $msgdir1
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    mc k1
+	} -result v1
+
+    removeFile l1.msg $msgdir1
+    removeDirectory msgdir1
+
+    set msgdir2 [makeDirectory msgdir2]
+    set msgdir3 [makeDirectory msgdir3]
+    makeFile "::msgcat::mcflset k2 v2 ; ::msgcat::mcload [list $msgdir3]"\
+	    l2.msg $msgdir2
+    makeFile {::msgcat::mcflset k3 v3} l2.msg $msgdir3
+
+	# chained mcload
+	test msgcat-8.2 {mcflset} -setup {
+	    variable locale [mclocale]
+	    mclocale l2
+	    mcload $msgdir2
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    return [mc k2][mc k3]
+	} -result v2v3
+
+    removeFile l2.msg $msgdir2
+    removeDirectory msgdir2
+    removeFile l3.msg $msgdir3
+    removeDirectory msgdir3
+
     cleanupTests
 }
 namespace delete ::msgcat::test