diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | tests/unixSelect.test | 10 | ||||
| -rw-r--r-- | unix/tkUnixSelect.c | 93 |
3 files changed, 24 insertions, 89 deletions
@@ -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 { |