Fix [6c0d7aec6713ab6a7c3e12dff7f26bff4679bc9d|6c0d7aec67]: unicode text input Windows 8. Added some test-cases using the "font actual" command.

12 files changed, 93 insertions, 51 deletions

diff --git a/generic/tkEntry.c b/generic/tkEntry.c
index c0ce47b..9e25bed 100644
--- a/generic/tkEntry.c
+++ b/generic/tkEntry.c
@@ -1924,8 +1924,8 @@ EntryComputeGeometry(
      */
 
     if (entryPtr->showChar != NULL) {
-	Tcl_UniChar ch;
-	char buf[TCL_UTF_MAX];
+	int ch;
+	char buf[6];
 	int size;
 
 	/*
@@ -1935,8 +1935,8 @@ EntryComputeGeometry(
 	 * resulting string.
 	 */
 
-	Tcl_UtfToUniChar(entryPtr->showChar, &ch);
-	size = Tcl_UniCharToUtf(ch, buf);
+	TkUtfToUniChar(entryPtr->showChar, &ch);
+	size = TkUniCharToUtf(ch, buf);
 
 	entryPtr->numDisplayBytes = entryPtr->numChars * size;
 	p = ckalloc(entryPtr->numDisplayBytes + 1);
@@ -3412,7 +3412,7 @@ ExpandPercents(
 				 * list element. */
     int number, length;
     register const char *string;
-    Tcl_UniChar ch;
+    int ch;
     char numStorage[2*TCL_INTEGER_SPACE];
 
     while (1) {
@@ -3445,7 +3445,7 @@ ExpandPercents(
 
 	before++; /* skip over % */
 	if (*before != '\0') {
-	    before += Tcl_UtfToUniChar(before, &ch);
+	    before += TkUtfToUniChar(before, &ch);
 	} else {
 	    ch = '%';
 	}
@@ -3465,7 +3465,7 @@ ExpandPercents(
 		string = Tk_PathName(entryPtr->tkwin);
 		break;
 	    default:
-		length = Tcl_UniCharToUtf(ch, numStorage);
+		length = TkUniCharToUtf(ch, numStorage);
 		numStorage[length] = '\0';
 		string = numStorage;
 		break;
@@ -3525,7 +3525,7 @@ ExpandPercents(
 		string = Tk_PathName(entryPtr->tkwin);
 		break;
 	    default:
-		length = Tcl_UniCharToUtf(ch, numStorage);
+		length = TkUniCharToUtf(ch, numStorage);
 		numStorage[length] = '\0';
 		string = numStorage;
 		break;
diff --git a/generic/tkFont.c b/generic/tkFont.c
index 102fc6e..51b2fce 100644
--- a/generic/tkFont.c
+++ b/generic/tkFont.c
@@ -13,6 +13,7 @@
 
 #include "tkInt.h"
 #include "tkFont.h"
+#include <windows.h>
 
 /*
  * The following structure is used to keep track of all the fonts that exist
@@ -497,7 +498,7 @@ Tk_FontObjCmd(
 	const char *s;
 	Tk_Font tkfont;
 	Tcl_Obj *optPtr, *charPtr, *resultPtr;
-	Tcl_UniChar uniChar = 0;
+	int uniChar = 0;
 	const TkFontAttributes *faPtr;
 	TkFontAttributes fa;
 
@@ -562,17 +563,19 @@ Tk_FontObjCmd(
 	 */
 
 	if (charPtr != NULL) {
-	    if (Tcl_GetCharLength(charPtr) != 1) {
+	    const char *string = Tcl_GetString(charPtr);
+	    int len = TkUtfToUniChar(string, &uniChar);
+
+	    if (len != charPtr->length) {
 		resultPtr = Tcl_NewStringObj(
 			"expected a single character but got \"", -1);
-		Tcl_AppendLimitedToObj(resultPtr, Tcl_GetString(charPtr),
+		Tcl_AppendLimitedToObj(resultPtr, string,
 			-1, 40, "...");
 		Tcl_AppendToObj(resultPtr, "\"", -1);
 		Tcl_SetObjResult(interp, resultPtr);
 		Tcl_SetErrorCode(interp, "TK", "VALUE", "FONT_SAMPLE", NULL);
 		return TCL_ERROR;
 	    }
-	    uniChar = Tcl_GetUniChar(charPtr, 0);
 	}
 
 	/*
@@ -1694,7 +1697,7 @@ Tk_PostscriptFontName(
     } else if (strcasecmp(family, "ZapfDingbats") == 0) {
 	family = "ZapfDingbats";
     } else {
-	Tcl_UniChar ch;
+	int ch;
 
 	/*
 	 * Inline, capitalize the first letter of each word, lowercase the
@@ -1712,14 +1715,14 @@ Tk_PostscriptFontName(
 		src++;
 		upper = 1;
 	    }
-	    src += Tcl_UtfToUniChar(src, &ch);
+	    src += TkUtfToUniChar(src, &ch);
 	    if (upper) {
 		ch = Tcl_UniCharToUpper(ch);
 		upper = 0;
 	    } else {
 		ch = Tcl_UniCharToLower(ch);
 	    }
-	    dest += Tcl_UniCharToUtf(ch, dest);
+	    dest += TkUniCharToUtf(ch, dest);
 	}
 	*dest = '\0';
 	Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
@@ -3249,7 +3252,7 @@ Tk_TextLayoutToPostscript(
     int i, j, len;
     const char *p, *glyphname;
     char uindex[5], c, *ps;
-    Tcl_UniChar ch;
+    int ch;
 
     Tcl_AppendToObj(psObj, "[(", -1);
     for (i = 0; i < layoutPtr->numChunks; i++, chunkPtr++) {
@@ -3272,7 +3275,7 @@ Tk_TextLayoutToPostscript(
 	     * international postscript fonts.
 	     */
 
-	    p += Tcl_UtfToUniChar(p, &ch);
+	    p += TkUtfToUniChar(p, &ch);
 	    if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) {
 		/*
 		 * Tricky point: the "03" is necessary in the sprintf below,
@@ -3298,6 +3301,9 @@ Tk_TextLayoutToPostscript(
 	     * use the full glyph name.
 	     */
 
+	    if (ch > 0xffff) {
+		goto noMapping;
+	    }
 	    sprintf(uindex, "%04X", ch);		/* endianness? */
 	    glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, 0);
 	    if (glyphname) {
@@ -3318,6 +3324,7 @@ Tk_TextLayoutToPostscript(
 		 * 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 "
diff --git a/generic/tkText.c b/generic/tkText.c
index 0e41ac8..412a7f2 100644
--- a/generic/tkText.c
+++ b/generic/tkText.c
@@ -4459,7 +4459,7 @@ TkTextGetTabs(
     Tcl_Obj **objv;
     TkTextTabArray *tabArrayPtr;
     TkTextTab *tabPtr;
-    Tcl_UniChar ch;
+    int ch;
     double prevStop, lastStop;
     /*
      * Map these strings to TkTextTabAlign values.
@@ -4566,7 +4566,7 @@ TkTextGetTabs(
 	 * There may be a more efficient way of getting this.
 	 */
 
-	Tcl_UtfToUniChar(Tcl_GetString(objv[i+1]), &ch);
+	TkUtfToUniChar(Tcl_GetString(objv[i+1]), &ch);
 	if (!Tcl_UniCharIsAlpha(ch)) {
 	    continue;
 	}
@@ -5880,7 +5880,7 @@ SearchCore(
 
 	    CLANG_ASSERT(pattern);
 	    do {
-		Tcl_UniChar ch;
+		int ch;
 		const char *p;
 		int lastFullLine = lastOffset;
 
@@ -6110,7 +6110,7 @@ SearchCore(
 			}
 		    } else {
 			firstOffset = p - startOfLine +
-				Tcl_UtfToUniChar(startOfLine+matchOffset,&ch);
+				TkUtfToUniChar(startOfLine+matchOffset,&ch);
 		    }
 		}
 	    } while (searchSpecPtr->all);
diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c
index a135084..f28ec6a 100644
--- a/generic/tkTextDisp.c
+++ b/generic/tkTextDisp.c
@@ -7581,8 +7581,8 @@ TkTextCharLayoutProc(
 
     if (bytesThatFit < maxBytes) {
 	if ((bytesThatFit == 0) && noCharsYet) {
-	    Tcl_UniChar ch;
-	    int chLen = Tcl_UtfToUniChar(p, &ch);
+	    int ch;
+	    int chLen = TkUtfToUniChar(p, &ch);
 
 #if TK_LAYOUT_WITH_BASE_CHUNKS
 	    bytesThatFit = CharChunkMeasureChars(chunkPtr, line,
diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c
index 8820191..d227bd8 100644
--- a/generic/tkTextIndex.c
+++ b/generic/tkTextIndex.c
@@ -2298,9 +2298,9 @@ StartEnd(
 	    int chSize = 1;
 
 	    if (segPtr->typePtr == &tkTextCharType) {
-		Tcl_UniChar ch;
+		int ch;
 
-		chSize = Tcl_UtfToUniChar(segPtr->body.chars + offset, &ch);
+		chSize = TkUtfToUniChar(segPtr->body.chars + offset, &ch);
 		if (!Tcl_UniCharIsWordChar(ch)) {
 		    break;
 		}
@@ -2343,9 +2343,9 @@ StartEnd(
 	    int chSize = 1;
 
 	    if (segPtr->typePtr == &tkTextCharType) {
-		Tcl_UniChar ch;
 
-		Tcl_UtfToUniChar(segPtr->body.chars + offset, &ch);
+		int ch;
+		TkUtfToUniChar(segPtr->body.chars + offset, &ch);
 		if (!Tcl_UniCharIsWordChar(ch)) {
 		    break;
 		}
diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c
index 533637d..a25574a 100644
--- a/generic/ttk/ttkEntry.c
+++ b/generic/ttk/ttkEntry.c
@@ -282,11 +282,11 @@ static char *EntryDisplayString(const char *showChar, int numChars)
 {
     char *displayString, *p;
     int size;
-    Tcl_UniChar ch;
-    char buf[TCL_UTF_MAX];
+    int ch;
+    char buf[6];
 
-    Tcl_UtfToUniChar(showChar, &ch);
-    size = Tcl_UniCharToUtf(ch, buf);
+    TkUtfToUniChar(showChar, &ch);
+    size = TkUniCharToUtf(ch, buf);
     p = displayString = ckalloc(numChars * size + 1);
 
     while (numChars--) {
@@ -406,7 +406,7 @@ ExpandPercents(
     int number, length;
     const char *string;
     int stringLength;
-    Tcl_UniChar ch;
+    int ch;
     char numStorage[2*TCL_INTEGER_SPACE];
 
     while (*template) {
@@ -430,7 +430,7 @@ ExpandPercents(
 	 */
 	++template; /* skip over % */
 	if (*template != '\0') {
-	    template += Tcl_UtfToUniChar(template, &ch);
+	    template += TkUtfToUniChar(template, &ch);
 	} else {
 	    ch = '%';
 	}
@@ -480,7 +480,7 @@ ExpandPercents(
 		string = Tk_PathName(entryPtr->core.tkwin);
 		break;
 	    default:
-		length = Tcl_UniCharToUtf(ch, numStorage);
+		length = TkUniCharToUtf(ch, numStorage);
 		numStorage[length] = '\0';
 		string = numStorage;
 		break;
diff --git a/tests/entry.test b/tests/entry.test
index d27ffb5..1be1d2d 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -2920,6 +2920,11 @@ test entry-16.4 {EntryVisibleRange procedure} -body {
 } -cleanup {
     destroy .e
 } -result {0.000000 1.000000}
+test entry-16.5 {Unicode handling in entry widget} -body {
+    entry .e -show abc
+} -cleanup {
+    destroy .e
+} -result {0.000000 1.000000}
 
 
 test entry-17.1 {EntryUpdateScrollbar procedure} -body {
diff --git a/tests/font.test b/tests/font.test
index 9e44a93..23e09c4 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -145,6 +145,18 @@ test font-4.10 {font command: actual} -constraints win -body {
 test font-4.11 {font command: bad option} -body {
     font actual xyz -style
 } -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}
+test font-4.12 {font command: actual} -body {
+    font actual {-family times} -- \ud800
+} -match glob -result {*}
+test font-4.13 {font command: actual} -body {
+    font actual {-family times} -- \udc00
+} -match glob -result {*}
+test font-4.14 {font command: actual} -constraints win -body {
+    font actual {-family times} -family -- \ud800\udc00
+} -result {Times New Roman}
+test font-4.15 {font command: actual} -body {
+    font actual {-family times} -- \udc00\ud800
+} -returnCodes 1 -match glob -result {expected a single character but got "*"}
 
 
 test font-5.1 {font command: configure} -body {
diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c
index af9bb95..4a466f1 100644
--- a/unix/tkUnixFont.c
+++ b/unix/tkUnixFont.c
@@ -406,7 +406,7 @@ ControlUtfProc(
 {
     const char *srcStart, *srcEnd;
     char *dstStart, *dstEnd;
-    Tcl_UniChar ch;
+    int ch;
     int result;
     static char hexChars[] = "0123456789abcdef";
     static char mapChars[] = {
@@ -427,9 +427,9 @@ ControlUtfProc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-	src += Tcl_UtfToUniChar(src, &ch);
+	src += TkUtfToUniChar(src, &ch);
 	dst[0] = '\\';
-	if ((ch < sizeof(mapChars)) && (mapChars[ch] != 0)) {
+	if (((size_t) ch < sizeof(mapChars)) && (mapChars[ch] != 0)) {
 	    dst[1] = mapChars[ch];
 	    dst += 2;
 	} else if (ch < 256) {
@@ -437,13 +437,21 @@ ControlUtfProc(
 	    dst[2] = hexChars[(ch >> 4) & 0xf];
 	    dst[3] = hexChars[ch & 0xf];
 	    dst += 4;
-	} else {
+	} else if (ch < 0x10000) {
 	    dst[1] = 'u';
 	    dst[2] = hexChars[(ch >> 12) & 0xf];
 	    dst[3] = hexChars[(ch >> 8) & 0xf];
 	    dst[4] = hexChars[(ch >> 4) & 0xf];
 	    dst[5] = hexChars[ch & 0xf];
 	    dst += 6;
+	} else {
+	    /* TODO we can do better here */
+	    dst[1] = 'u';
+	    dst[2] = 'f';
+	    dst[3] = 'f';
+	    dst[4] = 'f';
+	    dst[5] = 'd';
+	    dst += 6;
 	}
     }
     *srcReadPtr = src - srcStart;
@@ -1028,7 +1036,7 @@ Tk_MeasureChars(
 	curByte = 0;
     } else if (maxLength < 0) {
 	const char *p, *end, *next;
-	Tcl_UniChar ch;
+	int ch;
 	SubFont *thisSubFontPtr;
 	FontFamily *familyPtr;
 	Tcl_DString runString;
@@ -1044,7 +1052,7 @@ Tk_MeasureChars(
 	curX = 0;
 	end = source + numBytes;
 	for (p = source; p < end; ) {
-	    next = p + Tcl_UtfToUniChar(p, &ch);
+	    next = p + TkUtfToUniChar(p, &ch);
 	    thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr);
 	    if (thisSubFontPtr != lastSubFontPtr) {
 		familyPtr = lastSubFontPtr->familyPtr;
diff --git a/unix/tkUnixRFont.c b/unix/tkUnixRFont.c
index 8caa5ff..41cd096 100644
--- a/unix/tkUnixRFont.c
+++ b/unix/tkUnixRFont.c
@@ -668,9 +668,9 @@ Tk_MeasureChars(
     curByte = 0;
     sawNonSpace = 0;
     while (numBytes > 0) {
-	Tcl_UniChar unichar;
+	int unichar;
 
-	clen = Tcl_UtfToUniChar(source, &unichar);
+	clen = TkUtfToUniChar(source, &unichar);
 	c = (FcChar32) unichar;
 
 	if (clen <= 0) {
diff --git a/win/tkWinFont.c b/win/tkWinFont.c
index 10ea1b9..47c4c3c 100644
--- a/win/tkWinFont.c
+++ b/win/tkWinFont.c
@@ -828,7 +828,7 @@ Tk_MeasureChars(
     HFONT oldFont;
     WinFont *fontPtr;
     int curX, moretomeasure;
-    Tcl_UniChar ch;
+    int ch;
     SIZE size;
     FontFamily *familyPtr;
     Tcl_DString runString;
@@ -859,7 +859,7 @@ Tk_MeasureChars(
     start = source;
     end = start + numBytes;
     for (p = start; p < end; ) {
-	next = p + Tcl_UtfToUniChar(p, &ch);
+	next = p + TkUtfToUniChar(p, &ch);
 	thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr);
 	if (thisSubFontPtr != lastSubFontPtr) {
 	    familyPtr = lastSubFontPtr->familyPtr;
@@ -921,7 +921,7 @@ Tk_MeasureChars(
 	familyPtr = lastSubFontPtr->familyPtr;
 	Tcl_DStringInit(&runString);
 	for (p = start; p < end; ) {
-	    next = p + Tcl_UtfToUniChar(p, &ch);
+	    next = p + TkUtfToUniChar(p, &ch);
 	    Tcl_UtfToExternal(NULL, familyPtr->encoding, p,
 		    (int) (next - p), 0, NULL, buf, sizeof(buf), NULL,
 		    &dstWrote, NULL);
@@ -970,13 +970,13 @@ Tk_MeasureChars(
 	 */
 
 	const char *lastWordBreak = NULL;
-	Tcl_UniChar ch2;
+	int ch2;
 
 	end = p;
 	p = source;
 	ch = ' ';
 	while (p < end) {
-	    next = p + Tcl_UtfToUniChar(p, &ch2);
+	    next = p + TkUtfToUniChar(p, &ch2);
 	    if ((ch != ' ') && (ch2 == ' ')) {
 		lastWordBreak = p;
 	    }
@@ -1443,7 +1443,7 @@ MultiFontTextOut(
 				 * string when drawing. */
     double angle)
 {
-    Tcl_UniChar ch;
+    int ch;
     SIZE size;
     HFONT oldFont;
     FontFamily *familyPtr;
@@ -1458,7 +1458,7 @@ MultiFontTextOut(
 
     end = source + numBytes;
     for (p = source; p < end; ) {
-	next = p + Tcl_UtfToUniChar(p, &ch);
+	next = p + TkUtfToUniChar(p, &ch);
 	thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr);
 	if (thisSubFontPtr != lastSubFontPtr) {
 	    if (p > source) {
@@ -1940,7 +1940,8 @@ FindSubFontForChar(
     SubFont *subFontPtr;
     Tcl_DString ds;
 
-    if (ch < BASE_CHARS) {
+
+    if ((ch < BASE_CHARS) || (ch >= 0x10000)) {
 	return &fontPtr->subFontArray[0];
     }
 
diff --git a/win/tkWinX.c b/win/tkWinX.c
index 5771a29..b2424ce 100644
--- a/win/tkWinX.c
+++ b/win/tkWinX.c
@@ -1526,7 +1526,7 @@ TkWinGetUnicodeEncoding(void)
  *
  * HandleIMEComposition --
  *
- *	This function works around a definciency in some versions of Windows
+ *	This function works around a deficiency in some versions of Windows
  *	2000 to make it possible to entry multi-lingual characters under all
  *	versions of Windows 2000.
  *
@@ -1556,6 +1556,7 @@ HandleIMEComposition(
 {
     HIMC hIMC;
     int n;
+    int high = 0;
 
     if ((lParam & GCS_RESULTSTR) == 0) {
 	/*
@@ -1612,6 +1613,14 @@ HandleIMEComposition(
 
 	    event.xkey.keycode = buff[i++];
 
+	    if ((event.xkey.keycode & 0xfc00) == 0xd800) {
+		high = ((event.xkey.keycode & 0x3ff) << 10) + 0x10000;
+		break;
+	    } else if (high && (event.xkey.keycode & 0xfc00) == 0xdc00) {
+		event.xkey.keycode &= 0x3ff;
+		event.xkey.keycode += high;
+		high = 0;
+	    }
 	    event.type = KeyPress;
 	    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);