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;
}