Tk Source Code

    /*
     * If we're displaying a special character instead of the value of the
     * entry, recompute the displayString.
     */

    if (entryPtr->showChar != NULL) {

	char buf[4];
	int size;

	/*
	 * Normalize the special character so we can safely duplicate it in
	 * the display string. If we didn't do this, then two malformed
	 * characters might end up looking like one valid UTF character in the
	 * resulting string.
	 */
#if TCL_UTF_MAX == 4
	int ch;

	TkUtfToUniChar32(entryPtr->showChar, &ch);
#else
	Tcl_UniChar ch;

	Tcl_UtfToUniChar(entryPtr->showChar, &ch);
#endif
	size = Tcl_UniCharToUtf(ch, buf);

	entryPtr->numDisplayBytes = entryPtr->numChars * size;
	p = ckalloc(entryPtr->numDisplayBytes + 1);
	entryPtr->displayString = p;

	for (i = entryPtr->numChars; --i >= 0; ) {

     Tcl_DString *dsPtr)	/* Dynamic string in which to append new
				 * command. */
{
    int spaceNeeded, cvtFlags;	/* Used to substitute string as proper Tcl
				 * list element. */
    int number, length;
    register const char *string;
#if TCL_UTF_MAX == 4
    int ch;
#else
    Tcl_UniChar ch;
#endif
    char numStorage[2*TCL_INTEGER_SPACE];

    while (1) {
	if (*before == '\0') {
	    break;
	}
	/*

	/*
	 * There's a percent sequence here. Process it.
	 */

	before++; /* skip over % */
	if (*before != '\0') {
#if TCL_UTF_MAX == 4
	    before += TkUtfToUniChar32(before, &ch);
#else
	    before += Tcl_UtfToUniChar(before, &ch);
#endif
	} else {
	    ch = '%';
	}
	if (type == VALIDATE_BUTTON) {
	    /*
	     * -command %-substitution
	     */

    switch ((enum options) index) {
    case FONT_ACTUAL: {
	int skip, result, n;
	const char *s;
	Tk_Font tkfont;
	Tcl_Obj *optPtr, *charPtr, *resultPtr;
#if TCL_UTF_MAX == 4
	int uniChar = 0;
#else
	Tcl_UniChar uniChar = 0;
#endif
	const TkFontAttributes *faPtr;
	TkFontAttributes fa;

	/*
	 * Params 0 and 1 are 'font actual'. Param 2 is the font name. 3-4 may
	 * be '-displayof $window'
	 */

	}

	/*
	 * The 'charPtr' arg must be a single Unicode.
	 */

	if (charPtr != NULL) {
#if TCL_UTF_MAX == 4
	    Tcl_UniChar *ucPtr;
#endif

	    if (Tcl_GetCharLength(charPtr) != 1) {
		resultPtr = Tcl_NewStringObj(
			"expected a single character but got \"", -1);
		Tcl_AppendLimitedToObj(resultPtr, Tcl_GetString(charPtr),
			-1, 40, "...");
		Tcl_AppendToObj(resultPtr, "\"", -1);
		Tcl_SetObjResult(interp, resultPtr);
		Tcl_SetErrorCode(interp, "TK", "VALUE", "FONT_SAMPLE", NULL);
		return TCL_ERROR;
	    }
#if TCL_UTF_MAX == 4
	    ucPtr = Tcl_GetUnicodeFromObj(charPtr, NULL);
	    uniChar = *ucPtr;
	    if (((uniChar & 0xFC00) == 0xD800) && (ucPtr[1] != 0x000)) {
		if ((ucPtr[1] & 0xFC00) == 0xDC00) {
		    uniChar = ((uniChar & 0x3FF) << 10) + (ucPtr[1] & 0x3FF);
		    uniChar += 0x10000;
		}
	    }
#else
	    uniChar = Tcl_GetUniChar(charPtr, 0);
#endif
	}

	/*
	 * Find the font.
	 */

	tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);

    } else if (strcasecmp(family, "AvantGarde") == 0) {
	family = "AvantGarde";
    } else if (strcasecmp(family, "ZapfChancery") == 0) {
	family = "ZapfChancery";
    } else if (strcasecmp(family, "ZapfDingbats") == 0) {
	family = "ZapfDingbats";
    } else {
#if TCL_UTF_MAX == 4
	int ch;
#else
	Tcl_UniChar ch;
#endif

	/*
	 * Inline, capitalize the first letter of each word, lowercase the
	 * rest of the letters in each word, and then take out the spaces
	 * between the words. This may make the DString shorter, which is safe
	 * to do.
	 */

	Tcl_DStringAppend(dsPtr, family, -1);

	src = dest = Tcl_DStringValue(dsPtr) + len;
	upper = 1;
	for (; *src != '\0'; ) {
	    while (isspace(UCHAR(*src))) { /* INTL: ISO space */
		src++;
		upper = 1;
	    }
#if TCL_UTF_MAX == 4
	    src += TkUtfToUniChar32(src, &ch);
#else
	    src += Tcl_UtfToUniChar(src, &ch);
#endif
	    if (upper) {
		ch = (Tcl_UniChar) Tcl_UniCharToUpper(ch);
		upper = 0;
	    } else {
		ch = (Tcl_UniChar) Tcl_UniCharToLower(ch);
	    }
	    dest += Tcl_UniCharToUtf(ch, dest);

    TextLayout *layoutPtr = (TextLayout *) layout;
    LayoutChunk *chunkPtr = layoutPtr->chunks;
    int baseline = chunkPtr->y;
    Tcl_Obj *psObj = Tcl_NewObj();
    int i, j, len;
    const char *p, *glyphname;
    char uindex[5], c, *ps;
#if TCL_UTF_MAX == 4
    int ch;
#else
    Tcl_UniChar ch;
#endif

    Tcl_AppendToObj(psObj, "[(", -1);
    for (i = 0; i < layoutPtr->numChunks; i++, chunkPtr++) {
	if (baseline != chunkPtr->y) {
	    Tcl_AppendToObj(psObj, ")]\n[(", -1);
	    baseline = chunkPtr->y;
	}

	    /*
	     * INTL: We only handle symbols that have an encoding as a glyph
	     * from the standard set defined by Adobe. The rest get punted.
	     * Eventually this should be revised to handle more sophsticiated
	     * international postscript fonts.
	     */

#if TCL_UTF_MAX == 4
	    p += TkUtfToUniChar32(p, &ch);
#else
	    p += Tcl_UtfToUniChar(p, &ch);
#endif
	    if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) {
		/*
		 * Tricky point: the "03" is necessary in the sprintf below,
		 * so that a full three digits of octal are always generated.
		 * Without the "03", a number following this sequence could be
		 * interpreted by Postscript as part of this sequence.
		 */

	    }

	    /*
	     * This character doesn't belong to the ASCII character set, so we
	     * use the full glyph name.
	     */

#if TCL_UTF_MAX > 3
	    if (ch > 0xffff) {
		goto noMapping;
	    }
#endif
	    sprintf(uindex, "%04X", ch);		/* endianness? */
	    glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, 0);
	    if (glyphname) {
		ps = Tcl_GetStringFromObj(psObj, &len);
		if (ps[len-1] == '(') {
		    /*
		     * In-place edit. Ewww!
		     */

		    ps[len-1] = '/';
		} else {
		    Tcl_AppendToObj(psObj, ")/", -1);
		}
		Tcl_AppendToObj(psObj, glyphname, -1);
		Tcl_AppendToObj(psObj, "(", -1);
	    } else {
		/*
		 * No known mapping for the character into the space of
		 * PostScript glyphs. Ignore it. :-(
		 */
noMapping:	;

#ifdef TK_DEBUG_POSTSCRIPT_OUTPUT
		fprintf(stderr, "Warning: no mapping to PostScript "
			"glyphs for \\u%04x\n", ch);
#endif
	    }
	}

MODULE_SCOPE Status TkParseColor (Display * display,
				Colormap map, const char* spec,
				XColor * colorPtr);
#endif
#ifdef HAVE_XFT
MODULE_SCOPE void	TkUnixSetXftClipRegion(TkRegion clipRegion);
#endif

#if TCL_UTF_MAX == 4
MODULE_SCOPE int	TkUtfToUniChar32(const char *src, int *chPtr);
#endif

/*
 * Unsupported commands.
 */

MODULE_SCOPE int	TkUnsupported1ObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,

    Tcl_Obj *stringPtr)		/* Description of the tab stops. See the text
				 * manual entry for details. */
{
    int objc, i, count;
    Tcl_Obj **objv;
    TkTextTabArray *tabArrayPtr;
    TkTextTab *tabPtr;
#if TCL_UTF_MAX == 4
    int ch;
#else
    Tcl_UniChar ch;
#endif
    double prevStop, lastStop;
    /*
     * Map these strings to TkTextTabAlign values.
     */
    static const char *const tabOptionStrings[] = {
	"left", "right", "center", "numeric", NULL
    };

	    continue;
	}

	/*
	 * There may be a more efficient way of getting this.
	 */

#if TCL_UTF_MAX == 4
	TkUtfToUniChar32(Tcl_GetString(objv[i+1]), &ch);
#else
	Tcl_UtfToUniChar(Tcl_GetString(objv[i+1]), &ch);
#endif
	if (!Tcl_UniCharIsAlpha(ch)) {
	    continue;
	}
	i += 1;

	if (Tcl_GetIndexFromObjStruct(interp, objv[i], tabOptionStrings,
		sizeof(char *), "tab alignment", 0, &index) != TCL_OK) {

		    COUNT_DISPLAY_INDICES);
	}
	segPtr = TkTextIndexToSeg(indexPtr, &offset);
	while (1) {
	    int chSize = 1;

	    if (segPtr->typePtr == &tkTextCharType) {
#if TCL_UTF_MAX == 4
		int ch;
		chSize = TkUtfToUniChar32(segPtr->body.chars + offset, &ch);
#else
		Tcl_UniChar ch;

		chSize = Tcl_UtfToUniChar(segPtr->body.chars + offset, &ch);
#endif
		if (!Tcl_UniCharIsWordChar(ch)) {
		    break;
		}
		firstChar = 0;
	    }
	    offset += chSize;
	    indexPtr->byteIndex += chSize;

	 */

	segPtr = TkTextIndexToSeg(indexPtr, &offset);
	while (1) {
	    int chSize = 1;

	    if (segPtr->typePtr == &tkTextCharType) {
#if TCL_UTF_MAX == 4
		int ch;
		TkUtfToUniChar32(segPtr->body.chars + offset, &ch);
#else
		Tcl_UniChar ch;

		Tcl_UtfToUniChar(segPtr->body.chars + offset, &ch);
#endif
		if (!Tcl_UniCharIsWordChar(ch)) {
		    break;
		}
		if (offset > 0) {
		    chSize = (segPtr->body.chars + offset
			    - Tcl_UtfPrev(segPtr->body.chars + offset,
			    segPtr->body.chars));

    event.virtual.name = Tk_GetUid(eventName);
    if (detail != NULL) {
	event.virtual.user_data = detail;
    }

    Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL);
}

#if TCL_UTF_MAX == 4
/*
 *---------------------------------------------------------------------------
 *
 * TkUtfToUniChar32 --
 *
 *	Copied from Tcl_UtfToUniChar but using int instead of Tcl_UniChar!
 *
 *	Extract the Tcl_UniChar represented by the UTF-8 string. Bad UTF-8
 *	sequences are converted to valid Tcl_UniChars and processing
 *	continues. Equivalent to Plan 9 chartorune().
 *
 *	The caller must ensure that the source buffer is long enough that this
 *	routine does not run off the end and dereference non-existent memory
 *	looking for trail bytes. If the source buffer is known to be '\0'
 *	terminated, this cannot happen. Otherwise, the caller should call
 *	Tcl_UtfCharComplete() before calling this routine to ensure that
 *	enough bytes remain in the string.
 *
 * Results:
 *	*chPtr is filled with the Tcl_UniChar, and the return value is the
 *	number of bytes from the UTF-8 string that were consumed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkUtfToUniChar32(
    const char *src,	/* The UTF-8 string. */
    int *chPtr)		/* Filled with the Tcl_UniChar represented by
			 * the UTF-8 string. */
{
    int byte;

    /*
     * Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones.
     */

    byte = *((unsigned char *) src);
    if (byte < 0xC0) {
	/*
	 * Handles properly formed UTF-8 characters between 0x01 and 0x7F.
	 * Also treats \0 and naked trail bytes 0x80 to 0xBF as valid
	 * characters representing themselves.
	 */

	*chPtr = byte;
	return 1;
    } else if (byte < 0xE0) {
	if ((src[1] & 0xC0) == 0x80) {
	    /*
	     * Two-byte-character lead-byte followed by a trail-byte.
	     */

	    *chPtr = ((byte & 0x1F) << 6) | (src[1] & 0x3F);
	    return 2;
	}

	/*
	 * A two-byte-character lead-byte not followed by trail-byte
	 * represents itself.
	 */
    } else if (byte < 0xF0) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
	    /*
	     * Three-byte-character lead byte followed by two trail bytes.
	     */

	    *chPtr = ((byte & 0x0F) << 12)
		    | ((src[1] & 0x3F) << 6) | (src[2] & 0x3F);
	    return 3;
	}

	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    } else if (byte < 0xF8) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
	    /*
	     * Four-byte-character lead byte followed by three trail bytes.
	     */

	    *chPtr = ((byte & 0x0E) << 18) | ((src[1] & 0x3F) << 12)
		    | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F);
	    return 4;
	}

	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    }

    *chPtr = byte;
    return 1;
}
#endif
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

 * 	of (the first character in the string) 'showChar'.
 * 	Used to compute the displayString if -show is non-NULL.
 */
