Finally dealt with 614650 and with a simpler solution too.

3 files changed, 24 insertions, 89 deletions

diff --git a/ChangeLog b/ChangeLog
index 792131b..ed7536f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2002-10-01  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* tests/unixSelect.test (unixSelect-1.1[89]): Altered these tests
+	to work around [Bug #616923]
+	* unix/tkUnixSelect.c (SelRcvIncrProc,TkSelPropProc): It turns out
+	a much simpler and more robust solution is possible if we leverage
+	Tcl's encoding engine by using the same code path as for the
+	normal string selection.  It might be a bit slower, but it should
+	be a lot more correct.  [Bug #614650]
+
 2002-09-30  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* tests/panedwindow.test: added panedwindow-28.[12]
diff --git a/tests/unixSelect.test b/tests/unixSelect.test
index 9e0b35b..efe11a8 100644
--- a/tests/unixSelect.test
+++ b/tests/unixSelect.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: unixSelect.test,v 1.6 2002/09/30 15:22:08 dkf Exp $
+# RCS: @(#) $Id: unixSelect.test,v 1.7 2002/10/01 08:48:09 dkf Exp $
 
 package require tcltest 2.1
 namespace import -force tcltest::configure
@@ -324,7 +324,9 @@ test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO
     setupbg
     dobg {
 	text .t; pack .t; update
-	.t insert 1.0 [string repeat [string repeat \u00c4\u00e4 50]\n 21] sel
+	.t insert 1.0 [string repeat [string repeat \u00c4\u00e4 50]\n 21]
+	# Has to be selected in a separate stage
+	.t tag add sel 1.0 21.end+1c
     }
     after 10
     set x [selection get -type UTF8_STRING]
@@ -336,7 +338,9 @@ test unixSelect-1.19 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO
     setupbg
     dobg {
 	text .t; pack .t; update
-	.t insert 1.0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21] sel
+	.t insert 1.0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21]
+	# Has to be selected in a separate stage
+	.t tag add sel 1.0 21.end+1c
     }
     after 10
     set x [selection get -type UTF8_STRING]
diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c
index 1f45db2..92add7f 100644
--- a/unix/tkUnixSelect.c
+++ b/unix/tkUnixSelect.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkUnixSelect.c,v 1.10 2002/09/30 13:42:26 dkf Exp $
+ * RCS: @(#) $Id: tkUnixSelect.c,v 1.11 2002/10/01 08:48:08 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -363,6 +363,7 @@ TkSelPropProc(eventPtr)
 	     */
 
 	    if ((formatType == XA_STRING)
+		    || (dispPtr && formatType==dispPtr->utf8Atom)
 		    || (dispPtr && formatType==dispPtr->compoundTextAtom)) {
 		Tcl_DString ds;
 		int encodingCvtFlags;
@@ -384,6 +385,8 @@ TkSelPropProc(eventPtr)
 		}
 		if (formatType == XA_STRING) {
 		    encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+		} else if (dispPtr && formatType==dispPtr->utf8Atom) {
+		    encoding = Tcl_GetEncoding(NULL, "utf-8");
 		} else {
 		    encoding = Tcl_GetEncoding(NULL, "iso2022");
 		}
@@ -449,43 +452,6 @@ TkSelPropProc(eventPtr)
 		}
 		memcpy(incrPtr->converts[i].buffer, src, (size_t) srcLen+1);
 		Tcl_DStringFree(&ds);
