Tk and msgcat

The purpose of this page is to illustrate the use of the msgcat package to make a Tk software internationalized automatically. The recommended usage of the msgcat package to translate messages is to insert msgcat::mc instructions like this:

Instead of

 label .x -text Files

you write

 label .x -text [msgcat::mc Files]

This forces the developer to insert "msgcat::mc" everywhere into the current Tcl script. Of course, it is well known that the Frink tool can instrument a Tcl script and insert the msgcat::mc automatically. But the resulting script is modified, which may be unwanted (frink).

What should be available is a method to translate automatically the software, without modification of the original script. The only things which should be done are:

  • create the "yourlanguage.msg" catalog,
  • use msgcat and configure it with the desired language.

One can try to overload the Tk widgets to use the msgcat::mc automatically. The following is an example. The first call to "tk_chooseDirectory" is untranslated. Then one creates a translation command inside the "mynamespace" namespace. Then the tk_chooseDirectory is overloaded so that the next use of "tk_chooseDirectory" automatically uses the msgcat::mc command with the provided translation command.

 package require Tcl
 package require Tk
 package require msgcat
 ::msgcat::mclocale fr

 set dirname [tk_chooseDirectory -title "This is an untranslated title"]

 msgcat::mcset fr "This is an untranslated title" "C'est mon titre"
 namespace eval mynamespace {
    proc translate { original } {
        set translated [msgcat::mc $original]
        return $translated
    }
 }

 if {[info commands "::tk_chooseDirectory"]=="::tk_chooseDirectory"} then {
    rename ::tk_chooseDirectory ::_tk_chooseDirectory
    proc ::tk_chooseDirectory {args} {
        set command [list "::_tk_chooseDirectory"]
        foreach {key value} $args {
            if {$key=="-title" || $key=="-message"} then {
                set value [mynamespace::translate $value]
            }
            lappend command $key $value
        }
        set answer [eval $command]
        return $answer
    }
 }
 set dirname [tk_chooseDirectory -title "This is an untranslated title"]

This is interesting, but way too simple to be used in practical applications, mainly because one may want to configure our own translation command. The following is another attempt of what could be done.

 package require tkinternat
 tkinternat::configure -translationcmd "mynamespace::translate"
 tkinternat::overload "tk_chooseDirectory"
 tkinternat::overload "button"
 tkinternat::overload "checkbutton"
 tkinternat::overload "label"
 tkinternat::overload "menu"
 tkinternat::overload "menubutton"
 tkinternat::overload "labelframe"
 tkinternat::overload "message"
 tkinternat::overload "radiobutton"

This would allow to use the command "mynamespace::translate" and, after overloading the Tk widgets, the code can be used translated without modification. Here is the complete example :

 package require Tcl
 package require Tk
 package require msgcat
 msgcat::mclocale fr

 set dirname [tk_chooseDirectory -title "This is an untranslated title"]

 namespace eval mynamespace {
    msgcat::mcset fr "This is an untranslated title" "C'est mon titre"
    msgcat::mcset fr "Language" "Langue"
    msgcat::mcset fr "English" "Anglais"
    msgcat::mcset fr "File" "Fichier"
    proc translate { original } {
        set translated [msgcat::mc $original]
        return $translated
    }
 }

 lappend ::auto_path .
 package require tkinternat
 tkinternat::configure -translationcmd "mynamespace::translate"
 tkinternat::overload "tk_chooseDirectory"
 tkinternat::overload "button"
 tkinternat::overload "checkbutton"
 tkinternat::overload "label"
 tkinternat::overload "menu"
 tkinternat::overload "menubutton"
 tkinternat::overload "labelframe"
 tkinternat::overload "message"
 tkinternat::overload "radiobutton"
 set dirname [tk_chooseDirectory -title "This is an untranslated title"]
 pack [button .mybutton -text "This is an untranslated title"]
 pack [checkbutton .mycheckbutton -text "This is an untranslated title"]
 pack [label .mylabel -text "This is an untranslated title"]
 pack [labelframe .mylabelframe -text "This is an untranslated title"]
 pack [entry .mylabelframe.myentry]

 . configure -menu [menu .m -title "This is an untranslated title"]
 menu .m.m2 -tearoff 1
 # "add" is not overloaded
 .m add cascade -label "Language" -menu .m.m2
 foreach language {English French German} {
    .m.m2 add command -label $language
 }
 # Test menubutton
 frame .myframeBis
 pack .myframeBis -side top -fill x -pady 0
 menubutton .myframeBis.file   -text "File"   -menu .myframeBis.file.menu    -underline 0
 menu .myframeBis.file.menu   -tearoff false
 pack .myframeBis.file -side left 

 pack [message .mymessage -text "This is an untranslated title"]
 pack [radiobutton .myradiobutton -text "This is an untranslated title"]

 wm title . "Test"

The application is based on the package "tkinternat" which is the following. It is made with low-level Tcl, but it works !

 package provide tkinternat 1.0

 namespace eval tkinternat {
    variable _translatecmd ""   
 }
 proc tkinternat::configure { args } {
    foreach { key value } $args {
        switch -- $key {
            "-translationcmd" {
                set tkinternat::_translatecmd $value
            }
            default {
                error "Unknown option $key."
            }
        }
    }
    return ""
 }
 proc tkinternat::cget { key } {
    switch -- $key {
        "-translationcmd" {
            set value $tkinternat::_translatecmd
        }
        default {
            error "Unknown option $key."
        }
    }
    return $value
 }
 proc tkinternat::overload { tkwidget } {
    switch -- $tkwidget {
        "tk_getOpenFile" -
        "tk_getSaveFile" -
        "tk_chooseColor" -
        "tk_messageBox" -
        "tk_chooseDirectory" {
            if {[info commands "::$tkwidget"]=="::$tkwidget"} then {
                rename ::$tkwidget ::_$tkwidget
                set script "proc ::$tkwidget { args } { \n"
                append script "set command \[list ::_$tkwidget\]\n"
                append script "foreach {key value} \$args {\n"
                append script "if {\$key==\"-title\" || \$key==\"-message\" || \$key==\"-text\"} then {\n"
                append script "set translatecmd \[tkinternat::cget -translationcmd\]\n"
                append script "set value \[eval \[list \$translatecmd \$value\]\]\n"
                append script "}\n"
                append script "lappend command \$key \$value\n"
                append script "}\n"
                append script "set answer \[eval \$command\]\n"
                append script "return \$answer\n"
                append script "}"
                eval $script
            }
        }
        "button" -
        "checkbutton" -
        "menu" -
        "menubutton" -
        "message" -
        "radiobutton" -
        "label" -
        "labelframe" {
            if {[info commands "::$tkwidget"]=="::$tkwidget"} then {
                rename ::$tkwidget ::_$tkwidget
                set script "proc ::$tkwidget { pathname args } { \n"
                append script "set command \[list ::_$tkwidget \$pathname\]\n"
                append script "foreach {key value} \$args {\n"
                append script "if {\$key==\"-title\" || \$key==\"-text\" || \$key==\"-label\"} then {\n"
                append script "set translatecmd \[tkinternat::cget -translationcmd\]\n"
                append script "set value \[eval \[list \$translatecmd \$value\]\]\n"
                append script "}\n"
                append script "lappend command \$key \$value\n"
                append script "}\n"
                append script "puts \"command : \$command\"\n"
                append script "set answer \[eval \$command\]\n"
                append script "return \$answer\n"
                append script "}"
                eval $script
            }
        }
        default {
            error "Unknown tkwidget $tkwidget"
        }
    }
 }

See also: