/*
* tclXmsgcat.c --
*
* Contains commands for accessing XPG/3 message catalogs. If real XPG/3
* message catalogs are not available, the default string is returned.
*-----------------------------------------------------------------------------
* Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
*
* Permission to use, copy, modify, and distribute this software and its
* documentation for any purpose and without fee is hereby granted, provided
* that the above copyright notice appear in all copies. Karl Lehenbauer and
* Mark Diekhans make no representations about the suitability of this
* software for any purpose. It is provided "as is" without express or
* implied warranty.
*-----------------------------------------------------------------------------
* $Id: tclXmsgcat.c,v 8.7 1999/03/31 06:37:45 markd Exp $
*-----------------------------------------------------------------------------
*/
#include "tclExtdInt.h"
#ifndef NO_CATGETS
#include <nl_types.h>
#else
typedef int nl_catd;
#endif /* NO_CATGETS */
static int
ParseFailOptionObj (Tcl_Interp *interp,
Tcl_Obj *optionObj,
int *failPtr);
static int
CatOpFailedObj (Tcl_Interp *interp,
const char *errorMsg);
static int
TclX_CatopenObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]);
static int
TclX_CatgetsObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]);
static int
TclX_CatcloseObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]);
static void
MsgCatCleanUp (ClientData clientData,
Tcl_Interp *interp);
/*
* Message catalog table is global, so it is shared between all interpreters
* in the same process.
*/
static void_pt msgCatTblPtr = NULL;
#ifdef NO_CATGETS
/*-----------------------------------------------------------------------------
* catopen --
*
* A stub to use when message catalogs are not available. Always returns
* -1.
*-----------------------------------------------------------------------------
*/
static nl_catd
catopen (char *name, int oflag)
{
return (nl_catd) -1;
}
/*-----------------------------------------------------------------------------
* catgets --
*
* A stub to use when message catalogs are not available. Always returns
* the default string.
*-----------------------------------------------------------------------------
*/
static char *
catgets (nl_catd catd, int set_num, int msg_num, char *defaultStr)
{
return defaultStr;
}
/*-----------------------------------------------------------------------------
* catclose --
*
* A stub to use when message catalogs are not available. Always returns -1.
*-----------------------------------------------------------------------------
*/
static int
catclose (nl_catd catd)
{
return -1;
}
#endif /* NO_CATGETS */
/*-----------------------------------------------------------------------------
* ParseFailOptionObj --
*
* Parse the -fail/-nofail option, if specified.
*-----------------------------------------------------------------------------
*/
static int
ParseFailOptionObj (Tcl_Interp *interp,
Tcl_Obj *optionObj,
int *failPtr)
{
char *optionStr;
optionStr = Tcl_GetStringFromObj (optionObj, NULL);
if (STREQU ("-fail", optionStr))
*failPtr = TRUE;
else if (STREQU ("-nofail", optionStr))
*failPtr = FALSE;
else {
TclX_AppendObjResult (interp, "Expected option of `-fail' or ",
"`-nofail', got: `", optionStr, "'",
(char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* CatOpFailedObj --
*
* Handles failures of catopen and catclose. If message catalogs are
* available, if returns the supplied message. If message are not
* available, it returns a message indicating that message stubs are used.
* It is not specified by XPG/3 how to get the details of a message catalog
* open or close failure. Always returns TCL_ERROR;
*-----------------------------------------------------------------------------
*/
static int
CatOpFailedObj (Tcl_Interp *interp,
const char *errorMsg)
{
#ifndef NO_CATGETS
TclX_AppendObjResult (interp, errorMsg, (char *) NULL);
#else
TclX_AppendObjResult (interp, "the message catalog facility is not",
" available, default string is always returned",
(char *) NULL);
#endif /* NO_CATGETS */
return TCL_ERROR;
}
/*-----------------------------------------------------------------------------
* TclX_CatopenObjCmd --
*
* Implements the TCLX catopen command:
* catopen ?-fail|-nofail? catname
*-----------------------------------------------------------------------------
*/
static int
TclX_CatopenObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
int fail;
nl_catd catDesc;
nl_catd *catDescPtr;
char handleName[16];
char *catFileName;
if ((objc < 2) || (objc > 3))
return TclX_WrongArgs (interp, objv [0], "?-fail|-nofail? catname");
if (objc == 3) {
if (ParseFailOptionObj (interp, objv [1], &fail) == TCL_ERROR)
return TCL_ERROR;
} else
fail = FALSE;
catFileName = Tcl_GetStringFromObj (objv [objc - 1], NULL);
catDesc = catopen (catFileName, 0);
if ((catDesc == (nl_catd) -1) && fail)
return CatOpFailedObj (interp, "open of message catalog failed");
catDescPtr = (nl_catd *) TclX_HandleAlloc (msgCatTblPtr, handleName);
*catDescPtr = catDesc;
Tcl_SetObjResult (interp, Tcl_NewStringObj (handleName, -1));
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* TclX_CatgetsObjCmd --
*
* Implements the TCLX catgets command:
* catgets catHandle setnum msgnum defaultstr
*-----------------------------------------------------------------------------
*/
static int
TclX_CatgetsObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
nl_catd *catDescPtr;
int msgSetNum, msgNum;
char *localMsg;
char *defaultStr;
if (objc != 5)
return TclX_WrongArgs (interp,
objv [0],
"catHandle setnum msgnum defaultstr");
catDescPtr = (nl_catd *) TclX_HandleXlateObj (interp,
msgCatTblPtr,
objv [1]);
if (catDescPtr == NULL)
return TCL_ERROR;
if (Tcl_GetIntFromObj (interp, objv [2], &msgSetNum) == TCL_ERROR)
return TCL_ERROR;
if (Tcl_GetIntFromObj (interp, objv [3], &msgNum) == TCL_ERROR)
return TCL_ERROR;
/*
* if the integer value of the handle is -1, the catopen actually
* failed (softly, i.e. the caller did not specify "-fail")
* so we detect that and merely return the default string.
*/
if (*catDescPtr == (nl_catd)-1) {
Tcl_SetObjResult (interp, objv [4]);
Tcl_IncrRefCount (objv [4]);
return TCL_OK;
}
defaultStr = Tcl_GetStringFromObj (objv [4], NULL);
localMsg = catgets (*catDescPtr, (int)msgSetNum, (int)msgNum, defaultStr);
Tcl_SetObjResult (interp, Tcl_NewStringObj (localMsg, -1));
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* TclX_CatcloseObjCmd --
*
* Implements the TCLX catclose command:
* catclose ?-fail|-nofail? catHandle
*-----------------------------------------------------------------------------
*/
static int
TclX_CatcloseObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
int fail;
nl_catd *catDescPtr;
int result = 0;
if ((objc < 2) || (objc > 3))
return TclX_WrongArgs (interp, objv [0],
"?-fail|-nofail? catHandle");
if (objc == 3) {
if (ParseFailOptionObj (interp, objv [1], &fail) != TCL_OK)
return TCL_ERROR;
} else
fail = FALSE;
catDescPtr = (nl_catd *) TclX_HandleXlateObj (interp, msgCatTblPtr,
objv [objc - 1]);
if (catDescPtr == NULL)
return TCL_ERROR;
/* If the integer returned by catopen is -1, signifying that the
* open failed but "-fail" was not specified to actually force
* the failure, we don't close the catalog, but we do delete
* the handle. */
if (*catDescPtr == (nl_catd)-1) {
result = -1;
} else {
/*
* NetBSD has catclose of return type void, which is non-standard.
*/
#ifdef BAD_CATCLOSE
catclose (*catDescPtr);
#else
result = catclose (*catDescPtr);
#endif
}
TclX_HandleFree (msgCatTblPtr, catDescPtr);
if ((result < 0) && fail)
return CatOpFailedObj (interp, "close of message catalog failed");
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* MsgCatCleanUp --
*
* Called at interpreter deletion. Releases all resources when no more
* interpreters are using the message catalog table.
*-----------------------------------------------------------------------------
*/
static void
MsgCatCleanUp (ClientData clientData,
Tcl_Interp *interp)
{
nl_catd *catDescPtr;
int walkKey;
if (TclX_HandleTblUseCount (msgCatTblPtr, -1) > 0)
return;
walkKey = -1;
while (TRUE) {
catDescPtr = (nl_catd *) TclX_HandleWalk (msgCatTblPtr, &walkKey);
if (catDescPtr == NULL)
break;
if (*catDescPtr != (nl_catd)-1)
catclose (*catDescPtr);
}
TclX_HandleTblRelease (msgCatTblPtr);
msgCatTblPtr = NULL;
}
/*-----------------------------------------------------------------------------
* TclX_MsgCatInit --
*
* Initialize the Tcl XPG/3 message catalog support faility.
*-----------------------------------------------------------------------------
*/
void
TclX_MsgCatInit (Tcl_Interp *interp)
{
/*
* Set up the table. It is shared between all interpreters, so the use
* count reflects the number of interpreters.
*/
if (msgCatTblPtr == NULL) {
msgCatTblPtr = TclX_HandleTblInit ("msgcat", sizeof (nl_catd), 6);
} else {
(void) TclX_HandleTblUseCount (msgCatTblPtr, 1);
}
Tcl_CallWhenDeleted (interp, MsgCatCleanUp, (ClientData) NULL);
/*
* Initialize the commands.
*/
Tcl_CreateObjCommand (interp,
"catopen",
TclX_CatopenObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"catgets",
TclX_CatgetsObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"catclose",
TclX_CatcloseObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
}
/* vim: set ts=4 sw=4 sts=4 et : */