[Eric Boudaillier], 2014-02-06: While [msgcat] is designed to work with namespace, the following code allows using [msgcat] in conjunction with [TclOO]. The code is based on msgcat, and adds two new commands: * `msgcat::msmsetto`, to define messages translations in a specified ''folder''. * `msgcat::oomc`, to get message inside a method. [Eric Boudaillier], 2017-12-08: Code updated to work with msgcat >= 1.6. See below for older code. ====== 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 } } ====== <>msgcat | TclOO