cvs.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxmsgc.c

   1 /*
   2  * tclXmsgcat.c --
   3  *
   4  *      Contains commands for accessing XPG/3 message catalogs.  If real XPG/3
   5  * message catalogs are not available, the default string is returned.
   6  *-----------------------------------------------------------------------------
   7  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
   8  *
   9  * Permission to use, copy, modify, and distribute this software and its
  10  * documentation for any purpose and without fee is hereby granted, provided
  11  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12  * Mark Diekhans make no representations about the suitability of this
  13  * software for any purpose.  It is provided "as is" without express or
  14  * implied warranty.
  15  *-----------------------------------------------------------------------------
  16  * $Id: tclXmsgcat.c,v 2.0 1992/10/16 04:51:02 markd Rel $
  17  *-----------------------------------------------------------------------------
  18  */
  19
  20 #include "tclxint.h"
  21
  22 #ifdef TCL_HAVE_CATGETS
  23
  24 #include <nl_types.h>
  25
  26 #else
  27
  28 typedef int nl_catd;
  29
  30 #endif /* TCL_HAVE_CATGETS */
  31
  32 static int
  33 ParseFailOption _ANSI_ARGS_((Tcl_Interp *interp,
  34                              CONST char *optionStr,
  35                              int        *failPtr));
  36
  37 static int
  38 CatOpFailed _ANSI_ARGS_((Tcl_Interp *interp,
  39                          CONST char *errorMsg));
  40
  41 /*
  42  * Message catalog table is global, so it is shared between all interpreters
  43  * in the same process.
  44  */
  45 static void_pt msgCatTblPtr = NULL;
  46
  47 #ifndef TCL_HAVE_CATGETS
  48 \f
  49 /*
  50  *-----------------------------------------------------------------------------
  51  *
  52  * catopen --
  53  *    A stub to use when message catalogs are not available.
  54  *
  55  * Results:
  56  *     Always returns the default string.
  57  *
  58  *-----------------------------------------------------------------------------
  59  */
  60 static nl_catd
  61 catopen (name, oflag)
  62     char *name;
  63     int   oflag;
  64 {
  65     return (nl_catd) -1;
  66 }
  67 \f
  68 /*
  69  *-----------------------------------------------------------------------------
  70  *
  71  * catgets --
  72  *    A stub to use when message catalogs are not available.
  73  *
  74  * Results:
  75  *     Always returns -1.
  76  *
  77  *-----------------------------------------------------------------------------
  78  */
  79 static char *
  80 catgets (catd, set_num, msg_num, defaultStr)
  81     nl_catd catd;
  82     int     set_num, msg_num;
  83     char   *defaultStr;
  84 {
  85     return defaultStr;
  86 }
  87 \f
  88 /*
  89  *-----------------------------------------------------------------------------
  90  *
  91  * catclose --
  92  *    A stub to use when message catalogs are not available.
  93  *
  94  * Results:
  95  *     Always returns -1.
  96  *
  97  *-----------------------------------------------------------------------------
  98  */
  99 static int
 100 catclose (catd)
 101     nl_catd catd;
 102 {
 103     return -1;
 104 }
 105 #endif /* TCL_HAVE_CATGETS */
 106 \f
 107 /*
 108  *-----------------------------------------------------------------------------
 109  *
 110  * ParseFailOption --
 111  *    Parse the -fail/-nofail option, if specified.
 112  *
 113  * Results:
 114  *     Standard Tcl results.
 115  *
 116  *-----------------------------------------------------------------------------
 117  */
 118 static int
 119 ParseFailOption (interp, optionStr, failPtr)
 120     Tcl_Interp *interp;
 121     CONST char *optionStr;
 122     int        *failPtr;
 123 {
 124     if (STREQU ("-fail", ((char *) optionStr)))
 125         *failPtr = TRUE;
 126     else if (STREQU ("-nofail", ((char *) optionStr)))
 127         *failPtr = FALSE;
 128     else {
 129         Tcl_AppendResult (interp, "Expected option of `-fail' or ",
 130                           "`-nofail', got: `", optionStr, "'",
 131                           (char *) NULL);
 132         return TCL_ERROR;
 133     }
 134     return TCL_OK;
 135 }
 136 \f
 137 /*
 138  *-----------------------------------------------------------------------------
 139  *
 140  * CatOpFailed --
 141  *    Handles failures of catopen and catclose.  If message catalogs are
 142  * available, if returns the supplied message.  If message are not
 143  * available, it returns a message indicating that message stubs are used.
 144  * It is not specified by XPG/3 how to get the details of a message catalog
 145  * open or close failure.
 146  *
 147  * Results:
 148  *     Always returns TCL_ERROR;
 149  *
 150  *-----------------------------------------------------------------------------
 151  */
 152 static int
 153 CatOpFailed (interp, errorMsg)
 154     Tcl_Interp *interp;
 155     CONST char *errorMsg;
 156 {
 157 #ifdef TCL_HAVE_CATGETS
 158
 159     Tcl_AppendResult (interp, errorMsg, (char *) NULL);
 160
 161 #else
 162
 163     Tcl_AppendResult (interp, "the message catalog facility is not available,",
 164                       " default string is always returned", (char *) NULL);
 165
 166 #endif /* TCL_HAVE_CATGETS */
 167
 168     return TCL_ERROR;
 169 }
 170 \f
 171 /*
 172  *-----------------------------------------------------------------------------
 173  *
 174  * Tcl_CatopenCmd --
 175  *    Implements the TCL echo command:
 176  *        catopen [-fail|-nofail] catname
 177  *
 178  * Results:
 179  *     Standard Tcl results.
 180  *
 181  *-----------------------------------------------------------------------------
 182  */
 183 static int
 184 Tcl_CatopenCmd (clientData, interp, argc, argv)
 185     ClientData  clientData;
 186     Tcl_Interp *interp;
 187     int         argc;
 188     char      **argv;
 189 {
 190     int      fail;
 191     nl_catd  catDesc;
 192     nl_catd *catDescPtr;
 193
 194     if ((argc < 2) || (argc > 3)) {
 195         Tcl_AppendResult (interp, argv [0], " [-fail|-nofail] catname",
 196                           (char *) NULL);
 197         return TCL_ERROR;
 198     }
 199     if (argc == 3) {
 200         if (ParseFailOption (interp, argv [1], &fail) != TCL_OK)
 201             return TCL_ERROR;
 202     } else
 203         fail = FALSE;
 204
 205     catDesc = catopen (argv [argc - 1], 0);
 206     if ((catDesc == (nl_catd) -1) && fail)
 207         return CatOpFailed (interp, "open of message catalog failed");
 208
 209     catDescPtr = Tcl_HandleAlloc (msgCatTblPtr, interp->result);
 210     *catDescPtr = catDesc;
 211
 212     return TCL_OK;
 213 }
 214 \f
 215 /*
 216  *-----------------------------------------------------------------------------
 217  *
 218  * Tcl_CatgetsCmd --
 219  *    Implements the TCL echo command:
 220  *        catgets catHandle setnum msgnum defaultstr
 221  *
 222  * Results:
 223  *     Standard Tcl results.
 224  *
 225  *-----------------------------------------------------------------------------
 226  */
 227 static int
 228 Tcl_CatgetsCmd (clientData, interp, argc, argv)
 229     ClientData  clientData;
 230     Tcl_Interp *interp;
 231     int         argc;
 232     char      **argv;
 233 {
 234     nl_catd   *catDescPtr;
 235     int        msgSetNum, msgNum;
 236     char      *localMsg;
 237
 238     if (argc != 5) {
 239         Tcl_AppendResult (interp, argv [0], " catHandle setnum msgnum ",
 240                           "defaultstr", (char *) NULL);
 241         return TCL_ERROR;
 242     }
 243     catDescPtr = Tcl_HandleXlate (interp, msgCatTblPtr, argv [1]);
 244     if (catDescPtr == NULL)
 245         return TCL_ERROR;
 246     if (Tcl_GetInt (interp, argv [2], &msgSetNum) != TCL_OK)
 247         return TCL_ERROR;
 248     if (Tcl_GetInt (interp, argv [3], &msgNum) != TCL_OK)
 249         return TCL_ERROR;
 250
 251     localMsg = catgets (*catDescPtr, msgSetNum, msgNum, argv [4]);
 252
 253     Tcl_SetResult (interp, localMsg, TCL_VOLATILE);
 254     return TCL_OK;
 255 }\f
 256
 257 /*
 258  *-----------------------------------------------------------------------------
 259  *
 260  * Tcl_CatcloseCmd --
 261  *    Implements the TCL echo command:
 262  *        catclose [-fail|-nofail] catHandle
 263  *
 264  * Results:
 265  *     Standard Tcl results.
 266  *
 267  *-----------------------------------------------------------------------------
 268  */
 269 static int
 270 Tcl_CatcloseCmd (clientData, interp, argc, argv)
 271     ClientData  clientData;
 272     Tcl_Interp *interp;
 273     int         argc;
 274     char      **argv;
 275 {
 276     int      fail;
 277     nl_catd *catDescPtr;
 278
 279     if ((argc < 2) || (argc > 3)) {
 280         Tcl_AppendResult (interp, argv [0], " [-fail|-nofail] catHandle",
 281                           (char *) NULL);
 282         return TCL_ERROR;
 283     }
 284     if (argc == 3) {
 285         if (ParseFailOption (interp, argv [1], &fail) != TCL_OK)
 286             return TCL_ERROR;
 287     } else
 288         fail = FALSE;
 289
 290     catDescPtr = Tcl_HandleXlate (interp, msgCatTblPtr, argv [argc - 1]);
 291     if (catDescPtr == NULL)
 292         return TCL_ERROR;
 293
 294     if ((catclose (*catDescPtr) < 0) && fail)
 295         return CatOpFailed (interp, "close of message catalog failed");
 296
 297     Tcl_HandleFree (msgCatTblPtr, catDescPtr);
 298     return TCL_OK;
 299 }
 300 \f
 301 /*
 302  *-----------------------------------------------------------------------------
 303  *
 304  *  MsgCatCleanUp --
 305  *      Decrements the use count on the globals when a command is deleted.
 306  *      If it goes to zero, all resources are released.
 307  *
 308  *-----------------------------------------------------------------------------
 309  */
 310 static void
 311 MsgCatCleanUp (clientData)
 312     ClientData clientData;
 313 {
 314     nl_catd *catDescPtr;
 315     int      walkKey;
 316
 317     if (Tcl_HandleTblUseCount (msgCatTblPtr, -1) > 0)
 318         return;
 319
 320     walkKey = -1;
 321     while ((catDescPtr = Tcl_HandleWalk (msgCatTblPtr, &walkKey)) != NULL)
 322         catclose (*catDescPtr);
 323
 324     Tcl_HandleTblRelease (msgCatTblPtr);
 325 }
 326 \f
 327 /*
 328  *-----------------------------------------------------------------------------
 329  *
 330  *  Tcl_InitMsgCat --
 331  *      Initialize the Tcl XPG/3 message catalog support faility.
 332  *
 333  *-----------------------------------------------------------------------------
 334  */
 335 void
 336 Tcl_InitMsgCat (interp)
 337     Tcl_Interp *interp;
 338 {
 339
 340     if (msgCatTblPtr == NULL)
 341         msgCatTblPtr = Tcl_HandleTblInit ("msgcat", sizeof (nl_catd), 6);
 342
 343     (void) Tcl_HandleTblUseCount (msgCatTblPtr, 2);  /* 3 commands total */
 344
 345     /*
 346      * Initialize the commands.
 347      */
 348
 349     Tcl_CreateCommand (interp, "catopen", Tcl_CatopenCmd,
 350                        (ClientData)NULL, MsgCatCleanUp);
 351     Tcl_CreateCommand (interp, "catgets", Tcl_CatgetsCmd,
 352                        (ClientData)NULL, MsgCatCleanUp);
 353     Tcl_CreateCommand (interp, "catclose", Tcl_CatcloseCmd,
 354                        (ClientData)NULL, MsgCatCleanUp);
 355 }
 356