Tcl Source Code

 */

#define ENCODING_SINGLEBYTE	0
#define ENCODING_DOUBLEBYTE	1
#define ENCODING_MULTIBYTE	2
#define ENCODING_ESCAPE		3

/*
 * Data used for an alias encoding.
 */

typedef struct {
    Tcl_Obj *aliasName;		/* The name of the encoding that this is an
				 * alias for. */
    Tcl_Encoding aliasEncoding;	/* Reference to the encoding that this is an
				 * alias for. Will not be an alias itself. */
} AliasEncoding;

/*
 * A list of directories in which Tcl should look for *.enc files. This list
 * is shared by all threads. Access is governed by a mutex lock.
 */

static TclInitProcessGlobalValueProc InitializeEncodingSearchPath;
static ProcessGlobalValue encodingSearchPath = {

static int		BinaryProc(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(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void		AliasFreeProc(ClientData clientData);
static int		AliasFromUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		AliasToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static void		EscapeFreeProc(ClientData clientData);
static int		EscapeFromUtfProc(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(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static void		FillEncodingFileMap(void);
static void		FreeEncoding(Tcl_Encoding encoding);
static void		FreeEncodingIntRep(Tcl_Obj *objPtr);
static Encoding *	GetTableEncoding(EscapeEncodingData *dataPtr,
			    int state);
static Tcl_Encoding	LoadEncodingFile(Tcl_Interp *interp, const char *name);
static Tcl_Encoding	LoadTableEncoding(const char *name, int type,
			    Tcl_Channel chan);
static Tcl_Encoding	LoadEscapeEncoding(const char *name, Tcl_Channel chan);
static Tcl_Encoding	LoadAliasEncoding(const char *name, Tcl_Channel chan);
static Tcl_Channel	OpenEncodingFileChannel(Tcl_Interp *interp,
			    const char *name);
static void		TableFreeProc(ClientData clientData);
static int		TableFromUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,

	break;
    case 'M':
	encoding = LoadTableEncoding(name, ENCODING_MULTIBYTE, chan);
	break;
    case 'E':
	encoding = LoadEscapeEncoding(name, chan);
	break;
    case 'A':
	encoding = LoadAliasEncoding(name, chan);
	break;
    }
    if ((encoding == NULL) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid encoding file \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
    }
    Tcl_Close(NULL, chan);

    type.encodingName	= name;
    type.toUtfProc	= EscapeToUtfProc;
    type.fromUtfProc    = EscapeFromUtfProc;
    type.freeProc	= EscapeFreeProc;
    type.nullSize	= 1;
    type.clientData	= dataPtr;

    return Tcl_CreateEncoding(&type);
}

/*
 *-------------------------------------------------------------------------
 *
 * LoadAliasEncoding --
 *
 *	Helper function for LoadEncodingTable(). Loads an alias to another
 *	encoding.
 *
 *	File contains text data that describes what the encoding is an alias
 *	for.
 *
 * Results:
 *	The return value is the new encoding, or NULL if the encoding could
 *	not be created (because the file contained invalid data).
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Encoding
LoadAliasEncoding(
    const char *name,		/* Name for new encoding. */
    Tcl_Channel chan)		/* File containing new encoding. */
{
    Tcl_Obj *objPtr;
    AliasEncoding *aliasPtr;
    Tcl_EncodingType type;

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    if (Tcl_GetsObj(chan, objPtr) < 0) {
	Tcl_DecrRefCount(objPtr);
	return NULL;
    }
    aliasPtr = ckalloc(sizeof(AliasEncoding));
    aliasPtr->aliasName = objPtr;
    if (Tcl_GetEncodingFromObj(NULL, objPtr,
	    &aliasPtr->aliasEncoding) != TCL_OK) {
	ckfree(aliasPtr);
	Tcl_DecrRefCount(objPtr);
	return NULL;
    }

    /*
     * Check for (and prohibit) alias loops.
     */

    if (((Encoding *) aliasPtr->aliasEncoding)->freeProc == AliasFreeProc) {
	ckfree(aliasPtr);
	Tcl_DecrRefCount(objPtr);
	return NULL;
    }

    type.encodingName = name;
    type.toUtfProc = AliasToUtfProc;
    type.fromUtfProc = AliasFromUtfProc;
    type.freeProc = AliasFreeProc;
    type.nullSize = 1;
    type.clientData = aliasPtr;

    return Tcl_CreateEncoding(&type);
}

/*
 *-------------------------------------------------------------------------
 *

    bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);

    *lengthPtr = numBytes;
    *valuePtr = ckalloc(numBytes + 1);
    memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
    Tcl_DecrRefCount(searchPathObj);
}

/*
 *-------------------------------------------------------------------------
 *
 * AliasFreeProc --
 *
 *	How to dispose of an alias encoding.
 *
 *-------------------------------------------------------------------------
 */

static void
AliasFreeProc(
    ClientData clientData)
{
    AliasEncoding *aliasPtr = clientData;

    FreeEncoding(aliasPtr->aliasEncoding);
    Tcl_DecrRefCount(aliasPtr->aliasName);
    ckfree(aliasPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * AliasToUtfProc --
 *
 *	How to convert from Tcl's internal quasi-UTF8 format to an encoding
 *	that is an alias for another one.
 *
 *-------------------------------------------------------------------------
 */

static int
AliasFromUtfProc(
    ClientData clientData,
    const char *src,
    int srcLen,
    int flags,
    Tcl_EncodingState *statePtr,
    char *dst,
    int dstLen,
    int *srcReadPtr,
    int *dstWrotePtr,
    int *dstCharsPtr)
{
    AliasEncoding *aliasPtr = clientData;

    return Tcl_UtfToExternal(NULL, aliasPtr->aliasEncoding, src, srcLen,
	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
	    dstCharsPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * AliasToUtfProc --
 *
 *	How to convert from an encoding that is an alias for another one to
 *	Tcl's internal quasi-UTF8 format.
 *
 *-------------------------------------------------------------------------
 */

static int
AliasToUtfProc(
    ClientData clientData,
    const char *src,
    int srcLen,
    int flags,
    Tcl_EncodingState *statePtr,
    char *dst,
    int dstLen,
    int *srcReadPtr,
    int *dstWrotePtr,
    int *dstCharsPtr)
{
    AliasEncoding *aliasPtr = clientData;

    return Tcl_ExternalToUtf(NULL, aliasPtr->aliasEncoding, src, srcLen,
	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
	    dstCharsPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */