Updated 2009-01-28 20:14:12 by LV ▲

This page was created to publish my C(++) source code to access the C functions around the locale settings from tcl.

The code only contains the two tcl commands functions SetLocaleCMD and SetLangCMD, and not the framework for a DLL or SharedObject, the integration in a shell, or ...!

Here the code:
 // syntax: SetLocaleCMD ?category ?newLocale??
 //
 int SetLocaleCMD( ClientData cd, Tcl_Interp *ip, int argc, Tcl_Obj *CONST argv[] )
 {
     if ( argc > 3 )
     {
         Tcl_WrongNumArgs( ip, 1, argv, "?category ?newLocale??" );
         return TCL_ERROR;
     }

     if ( argc == 1 )
     {
         // simply return the current locale
         //
         Tcl_SetObjResult(
            ip,
            Tcl_NewStringObj(
                setlocale( LC_ALL, 0 ),
                -1
            )
        );
     }
     else if ( argc >= 2 )
     {
         // get or set the current locale of a specified category
         //
         // test the argument - the locale category to be changed
         //
         // !! could have been realized using Tcl_GetIndexFromObj !!
         //
         int     iCategory       = 0;
         char    *pocCategory    = (char *) NULL,
                 *pocLocale      = (char *) NULL;

         pocCategory    = Tcl_GetStringFromObj( argv[1], 0 );

         if ( stricmp( "LC_ALL", pocCategory ) == 0 )
         {
             iCategory   = LC_ALL;
         }
         else if ( stricmp( "LC_COLLATE", pocCategory ) == 0 )
         {
             iCategory   = LC_COLLATE;
         }
         else if ( stricmp( "LC_CTYPE", pocCategory ) == 0 )
         {
             iCategory   = LC_CTYPE;
         }
         else if ( stricmp( "LC_MONETARY", pocCategory ) == 0 )
         {
             iCategory   = LC_MONETARY;
         }
         else if ( stricmp( "LC_NUMERIC", pocCategory ) == 0 )
         {
             iCategory   = LC_NUMERIC;
         }
         else if ( stricmp( "LC_TIME", pocCategory ) == 0 )
         {
             iCategory   = LC_TIME;
         }
         else
         {
             char    pocError[1024]  = "";

             sprintf( pocError, "bad category \"%s\": must be LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC, or LC_TIME", pocCategory );

             Tcl_SetObjResult( ip, Tcl_NewStringObj( pocError, -1 ) );
             return TCL_ERROR;
         }

         if ( argc == 2 )
         {
             // return the locale of the specified category
             //
             Tcl_SetObjResult(
                ip,
                Tcl_NewStringObj(
                    setlocale( iCategory, 0 ),
                    -1
                )
            );
         }
         else
         {
             // change the locale of the specified category
             //
             pocLocale   = Tcl_GetStringFromObj( argv[2], 0 );

             if ( ( pocLocale = setlocale( iCategory, pocLocale ) ) == NULL )
             {
                 char    pocError[1024]  = "";

                 sprintf( pocError, "expected valid locale, but got \"%s\"", Tcl_GetStringFromObj( argv[2], 0 ) );

                 Tcl_SetObjResult( ip, Tcl_NewStringObj( pocError, -1 ) );
                 return TCL_ERROR;
             }

             Tcl_SetObjResult( ip, Tcl_NewStringObj( pocLocale, -1 ) );
         }
     }

     return TCL_OK;
 }

 // syntax: SetLangCMD ?countryCode?
 //
 int SetLangCMD( ClientData cd, Tcl_Interp *ip, int argc, Tcl_Obj *CONST argv[] )
 {
     if ( argc > 2 )
     {
         Tcl_WrongNumArgs( ip, 1, argv, "?countryCode?" );
         return TCL_ERROR;
     }

     char    *pocVarNames[]  = { "LANG", "LC_ALL", "LC_NUMERIC" },
             *pocGetEnv      = (char *) NULL;

     if ( argc == 2 )
     {
         // set the language environment variables to the given country code
         //
         int     iLength         = 0;
         char    *pocValue       = Tcl_GetStringFromObj( argv[1], &iLength ),
                 pocEnv[512+1]   = "";

         for ( int i = 0 ; i < 3 ; ++i )
         {
             memset( pocEnv, 0x0, 512+1 );
             sprintf( pocEnv, "%s=%s", pocVarNames[i], pocValue );

             if ( Tcl_PutEnv( pocEnv ) == TCL_ERROR )
             {
                 char    pocError[1024];

                 sprintf( pocError, "couldn't set the environment variable \"%s\" via Tcl_PutEnv( \"LANG=%s\" ): %s", pocVarNames[i] , pocValue, Tcl_GetStringResult( ip ) );

                 Tcl_SetObjResult( ip, Tcl_NewStringObj( pocError, -1 ) );
                 return TCL_ERROR;
             }
         }

         return TCL_OK;
     }

     // return the country codes inside the language environment variables
     //
     Tcl_Obj *poResult   = (Tcl_Obj *) NULL;

     poResult    = Tcl_NewObj();

     for ( int i = 0 ; i < 3 ; ++i )
     {
         if ( ( pocGetEnv = getenv( pocVarNames[i] ) ) == NULL )
         {
             char    pocError[1024]  = "";

             sprintf( pocError, "couldn't get the environment variable \"%s\" via getenv( \"%s\" )", pocVarNames[i], pocVarNames[i] );

             Tcl_SetObjResult( ip, Tcl_NewStringObj( pocError, -1 ) );

             Tcl_DecrRefCount( poResult );
             return TCL_ERROR;
         }

         Tcl_ListObjAppendElement( ip, poResult, Tcl_NewStringObj( pocVarNames[i], -1 ) );
         Tcl_ListObjAppendElement( ip, poResult, Tcl_NewStringObj( pocGetEnv, -1 ) );
     }

     Tcl_SetObjResult( ip, poResult );
     return TCL_OK;
 }

Category Characters