tclEncoding.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:91k
- /*
- * tclEncoding.c --
- *
- * Contains the implementation of the encoding conversion package.
- *
- * Copyright (c) 1996-1998 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclEncoding.c,v 1.16.2.14 2007/02/12 19:25:42 andreas_kupries Exp $
- */
- #include "tclInt.h"
- #include "tclPort.h"
- typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));
- /*
- * The following data structure represents an encoding, which describes how
- * to convert between various character sets and UTF-8.
- */
- typedef struct Encoding {
- char *name; /* Name of encoding. Malloced because (1)
- * hash table entry that owns this encoding
- * may be freed prior to this encoding being
- * freed, (2) string passed in the
- * Tcl_EncodingType structure may not be
- * persistent. */
- Tcl_EncodingConvertProc *toUtfProc;
- /* Procedure to convert from external
- * encoding into UTF-8. */
- Tcl_EncodingConvertProc *fromUtfProc;
- /* Procedure to convert from UTF-8 into
- * external encoding. */
- Tcl_EncodingFreeProc *freeProc;
- /* If non-NULL, procedure to call when this
- * encoding is deleted. */
- int nullSize; /* Number of 0x00 bytes that signify
- * end-of-string in this encoding. This
- * number is used to determine the source
- * string length when the srcLen argument is
- * negative. This number can be 1 or 2. */
- ClientData clientData; /* Arbitrary value associated with encoding
- * type. Passed to conversion procedures. */
- LengthProc *lengthProc; /* Function to compute length of
- * null-terminated strings in this encoding.
- * If nullSize is 1, this is strlen; if
- * nullSize is 2, this is a function that
- * returns the number of bytes in a 0x0000
- * terminated string. */
- int refCount; /* Number of uses of this structure. */
- Tcl_HashEntry *hPtr; /* Hash table entry that owns this encoding. */
- } Encoding;
- /*
- * The following structure is the clientData for a dynamically-loaded,
- * table-driven encoding created by LoadTableEncoding(). It maps between
- * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
- * encoding.
- */
- typedef struct TableEncodingData {
- int fallback; /* Character (in this encoding) to
- * substitute when this encoding cannot
- * represent a UTF-8 character. */
- char prefixBytes[256]; /* If a byte in the input stream is a lead
- * byte for a 2-byte sequence, the
- * corresponding entry in this array is 1,
- * otherwise it is 0. */
- unsigned short **toUnicode; /* Two dimensional sparse matrix to map
- * characters from the encoding to Unicode.
- * Each element of the toUnicode array points
- * to an array of 256 shorts. If there is no
- * corresponding character in Unicode, the
- * value in the matrix is 0x0000. malloc'd. */
- unsigned short **fromUnicode;
- /* Two dimensional sparse matrix to map
- * characters from Unicode to the encoding.
- * Each element of the fromUnicode array
- * points to an array of 256 shorts. If there
- * is no corresponding character the encoding,
- * the value in the matrix is 0x0000.
- * malloc'd. */
- } TableEncodingData;
- /*
- * The following structures is the clientData for a dynamically-loaded,
- * escape-driven encoding that is itself comprised of other simpler
- * encodings. An example is "iso-2022-jp", which uses escape sequences to
- * switch between ascii, jis0208, jis0212, gb2312, and ksc5601. Note that
- * "escape-driven" does not necessarily mean that the ESCAPE character is
- * the character used for switching character sets.
- */
- typedef struct EscapeSubTable {
- unsigned int sequenceLen; /* Length of following string. */
- char sequence[16]; /* Escape code that marks this encoding. */
- char name[32]; /* Name for encoding. */
- Encoding *encodingPtr; /* Encoding loaded using above name, or NULL
- * if this sub-encoding has not been needed
- * yet. */
- } EscapeSubTable;
- typedef struct EscapeEncodingData {
- int fallback; /* Character (in this encoding) to
- * substitute when this encoding cannot
- * represent a UTF-8 character. */
- unsigned int initLen; /* Length of following string. */
- char init[16]; /* String to emit or expect before first char
- * in conversion. */
- unsigned int finalLen; /* Length of following string. */
- char final[16]; /* String to emit or expect after last char
- * in conversion. */
- char prefixBytes[256]; /* If a byte in the input stream is the
- * first character of one of the escape
- * sequences in the following array, the
- * corresponding entry in this array is 1,
- * otherwise it is 0. */
- int numSubTables; /* Length of following array. */
- EscapeSubTable subTables[1];/* Information about each EscapeSubTable
- * used by this encoding type. The actual
- * size will be as large as necessary to
- * hold all EscapeSubTables. */
- } EscapeEncodingData;
- /*
- * Constants used when loading an encoding file to identify the type of the
- * file.
- */
- #define ENCODING_SINGLEBYTE 0
- #define ENCODING_DOUBLEBYTE 1
- #define ENCODING_MULTIBYTE 2
- #define ENCODING_ESCAPE 3
- /*
- * Initialize the default encoding directory. If this variable contains
- * a non NULL value, it will be the first path used to locate the
- * system encoding files.
- */
- char *tclDefaultEncodingDir = NULL;
- static int encodingsInitialized = 0;
- /*
- * Hash table that keeps track of all loaded Encodings. Keys are
- * the string names that represent the encoding, values are (Encoding *).
- */
-
- static Tcl_HashTable encodingTable;
- TCL_DECLARE_MUTEX(encodingMutex)
- /*
- * The following are used to hold the default and current system encodings.
- * If NULL is passed to one of the conversion routines, the current setting
- * of the system encoding will be used to perform the conversion.
- */
- static Tcl_Encoding defaultEncoding;
- static Tcl_Encoding systemEncoding;
- /*
- * The following variable is used in the sparse matrix code for a
- * TableEncoding to represent a page in the table that has no entries.
- */
- static unsigned short emptyPage[256];
- /*
- * Procedures used only in this module.
- */
- static int BinaryProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static void DupEncodingIntRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *dupPtr));
- static void EscapeFreeProc _ANSI_ARGS_((ClientData clientData));
- static int EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static int EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static void FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
- static void FreeEncodingIntRep _ANSI_ARGS_((Tcl_Obj *objPtr));
- static Encoding * GetTableEncoding _ANSI_ARGS_((
- EscapeEncodingData *dataPtr, int state));
- static Tcl_Encoding LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *name));
- static Tcl_Encoding LoadTableEncoding _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *name, int type, Tcl_Channel chan));
- static Tcl_Encoding LoadEscapeEncoding _ANSI_ARGS_((CONST char *name,
- Tcl_Channel chan));
- static Tcl_Channel OpenEncodingFile _ANSI_ARGS_((CONST char *dir,
- CONST char *name));
- static void TableFreeProc _ANSI_ARGS_((ClientData clientData));
- static int TableFromUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static int TableToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static size_t unilen _ANSI_ARGS_((CONST char *src));
- static int UnicodeToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static int UtfToUnicodeProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static int UtfToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr, int pureNullMode));
- static int UtfIntToUtfExtProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static int UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst, int dstLen,
- int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
- static int TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
- /*
- * A Tcl_ObjType for holding a cached Tcl_Encoding as the intrep.
- * This should help the lifetime of encodings be more useful.
- * See concerns raised in [Bug 1077262].
- */
- static Tcl_ObjType EncodingType = {
- "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
- };
- /*
- *----------------------------------------------------------------------
- *
- * TclGetEncodingFromObj --
- *
- * Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr),
- * if possible, and returns TCL_OK. If no such encoding exists,
- * TCL_ERROR is returned, and if interp is non-NULL, an error message
- * is written there.
- *
- * Results:
- * Standard Tcl return code.
- *
- * Side effects:
- * Caches the Tcl_Encoding value as the internal rep of (*objPtr).
- *
- *----------------------------------------------------------------------
- */
- int
- TclGetEncodingFromObj(interp, objPtr, encodingPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
- Tcl_Encoding *encodingPtr;
- {
- CONST char *name = Tcl_GetString(objPtr);
- if (objPtr->typePtr != &EncodingType) {
- Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
- if (encoding == NULL) {
- return TCL_ERROR;
- }
- if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
- objPtr->typePtr->freeIntRepProc(objPtr);
- }
- objPtr->internalRep.otherValuePtr = (VOID *) encoding;
- objPtr->typePtr = &EncodingType;
- }
- *encodingPtr = Tcl_GetEncoding(NULL, name);
- return TCL_OK;
- }
- /*
- *----------------------------------------------------------------------
- *
- * FreeEncodingIntRep --
- *
- * The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
- *
- *----------------------------------------------------------------------
- */
- static void
- FreeEncodingIntRep(objPtr)
- Tcl_Obj *objPtr;
- {
- Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr);
- }
- /*
- *----------------------------------------------------------------------
- *
- * DupEncodingIntRep --
- *
- * The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
- *
- *----------------------------------------------------------------------
- */
- static void
- DupEncodingIntRep(srcPtr, dupPtr)
- Tcl_Obj *srcPtr;
- Tcl_Obj *dupPtr;
- {
- dupPtr->internalRep.otherValuePtr = (VOID *)
- Tcl_GetEncoding(NULL, srcPtr->bytes);
- }
- /*
- *---------------------------------------------------------------------------
- *
- * TclInitEncodingSubsystem --
- *
- * Initialize all resources used by this subsystem on a per-process
- * basis.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Depends on the memory, object, and IO subsystems.
- *
- *---------------------------------------------------------------------------
- */
- void
- TclInitEncodingSubsystem()
- {
- Tcl_EncodingType type;
- Tcl_MutexLock(&encodingMutex);
- Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
- Tcl_MutexUnlock(&encodingMutex);
-
- /*
- * Create a few initial encodings. Note that the UTF-8 to UTF-8
- * translation is not a no-op, because it will turn a stream of
- * improperly formed UTF-8 into a properly formed stream.
- */
- type.encodingName = "identity";
- type.toUtfProc = BinaryProc;
- type.fromUtfProc = BinaryProc;
- type.freeProc = NULL;
- type.nullSize = 1;
- type.clientData = NULL;
- defaultEncoding = Tcl_CreateEncoding(&type);
- systemEncoding = Tcl_GetEncoding(NULL, type.encodingName);
- type.encodingName = "utf-8";
- type.toUtfProc = UtfExtToUtfIntProc;
- type.fromUtfProc = UtfIntToUtfExtProc;
- type.freeProc = NULL;
- type.nullSize = 1;
- type.clientData = NULL;
- Tcl_CreateEncoding(&type);
- type.encodingName = "unicode";
- type.toUtfProc = UnicodeToUtfProc;
- type.fromUtfProc = UtfToUnicodeProc;
- type.freeProc = NULL;
- type.nullSize = 2;
- type.clientData = NULL;
- Tcl_CreateEncoding(&type);
- }
- /*
- *----------------------------------------------------------------------
- *
- * TclFinalizeEncodingSubsystem --
- *
- * Release the state associated with the encoding subsystem.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Frees all of the encodings.
- *
- *----------------------------------------------------------------------
- */
- void
- TclFinalizeEncodingSubsystem()
- {
- Tcl_HashSearch search;
- Tcl_HashEntry *hPtr;
- Tcl_MutexLock(&encodingMutex);
- encodingsInitialized = 0;
- FreeEncoding(systemEncoding);
- hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
- while (hPtr != NULL) {
- /*
- * Call FreeEncoding instead of doing it directly to handle refcounts
- * like escape encodings use. [Bug #524674]
- * Make sure to call Tcl_FirstHashEntry repeatedly so that all
- * encodings are eventually cleaned up.
- */
- FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
- hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
- }
- Tcl_DeleteHashTable(&encodingTable);
- Tcl_MutexUnlock(&encodingMutex);
- }
- /*
- *-------------------------------------------------------------------------
- *
- * Tcl_GetDefaultEncodingDir --
- *
- *
- * Results:
- *
- * Side effects:
- *
- *-------------------------------------------------------------------------
- */
- CONST char *
- Tcl_GetDefaultEncodingDir()
- {
- return tclDefaultEncodingDir;
- }
- /*
- *-------------------------------------------------------------------------
- *
- * Tcl_SetDefaultEncodingDir --
- *
- *
- * Results:
- *
- * Side effects:
- *
- *-------------------------------------------------------------------------
- */
- void
- Tcl_SetDefaultEncodingDir(path)
- CONST char *path;
- {
- tclDefaultEncodingDir = (char *)ckalloc((unsigned) strlen(path) + 1);
- strcpy(tclDefaultEncodingDir, path);
- }
- /*
- *-------------------------------------------------------------------------
- *
- * Tcl_GetEncoding --
- *
- * Given the name of a encoding, find the corresponding Tcl_Encoding
- * token. If the encoding did not already exist, Tcl attempts to
- * dynamically load an encoding by that name.
- *
- * Results:
- * Returns a token that represents the encoding. If the name didn't
- * refer to any known or loadable encoding, NULL is returned. If
- * NULL was returned, an error message is left in interp's result
- * object, unless interp was NULL.
- *
- * Side effects:
- * The new encoding type is entered into a table visible to all
- * interpreters, keyed off the encoding's name. For each call to
- * this procedure, there should eventually be a call to
- * Tcl_FreeEncoding, so that the database can be cleaned up when
- * encodings aren't needed anymore.
- *
- *-------------------------------------------------------------------------
- */
- Tcl_Encoding
- Tcl_GetEncoding(interp, name)
- Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
- CONST char *name; /* The name of the desired encoding. */
- {
- Tcl_HashEntry *hPtr;
- Encoding *encodingPtr;
- Tcl_MutexLock(&encodingMutex);
- if (name == NULL) {
- encodingPtr = (Encoding *) systemEncoding;
- encodingPtr->refCount++;
- Tcl_MutexUnlock(&encodingMutex);
- return systemEncoding;
- }
- hPtr = Tcl_FindHashEntry(&encodingTable, name);
- if (hPtr != NULL) {
- encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
- encodingPtr->refCount++;
- Tcl_MutexUnlock(&encodingMutex);
- return (Tcl_Encoding) encodingPtr;
- }
- Tcl_MutexUnlock(&encodingMutex);
- return LoadEncodingFile(interp, name);
- }
- /*
- *---------------------------------------------------------------------------
- *
- * Tcl_FreeEncoding --
- *
- * This procedure is called to release an encoding allocated by
- * Tcl_CreateEncoding() or Tcl_GetEncoding().
- *
- * Results:
- * None.
- *
- * Side effects:
- * The reference count associated with the encoding is decremented
- * and the encoding may be deleted if nothing is using it anymore.
- *
- *---------------------------------------------------------------------------
- */
- void
- Tcl_FreeEncoding(encoding)
- Tcl_Encoding encoding;
- {
- Tcl_MutexLock(&encodingMutex);
- FreeEncoding(encoding);
- Tcl_MutexUnlock(&encodingMutex);
- }
- /*
- *----------------------------------------------------------------------
- *
- * FreeEncoding --
- *
- * This procedure is called to release an encoding by procedures
- * that already have the encodingMutex.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The reference count associated with the encoding is decremented
- * and the encoding may be deleted if nothing is using it anymore.
- *
- *----------------------------------------------------------------------
- */
- static void
- FreeEncoding(encoding)
- Tcl_Encoding encoding;
- {
- Encoding *encodingPtr;
-
- encodingPtr = (Encoding *) encoding;
- if (encodingPtr == NULL) {
- return;
- }
- encodingPtr->refCount--;
- if (encodingPtr->refCount == 0) {
- if (encodingPtr->freeProc != NULL) {
- (*encodingPtr->freeProc)(encodingPtr->clientData);
- }
- if (encodingPtr->hPtr != NULL) {
- Tcl_DeleteHashEntry(encodingPtr->hPtr);
- }
- ckfree((char *) encodingPtr->name);
- ckfree((char *) encodingPtr);
- }
- }
- /*
- *-------------------------------------------------------------------------
- *
- * Tcl_GetEncodingName --
- *
- * Given an encoding, return the name that was used to constuct
- * the encoding.
- *
- * Results:
- * The name of the encoding.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
- CONST char *
- Tcl_GetEncodingName(encoding)
- Tcl_Encoding encoding; /* The encoding whose name to fetch. */
- {
- Encoding *encodingPtr;
- if (encoding == NULL) {
- encoding = systemEncoding;
- }
- encodingPtr = (Encoding *) encoding;
- return encodingPtr->name;
- }
- /*
- *-------------------------------------------------------------------------
- *
- * Tcl_GetEncodingNames --
- *
- * Get the list of all known encodings, including the ones stored
- * as files on disk in the encoding path.
- *
- * Results:
- * Modifies interp's result object to hold a list of all the available
- * encodings.
- *
- * Side effects:
- * None.
- *
- *-------------------------------------------------------------------------
- */
- void
- Tcl_GetEncodingNames(interp)
- Tcl_Interp *interp; /* Interp to hold result. */
- {
- Tcl_HashSearch search;
- Tcl_HashEntry *hPtr;
- Tcl_Obj *pathPtr, *resultPtr;
- int dummy;
- Tcl_HashTable table;
- Tcl_MutexLock(&encodingMutex);
- Tcl_InitHashTable(&table, TCL_STRING_KEYS);
- hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
- while (hPtr != NULL) {
- Encoding *encodingPtr;
-
- encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
- Tcl_CreateHashEntry(&table, encodingPtr->name, &dummy);
- hPtr = Tcl_NextHashEntry(&search);
- }
- Tcl_MutexUnlock(&encodingMutex);
- pathPtr = TclGetLibraryPath();
- if (pathPtr != NULL) {
- int i, objc;
- Tcl_Obj **objv;
- char globArgString[10];
- Tcl_Obj* encodingObj = Tcl_NewStringObj("encoding",-1);
- Tcl_IncrRefCount(encodingObj);
-
- objc = 0;
- Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
- for (i = 0; i < objc; i++) {
- Tcl_Obj *searchIn;
-
- /*
- * Construct the path from the element of pathPtr,
- * joined with 'encoding'.
- */
- searchIn = Tcl_FSJoinToPath(objv[i],1,&encodingObj);
- Tcl_IncrRefCount(searchIn);
- Tcl_ResetResult(interp);
- /*
- * TclGlob() changes the contents of globArgString, which causes
- * a segfault if we pass in a pointer to non-writeable memory.
- * TclGlob() puts its results directly into interp.
- */
- strcpy(globArgString, "*.enc");
- /*
- * The GLOBMODE_TAILS flag returns just the tail of each file
- * which is the encoding name with a .enc extension
- */
- if ((TclGlob(interp, globArgString, searchIn,
- TCL_GLOBMODE_TAILS, NULL) == TCL_OK)) {
- int objc2 = 0;
- Tcl_Obj **objv2;
- int j;
- Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
- &objv2);
- for (j = 0; j < objc2; j++) {
- int length;
- char *string;
- string = Tcl_GetStringFromObj(objv2[j], &length);
- length -= 4;
- if (length > 0) {
- string[length] = ' ';
- Tcl_CreateHashEntry(&table, string, &dummy);
- string[length] = '.';
- }
- }
- }
- Tcl_DecrRefCount(searchIn);
- }
- Tcl_DecrRefCount(encodingObj);
- }
- /*
- * Clear any values placed in the result by globbing.
- */
- Tcl_ResetResult(interp);
- resultPtr = Tcl_GetObjResult(interp);
- hPtr = Tcl_FirstHashEntry(&table, &search);
- while (hPtr != NULL) {
- Tcl_Obj *strPtr;
- strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&table, hPtr), -1);
- Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
- hPtr = Tcl_NextHashEntry(&search);
- }
- Tcl_DeleteHashTable(&table);
- }
- /*
- *------------------------------------------------------------------------
- *
- * Tcl_SetSystemEncoding --
- *
- * Sets the default encoding that should be used whenever the user
- * passes a NULL value in to one of the conversion routines.
- * If the supplied name is NULL, the system encoding is reset to the
- * default system encoding.
- *
- * Results:
- * The return value is TCL_OK if the system encoding was successfully
- * set to the encoding specified by name, TCL_ERROR otherwise. If
- * TCL_ERROR is returned, an error message is left in interp's result
- * object, unless interp was NULL.
- *
- * Side effects:
- * The reference count of the new system encoding is incremented.
- * The reference count of the old system encoding is decremented and
- * it may be freed.
- *
- *------------------------------------------------------------------------
- */
- int
- Tcl_SetSystemEncoding(interp, name)
- Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
- CONST char *name; /* The name of the desired encoding, or NULL
- * to reset to default encoding. */
- {
- Tcl_Encoding encoding;
- Encoding *encodingPtr;
- if (name == NULL) {
- Tcl_MutexLock(&encodingMutex);
- encoding = defaultEncoding;
- encodingPtr = (Encoding *) encoding;
- encodingPtr->refCount++;
- Tcl_MutexUnlock(&encodingMutex);
- } else {
- encoding = Tcl_GetEncoding(interp, name);
- if (encoding == NULL) {
- return TCL_ERROR;
- }
- }
- Tcl_MutexLock(&encodingMutex);
- FreeEncoding(systemEncoding);
- systemEncoding = encoding;
- Tcl_MutexUnlock(&encodingMutex);
- return TCL_OK;
- }
- /*
- *---------------------------------------------------------------------------
- *
- * Tcl_CreateEncoding --
- *
- * This procedure is called to define a new encoding and the procedures
- * that are used to convert between the specified encoding and Unicode.
- *
- * Results:
- * Returns a token that represents the encoding. If an encoding with
- * the same name already existed, the old encoding token remains
- * valid and continues to behave as it used to, and will eventually
- * be garbage collected when the last reference to it goes away. Any
- * subsequent calls to Tcl_GetEncoding with the specified name will
- * retrieve the most recent encoding token.
- *
- * Side effects:
- * The new encoding type is entered into a table visible to all
- * interpreters, keyed off the encoding's name. For each call to
- * this procedure, there should eventually be a call to
- * Tcl_FreeEncoding, so that the database can be cleaned up when
- * encodings aren't needed anymore.
- *
- *---------------------------------------------------------------------------
- */
- Tcl_Encoding
- Tcl_CreateEncoding(typePtr)
- Tcl_EncodingType *typePtr; /* The encoding type. */
- {
- Tcl_HashEntry *hPtr;
- int new;
- Encoding *encodingPtr;
- char *name;
- Tcl_MutexLock(&encodingMutex);
- hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &new);
- if (new == 0) {
- /*
- * Remove old encoding from hash table, but don't delete it until
- * last reference goes away.
- */
-
- encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
- encodingPtr->hPtr = NULL;
- }
- name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);
-
- encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
- encodingPtr->name = strcpy(name, typePtr->encodingName);
- encodingPtr->toUtfProc = typePtr->toUtfProc;
- encodingPtr->fromUtfProc = typePtr->fromUtfProc;
- encodingPtr->freeProc = typePtr->freeProc;
- encodingPtr->nullSize = typePtr->nullSize;
- encodingPtr->clientData = typePtr->clientData;
- if (typePtr->nullSize == 1) {
- encodingPtr->lengthProc = (LengthProc *) strlen;
- } else {
- encodingPtr->lengthProc = (LengthProc *) unilen;
- }
- encodingPtr->refCount = 1;
- encodingPtr->hPtr = hPtr;
- Tcl_SetHashValue(hPtr, encodingPtr);
- Tcl_MutexUnlock(&encodingMutex);
- return (Tcl_Encoding) encodingPtr;
- }
- /*
- *-------------------------------------------------------------------------
- *
- * Tcl_ExternalToUtfDString --
- *
- * Convert a source buffer from the specified encoding into UTF-8.
- * If any of the bytes in the source buffer are invalid or cannot
- * be represented in the target encoding, a default fallback
- * character will be substituted.
- *
- * Results:
- * The converted bytes are stored in the DString, which is then NULL
- * terminated. The return value is a pointer to the value stored
- * in the DString.
- *
- * Side effects:
- * None.
- *
- *-------------------------------------------------------------------------
- */
- char *
- Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
- Tcl_Encoding encoding; /* The encoding for the source string, or
- * NULL for the default system encoding. */
- CONST char *src; /* Source string in specified encoding. */
- int srcLen; /* Source string length in bytes, or < 0 for
- * encoding-specific string length. */
- Tcl_DString *dstPtr; /* Uninitialized or free DString in which
- * the converted string is stored. */
- {
- char *dst;
- Tcl_EncodingState state;
- Encoding *encodingPtr;
- int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
- Tcl_DStringInit(dstPtr);
- dst = Tcl_DStringValue(dstPtr);
- dstLen = dstPtr->spaceAvl - 1;
-
- if (encoding == NULL) {
- encoding = systemEncoding;
- }
- encodingPtr = (Encoding *) encoding;
- if (src == NULL) {
- srcLen = 0;
- } else if (srcLen < 0) {
- srcLen = (*encodingPtr->lengthProc)(src);
- }
- flags = TCL_ENCODING_START | TCL_ENCODING_END;
- while (1) {
- result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src,
- srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
- &dstChars);
- soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
- if (result != TCL_CONVERT_NOSPACE) {
- Tcl_DStringSetLength(dstPtr, soFar);
- return Tcl_DStringValue(dstPtr);
- }
- flags &= ~TCL_ENCODING_START;
- src += srcRead;
- srcLen -= srcRead;
- if (Tcl_DStringLength(dstPtr) == 0) {
- Tcl_DStringSetLength(dstPtr, dstLen);
- }
- Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
- dst = Tcl_DStringValue(dstPtr) + soFar;
- dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
- }
- }
- /*
- *-------------------------------------------------------------------------
- *
- * Tcl_ExternalToUtf --
- *
- * Convert a source buffer from the specified encoding into UTF-8.
- *
- * Results:
- * The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE,
- * TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE,
- * as documented in tcl.h.
- *
- * Side effects:
- * The converted bytes are stored in the output buffer.
- *
- *-------------------------------------------------------------------------
- */
- int
- Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
- dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
- Tcl_Interp *interp; /* Interp for error return, if not NULL. */
- Tcl_Encoding encoding; /* The encoding for the source string, or
- * NULL for the default system encoding. */
- CONST char *src; /* Source string in specified encoding. */
- int srcLen; /* Source string length in bytes, or < 0 for
- * encoding-specific string length. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store
- * state information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string
- * is stored. */
- int dstLen; /* The maximum length of output buffer in
- * bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
- * stored in the output buffer as a result of
- * the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
- * correspond to the bytes stored in the
- * output buffer. */
- {
- Encoding *encodingPtr;
- int result, srcRead, dstWrote, dstChars;
- Tcl_EncodingState state;
-
- if (encoding == NULL) {
- encoding = systemEncoding;
- }
- encodingPtr = (Encoding *) encoding;
- if (src == NULL) {
- srcLen = 0;
- } else if (srcLen < 0) {
- srcLen = (*encodingPtr->lengthProc)(src);
- }
- if (statePtr == NULL) {
- flags |= TCL_ENCODING_START | TCL_ENCODING_END;
- statePtr = &state;
- }
- if (srcReadPtr == NULL) {
- srcReadPtr = &srcRead;
- }
- if (dstWrotePtr == NULL) {
- dstWrotePtr = &dstWrote;
- }
- if (dstCharsPtr == NULL) {
- dstCharsPtr = &dstChars;
- }
- /*
- * If there are any null characters in the middle of the buffer, they will
- * converted to the UTF-8 null character (xC080). To get the actual
- *