- msgcat::msmsetto, to define messages translations in a specified folder.
- msgcat::oomc, to get message inside a method.
package require TclOO
package require msgcat
namespace eval ::msgcat {
namespace export mcmsetto oomc
}
# This procedure returns the class hierarchy of an object.
proc ::msgcat::OOTraversal {class {lvar ""}} {
if {$lvar ne ""} {
upvar 1 $lvar l
}
lappend l $class
foreach parent [info class superclasses $class] {
if {$parent ne "::oo::object" && $parent ni $l} {
OOTraversal $parent l
}
}
return $l
}
# mcmsetto is like mcmset, but with a specified folder instead
# of caller namespace.
# This allow defining messages associated to a class.
proc ::msgcat::mcmsetto {folder locale pairs} {
variable Msgs
if {![string match "::*" $folder]} {
# Relative to current namespace
set ns [uplevel 1 {namespace current}]
if {$ns eq "::"} {
set folder "::$folder"
} else {
set folder "${ns}::$folder"
}
}
set length [llength $pairs]
if {$length % 2} {
return -code error "bad translation list:\
should be \"[lindex [info level 0] 0] folder locale {src dest ...}\""
}
set locale [string tolower $locale]
foreach {src dest} $pairs {
dict set Msgs $folder $locale $src $dest
}
return [expr {$length / 2}]
}
# Copy of msgcat::mc, but search in class hierarchy,
# then class namespace hierarchy.
proc ::msgcat::oomc {src args} {
variable Msgs
variable Loclist
# Get object class hierarchy
set obj [uplevel 1 self]
if {[info object isa class $obj]} {
set class $obj
} else {
set class [info object class $obj]
}
set folders [OOTraversal $class]
# Add namespace hierarchy
set ns [regsub {::[^:]*$} $class ""]
if {$ns eq ""} {set ns "::"}
while {$ns ne ""} {
lappend folders $ns
set ns [namespace parent $ns]
}
foreach ns $folders {
foreach loc $Loclist {
if {[dict exists $Msgs $ns $loc $src]} {
if {[llength $args] == 0} {
return [dict get $Msgs $ns $loc $src]
} else {
return [format [dict get $Msgs $ns $loc $src] {*}$args]
}
}
}
}
# we have not found the translation
return [uplevel 1 [list ::msgcat::mcunknown \
"" $src {*}$args]]
}
Older implementation for msgcat < 1.6 (mcmsetto and oomc only):# mcmsetto is like mcmset, but with a specified folder instead
# of caller namespace.
# This allow defining messages associated to a class.
proc ::msgcat::mcmsetto {folder locale pairs} {
variable Msgs
if {![string match "::*" $folder]} {
# Relative to current namespace
set ns [uplevel 1 {namespace current}]
if {$ns eq "::"} {
set folder "::$folder"
} else {
set folder "${ns}::$folder"
}
}
set length [llength $pairs]
if {$length % 2} {
return -code error "bad translation list:\
should be \"[lindex [info level 0] 0] folder locale {src dest ...}\""
}
set locale [string tolower $locale]
foreach {src dest} $pairs {
dict set Msgs $locale $folder $src $dest
}
return [expr {$length / 2}]
}
# Copy of msgcat::mc, but search in class hierarchy,
# then class namespace hierarchy.
proc ::msgcat::oomc {src args} {
variable Msgs
variable Loclist
variable Locale
# Get object class hierarchy
set obj [uplevel 1 self]
if {[info object isa class $obj]} {
set class $obj
} else {
set class [info object class $obj]
}
set folders [OOTraversal $class]
# Add namespace hierarchy
set ns [regsub {::[^:]*$} $class ""]
if {$ns eq ""} {set ns "::"}
while {$ns ne ""} {
lappend folders $ns
set ns [namespace parent $ns]
}
foreach ns $folders {
foreach loc $Loclist {
if {[dict exists $Msgs $loc $ns $src]} {
if {[llength $args] == 0} {
return [dict get $Msgs $loc $ns $src]
} else {
return [format [dict get $Msgs $loc $ns $src] {*}$args]
}
}
}
}
# we have not found the translation
return [uplevel 1 [list ::msgcat::mcunknown \
$Locale $src {*}$args]]
}
Here is a simple package:namespace import ::msgcat::*
namespace eval MyPkg {
# Base class Alpha
oo::class create Alpha {
method testFooMsg {} {
oomc FooMsg
}
method testBarMsg {} {
oomc BarMsg
}
}
# Derived class Beta
oo::class create Beta {
superclass Alpha
}
# Another class Gamma
oo::class create Gamma {
method testFooMsg {} {
oomc FooMsg
}
method testBarMsg {} {
oomc BarMsg
}
}
}The messages can be defined in another file (a .msg file), without needing the class to be defined.namespace eval MyPkg {
mcmset {} {
FooMsg "this is my package foo msg"
}
mcmsetto Alpha {} {
FooMsg "this is the alpha foo msg"
BarMsg "this is the alpha bar msg"
}
mcmsetto Beta {} {
FooMsg "this is the beta foo msg"
}
}And the result:set a [MyPkg::Alpha new] set b [MyPkg::Beta new] set g [MyPkg::Gamma new] $a testFooMsg => this is the alpha foo msg $a testBarMsg => this is the alpha bar msg $b testFooMsg => this is the beta foo msg $b testBarMsg => this is the alpha bar msg $g testFooMsg => this is my package foo msg $g testBarMsg => BarMsg
DKF: It seems to me like we don't need all that much code to make this work:
namespace eval ::msgcat {
oo::class create MessageCatalogAware {
forward mc ::msgcat::OOBridge ::msgcat::mc
forward mcmax ::msgcat::OOBridge ::msgcat::mcmax
forward mcexists ::msgcat::OOBridge ::msgcat::mcexists
# Tricky point: methods are not usefully callable from outside the class hierarchy
unexport mc mcmax mcexists
}
proc OOBridge {cmd args} {
if {[catch {
# Tricky point: [self class] needs to run in the caller
set ns [namespace qualifiers [uplevel 1 {self class}]]
}]} {
# Not a class-defined method (so we got an error); use instance instead
set ns [namespace qualifiers [uplevel 1 self]]
}
tailcall apply [list {cmd args} {tailcall $cmd {*}$args} $ns] $cmd
}
}(Note that the tricky bits are self class and a tailcall/apply/tailcall chain.)(Random user: I am loathe to change this without testing, but surely it should be tailcall apply [list {cmd args} {tailcall $cmd {*}$args} $ns] $cmd {*}$args?)Then I'd just do something like this while using all the usual mechanisms for setting up the message catalog, with derived classes in their own package using their own catalogs for the methods they define:namespace eval MyPkg {
# Base class Alpha
oo::class create Alpha {
mixin ::msgcat::MessageCatalogAware
method testFooMsg {} {
my mc FooMsg
}
method testBarMsg {} {
my mc BarMsg
}
}
# Derived class Beta
oo::class create Beta {
superclass Alpha
}
}