Internationalization and the Tcl C APIs

The current state can be found at [1 ].

Proposal

The msgcat package provides internationalization on the script level. This functionality is currently missing on the C-function side. A function with the following signature can implement these feature:

 const char *Tcl_Msg(Tcl_Interp *interp, Tcl_Obj *ns, const char *text);

Please comment on Multi thread applications?

Usage example in an C-Extension (p.e. 'Ext1' in namespace 'ext1')

 Tcl_Interp *myInterp; /* used interpreter */
 Tcl_Obj *myNs; /* used namespace, also name of array variable to hold translation strings */
 #define EXT1_MSG(text) Tcl_Msg(myInterp,myNs,text)
 int Ext1_Init(Tcl_Interp *interp) {
   ...
   myInterp = interp;
   myNs = Tcl_GetStringObj("::ext1",-1);
 }
 void Ext1_command() {
   printf(EXT1_MSG("some dummy text at line %d",__LINE__);
 }

To find all translation strings of extension 'Ext1' the following procedure can be used.

proc findstrings {function cfiles} {
   set regex $function
   append regex {[ \t]*\([ \t]*("(?:\\"|[^"])[ \t]*)}
   foreach f $cfiles {
     set fd [open $f r]
     set c [read $fd]
     close $fd
     foreach {x text} [regexp -all -inline $regex $c] {puts $text}
   }
 }
 findstrings EXT1_MSG [glob *.c]

Implementation 1

This implementation is very fast. The downside is the necessary step to convert the used dictionary to an array. Because access to nested dictionaries is not (yet?) exposed the used dictionary is converted in an array variable. This is done by the new 'msgcat::ns' function. The function should be called after setting the locale (can be done with a trace on msgcat::Loclist) and after setting the translation strings.

proc ::msgcat::ns {ns src} {
  variable Msgs
  variable Loclist

  if {[string range $ns 0 1] ne {::}} {set ns ::$ns}
  namespace eval $ns {}
  catch {unset $ns}
  array set $ns {}
  foreach loc $Loclist {
    if {[dict exists $Msgs $loc $ns]} {
      dict for {key value} [dict get $Msgs $loc $ns] {
        if {![info exists $ns($key)]} {set $ns($key) $value}
      }
    }
  }
}

C-function to get a translated string.

const char *Tcl_Msg(Tcl_Interp *interp, Tcl_Obj *ns, const char *text) {
  static Tcl_Obj *textPtr=NULL;
  Tcl_Obj *varObj;

  if (textPtr==NULL) {
    textPtr = Tcl_StringObj("",-1);
  }
  Tcl_SetStringObj(textPtr,text,-1)
  varObj = Tcl_ObjGetVar2(interp, ns, textPtr, TCL_GLOBAL_ONLY);
  if (varObj == NULL) {
    return (text);
  } else {
    return (Tcl_GetString(varObj));
  }
}

Implementation 2

This implementation is not so fast because of the necessary search in the dictionary.

const char *Tcl_Msg(Tcl_Interp *interp, Tcl_Obj *ns, const char *text) {
  static Tcl_Obj *msgsPtr=NULL;
  static Tcl_Obj *loclistPtr=NULL;
  static Tcl_Obj *textPtr=NULL;
  Tcl_Obj *listPtr;
  Tcl_Obj **listPtrPtr;
  Tcl_Obj *dictMsgsPtr;
  Tcl_Obj *dictLocPtr;
  Tcl_Obj *dictNsPtr;
  Tcl_Obj *valuePtr;
  int length;
  int i;
  /* Initialization of used variable names. */
  if (msgsPtr == NULL) {
    msgsPtr    = Tcl_NewStringObj("::msgcat::Msgs",-1);
    loclistPtr = Tcl_NewStringObj("::msgcat::Loclist",-1);
    textPtr    = Tcl_NewStringObj("",-1);
  }
  /* Get used variables */
  dictMsgsPtr = Tcl_ObjGetVar2(interp,msgsPtr,NULL,TCL_GLOBAL_ONLY);
  if (dictMsgsPtr == NULL) {
    return (text);
  }
  listPtr = Tcl_ObjGetVar2(interp,loclistPtr,NULL,TCL_GLOBAL_ONLY);
  if (listPtr == NULL) {
    return (text);
  }
  if (Tcl_ListObjGetElements(NULL, listPtr, &length, &listPtrPtr) != TCL_OK) {
    return (text);
  }
  /* Try to get values from Msgs dictionary */
  Tcl_SetStringObj(textPtr,text,-1);
  for (i=0; i<length; i++) {
    if (Tcl_DictObjGet(NULL,dictMsgsPtr,listPtrPtr[i],&dictLocPtr)==TCL_OK && dictLocPtr != NULL) {
      if (Tcl_DictObjGet(NULL,dictLocPtr,ns,&dictNsPtr)==TCL_OK && dictNsPtr != NULL) {
        if (Tcl_DictObjGet(NULL,dictNsPtr,textPtr,&valuePtr)==TCL_OK && valuePtr != NULL) {
          return (Tcl_GetString(valuePtr));
        }
      }
    }
  }
  return (text);
}