-	    } else if (dispPtr && formatType==dispPtr->utf8Atom) {
-		/*
-		 * Detect if the last character was a complete UTF-8
-		 * character; if not, it is not a good idea to send it
-		 * to the remote end as there's no telling whether the
-		 * other side will be able to digest partial
-		 * characters.
-		 *
-		 * Note that utfLength is calculated and then potentially
-		 * recalculated...
-		 */
-		CONST char *utfBuffer = (CONST char *) buffer;
-		CONST char *lastChar =
-			Tcl_UtfPrev(utfBuffer+numItems, utfBuffer);
-		int utfLength = lastChar-utfBuffer;
-
-		if (numItems-utfLength > TCL_UTF_MAX) {
-		    panic("Tcl_UtfPrev scanned backward over more than one character");
-		}
-		if (!Tcl_UtfCharComplete(lastChar, numItems-utfLength)) {
-		    /*
-		     * numItems must not be reduced, so we need to set
-		     * the length of the bits we want to subtract off
-		     * it here.  Horrid!
-		     */
-		    length = numItems - utfLength;
-		} else {
-		    /*
-		     * We want to shovel all the data we've got across
-		     */
-		    utfLength = numItems;
-		}
-
-		XChangeProperty(eventPtr->xproperty.display,
-			eventPtr->xproperty.window, eventPtr->xproperty.atom,
-			formatType, 8, PropModeReplace,
-			(unsigned char *) utfBuffer, utfLength);
 	    } else {
 		/*
 		 * Set the property to the encoded string value.
@@ -1182,6 +1148,7 @@ SelRcvIncrProc(clientData, eventPtr)
     }
     if ((type == XA_STRING)
 	    || (type == retrPtr->winPtr->dispPtr->textAtom)
+	    || (type == retrPtr->winPtr->dispPtr->utf8Atom)
 	    || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
 	char *dst, *src;
 	int srcLen, dstLen, srcRead, dstWrote, soFar;
@@ -1203,6 +1170,8 @@ SelRcvIncrProc(clientData, eventPtr)
 
 	if (type == retrPtr->winPtr->dispPtr->compoundTextAtom) {
 	    encoding = Tcl_GetEncoding(NULL, "iso2022");
+	} else if (type == retrPtr->winPtr->dispPtr->utf8Atom) {
+	    encoding = Tcl_GetEncoding(NULL, "utf-8");
 	} else {
 	    encoding = Tcl_GetEncoding(NULL, "iso8859-1");
 	}
@@ -1288,54 +1257,6 @@ SelRcvIncrProc(clientData, eventPtr)
 	if (result != TCL_OK) {
 	    retrPtr->result = result;
 	}
-    } else if (type == retrPtr->winPtr->dispPtr->utf8Atom) {
-	/*
-	 * The X selection data is in UTF-8 format already.
-	 * We can't guarantee that propInfo is NULL-terminated,
-	 * so we might have to copy the string.
-	 */
-	char *propData = propInfo;
-
-	if (format != 8) {
-	    char buf[64 + TCL_INTEGER_SPACE];
-	    
-	    sprintf(buf, 
-		    "bad format for string selection: wanted \"8\", got \"%d\"",
-		    format);
-	    Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
-	    retrPtr->result = TCL_ERROR;
-	    goto done;
-	}
-
-	/*
-	 * Check for the end of the incremental transfer.
-	 */
-	if (numItems == 0) {
-	    retrPtr->result = TCL_OK;
-	    goto done;
-	}
-
-	/*
-	 * Not sure if this is correct; can propInfo contain embedded
-	 * NUL bytes?  Certainly not if it is coming from Tcl/Tk, but
-	 * I don't remember if all other apps treat \u0000 the same
-	 * way...
-	 */
-	if (propInfo[numItems] != '\0') {
-	    propData = ckalloc((size_t) numItems + 1);
-	    strcpy(propData, propInfo);
-	    propData[numItems] = '\0';
-	}
-        interp = retrPtr->interp;
-        Tcl_Preserve((ClientData) interp);
-	result = (*retrPtr->proc)(retrPtr->clientData, interp, propData);
-	Tcl_Release((ClientData) interp);
-	if (propData != propInfo) {
-	    ckfree((char *) propData);
-	}
-	if (result != TCL_OK) {
-	    retrPtr->result = result;
-	}
     } else if (numItems == 0) {
 	retrPtr->result = TCL_OK;
     } else {