tclencoding.c

来自「tcl是工具命令语言」· C语言 代码 · 共 2,179 行 · 第 1/5 页

 *
 *---------------------------------------------------------------------------
 */

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] = '\0';
			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