static char *EntryDisplayString(const char *showChar, int numChars)
{
    char *displayString, *p;
    int size;

    char buf[4];
#if TCL_UTF_MAX == 4
    int ch;

    TkUtfToUniChar32(showChar, &ch);
#else
    Tcl_UniChar ch;

    Tcl_UtfToUniChar(showChar, &ch);
#endif
    size = Tcl_UniCharToUtf(ch, buf);
    p = displayString = ckalloc(numChars * size + 1);

    while (numChars--) {
	memcpy(p, buf, size);
	p += size;
    }

     VREASON reason,		/* Reason for change */
     Tcl_DString *dsPtr)	/* Result of %-substitutions */
{
    int spaceNeeded, cvtFlags;
    int number, length;
    const char *string;
    int stringLength;
#if TCL_UTF_MAX == 4
    int ch;
#else
    Tcl_UniChar ch;
#endif
    char numStorage[2*TCL_INTEGER_SPACE];

    while (*template) {
	/* Find everything up to the next % character and append it
	 * to the result string.
	 */
	string = Tcl_UtfFindFirst(template, '%');

	    template = string;
	}

	/* There's a percent sequence here.  Process it.
	 */
	++template; /* skip over % */
	if (*template != '\0') {
#if TCL_UTF_MAX == 4
	    template += TkUtfToUniChar32(template, &ch);
#else
	    template += Tcl_UtfToUniChar(template, &ch);
#endif
	} else {
	    ch = '%';
	}

	stringLength = -1;
	switch (ch) {
	    case 'd': /* Type of call that caused validation */

 * character existence metrics, used to determine if a screen font can display
 * a given Unicode character.
 *
 * Under Unix, there are three attributes that uniquely identify a "font
 * family": the foundry, face name, and charset.
 */

#if TCL_UTF_MAX > 3
#define FONTMAP_SHIFT		12
#define FONTMAP_PAGES		(1 << (21 - FONTMAP_SHIFT))
#else
#define FONTMAP_SHIFT		10
#define FONTMAP_PAGES		(1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT))
#endif
#define FONTMAP_BITSPERPAGE	(1 << FONTMAP_SHIFT)

typedef struct FontFamily {
    struct FontFamily *nextPtr;	/* Next in list of all known font families. */
    int refCount;		/* How many SubFonts are referring to this
				 * FontFamily. When the refCount drops to
				 * zero, this FontFamily may be freed. */

 * the information isn't retrievable from the GC.
 */

typedef struct ThreadSpecificData {
    Region clipRegion;		/* The clipping region, or None. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#if TCL_UTF_MAX == 4
#define	UtfToUniChar(src, chPtr) TkUtfToUniChar32(src, chPtr)
#else
#define	UtfToUniChar(src, chPtr) Tcl_UtfToUniChar(src, chPtr)
#endif

/*
 * Package initialization:
 * 	Nothing to do here except register the fact that we're using Xft in
 * 	the TIP 59 configuration database.
 */

    int len = 0;
#endif /* DEBUG_FONTSEL */

    curX = 0;
    curByte = 0;
    sawNonSpace = 0;
    while (numBytes > 0) {
#if TCL_UTF_MAX == 4
	int unichar;
#else
	Tcl_UniChar unichar;
#endif

	clen = UtfToUniChar(source, &unichar);
	c = (FcChar32) unichar;

	if (clen <= 0) {
	    /*
	     * This can't happen (but see #1185640)
	     */

 * instance of this structure. The most important shared property is the
 * character existence metrics, used to determine if a screen font can display
 * a given Unicode character.
 *
 * Under Windows, a "font family" is uniquely identified by its face name.
 */

#if TCL_UTF_MAX > 3
#define FONTMAP_SHIFT		12
#define FONTMAP_PAGES	    	(1 << (21 - FONTMAP_SHIFT))
#else
#define FONTMAP_SHIFT		10
#define FONTMAP_PAGES		(1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT))
#endif
#define FONTMAP_BITSPERPAGE	(1 << FONTMAP_SHIFT)

typedef struct FontFamily {
    struct FontFamily *nextPtr;	/* Next in list of all known font families. */
    size_t refCount;		/* How many SubFonts are referring to this
				 * FontFamily. When the refCount drops to
				 * zero, this FontFamily may be freed. */

static void		ReleaseFont(WinFont *fontPtr);
static inline void	ReleaseSubFont(SubFont *subFontPtr);
static int		SeenName(const char *name, Tcl_DString *dsPtr);
static inline HFONT	SelectFont(HDC hdc, WinFont *fontPtr,
			    SubFont *subFontPtr, double angle);
static inline void	SwapLong(PULONG p);
static inline void	SwapShort(USHORT *p);
#if TCL_UTF_MAX == 4
#define			UtfToUniChar(src, chPtr) TkUtfToUniChar32(src, chPtr)
#else
#define			UtfToUniChar(src, chPtr) Tcl_UtfToUniChar(src, chPtr)
#endif
static int CALLBACK	WinFontCanUseProc(ENUMLOGFONT *lfPtr,
			    NEWTEXTMETRIC *tmPtr, int fontType,
			    LPARAM lParam);
static int CALLBACK	WinFontExistProc(ENUMLOGFONT *lfPtr,
			    NEWTEXTMETRIC *tmPtr, int fontType,
			    LPARAM lParam);
static int CALLBACK	WinFontFamilyEnumProc(ENUMLOGFONT *lfPtr,

    int *lengthPtr)		/* Filled with x-location just after the
				 * terminating character. */
{
    HDC hdc;
    HFONT oldFont;
    WinFont *fontPtr;
    int curX, moretomeasure;
#if TCL_UTF_MAX == 4
    int ch;
#else
    Tcl_UniChar ch;
#endif
    SIZE size;
    FontFamily *familyPtr;
    Tcl_DString runString;
    SubFont *thisSubFontPtr, *lastSubFontPtr;
    const char *p, *end, *next = NULL, *start;

    if (numBytes == 0) {

     */

    moretomeasure = 0;
    curX = 0;
    start = source;
    end = start + numBytes;
    for (p = start; p < end; ) {
	next = p + UtfToUniChar(p, &ch);
	thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr);
	if (thisSubFontPtr != lastSubFontPtr) {
	    familyPtr = lastSubFontPtr->familyPtr;
	    Tcl_UtfToExternalDString(familyPtr->encoding, start,
		    (int) (p - start), &runString);
	    size.cx = 0;
	    familyPtr->getTextExtentPoint32Proc(hdc,

	char buf[16];
	int dstWrote;
	int lastSize = 0;

	familyPtr = lastSubFontPtr->familyPtr;
	Tcl_DStringInit(&runString);
	for (p = start; p < end; ) {
	    next = p + UtfToUniChar(p, &ch);
	    Tcl_UtfToExternal(NULL, familyPtr->encoding, p,
		    (int) (next - p), 0, NULL, buf, sizeof(buf), NULL,
		    &dstWrote, NULL);
	    Tcl_DStringAppend(&runString,buf,dstWrote);
	    size.cx = 0;
	    familyPtr->getTextExtentPoint32Proc(hdc,
		    (TCHAR *) Tcl_DStringValue(&runString),

    if ((flags & TK_WHOLE_WORDS) && (p < end)) {
	/*
	 * Scan the string for the last word break and than repeat the whole
	 * procedure without the maxLength limit or any flags.
	 */

	const char *lastWordBreak = NULL;
#if TCL_UTF_MAX == 4
	int ch2;
#else
	Tcl_UniChar ch2;
#endif

	end = p;
	p = source;
	ch = ' ';
	while (p < end) {
	    next = p + UtfToUniChar(p, &ch2);
	    if ((ch != ' ') && (ch2 == ' ')) {
		lastWordBreak = p;
	    }
	    p = next;
	    ch = ch2;
	}

				 * following string. */
    const char *source,		/* Potentially multilingual UTF-8 string. */
    int numBytes,		/* Length of string in bytes. */
    int x, int y,		/* Coordinates at which to place origin of
				 * string when drawing. */
    double angle)
{
#if TCL_UTF_MAX == 4
    int ch;
#else
    Tcl_UniChar ch;
#endif
    SIZE size;
    HFONT oldFont;
    FontFamily *familyPtr;
    Tcl_DString runString;
    const char *p, *end, *next;
    SubFont *lastSubFontPtr, *thisSubFontPtr;
    TEXTMETRICA tm;

    lastSubFontPtr = &fontPtr->subFontArray[0];
    oldFont = SelectFont(hdc, fontPtr, lastSubFontPtr, angle);
    GetTextMetricsA(hdc, &tm);

    end = source + numBytes;
    for (p = source; p < end; ) {
	next = p + UtfToUniChar(p, &ch);
	thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr);
	if (thisSubFontPtr != lastSubFontPtr) {
	    if (p > source) {
		familyPtr = lastSubFontPtr->familyPtr;
 		Tcl_UtfToExternalDString(familyPtr->encoding, source,
			(int) (p - source), &runString);
		familyPtr->textOutProc(hdc, x-(tm.tmOverhang/2), y,

    SubFont *subFontPtr,	/* Contains font mapping cache to be
				 * updated. */
    int row)			/* Index of the page to be loaded into the
				 * cache. */
{
    FontFamily *familyPtr;
    Tcl_Encoding encoding;
    char src[TCL_UTF_MAX], buf[16];
    USHORT *startCount, *endCount;
    int i, j, bitOffset, end, segCount;

    subFontPtr->fontMap[row] = ckalloc(FONTMAP_BITSPERPAGE / 8);
    memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);

    familyPtr = subFontPtr->familyPtr;

	unichar <<= 8;
	unichar |= keyEv->trans_chars[0] & 0xff;

	len = Tcl_UniCharToUtf((Tcl_UniChar) unichar, buf);

	Tcl_DStringAppend(dsPtr, buf, len);
    } else if (keyEv->send_event == -3) {

	char buf[XMaxTransChars];
	int len;

	/*
	 * Special case for WM_UNICHAR.
	 */

	len = Tcl_UniCharToUtf(keyEv->keycode, buf);
	if ((keyEv->keycode <= 0xffff) || (len > 3)) {
	    Tcl_DStringAppend(dsPtr, buf, len);
	} else {
	    Tcl_UniCharToUtf(((keyEv->keycode - 0x10000) >> 10) | 0xd800, buf);
	    Tcl_DStringAppend(dsPtr, buf, 3);
	    Tcl_UniCharToUtf(((keyEv->keycode - 0x10000) & 0x3ff) | 0xdc00, buf);
	    Tcl_DStringAppend(dsPtr, buf, 3);
	}