diff options
| -rw-r--r-- | generic/tkSelect.h | 6 | ||||
| -rw-r--r-- | tests/defs.tcl | 26 | ||||
| -rw-r--r-- | tests/unixMenu.test | 15 | ||||
| -rw-r--r-- | unix/tkUnixSelect.c | 131 |
4 files changed, 140 insertions, 38 deletions
diff --git a/generic/tkSelect.h b/generic/tkSelect.h index 0d8c644..72fdad6 100644 --- a/generic/tkSelect.h +++ b/generic/tkSelect.h @@ -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: tkSelect.h,v 1.3 1999/04/16 01:51:22 stanton Exp $ + * RCS: @(#) $Id: tkSelect.h,v 1.4 1999/05/25 20:40:54 stanton Exp $ */ #ifndef _TKSELECT @@ -95,6 +95,10 @@ typedef struct TkSelRetrievalInfo { int idleTime; /* Number of seconds that have gone by * without hearing anything from the * selection owner. */ + Tcl_EncodingState encState; /* Holds intermediate state during translations + * of data that cross buffer boundaries. */ + int encFlags; /* Encoding translation state flags. */ + Tcl_DString buf; /* Buffer to hold translation data. */ struct TkSelRetrievalInfo *nextPtr; /* Next in list of all pending * selection retrievals. NULL means diff --git a/tests/defs.tcl b/tests/defs.tcl index c582b52..245ec6a 100644 --- a/tests/defs.tcl +++ b/tests/defs.tcl @@ -11,7 +11,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: defs.tcl,v 1.4 1999/04/20 19:20:03 hershey Exp $ +# RCS: @(#) $Id: defs.tcl,v 1.5 1999/05/25 20:40:54 stanton Exp $ # Initialize wish shell @@ -980,22 +980,20 @@ if {[info exists tk_version]} { cleanupbg } - # The following code segment cannot be run on Windows in Tk8.1b2 - # This bug is logged as a pipe bug (bugID 1495). + # The following code segment cannot be run on Windows prior + # to Tk 8.1b3 due to a channel I/O bug. global tcl_platform - if {$tcl_platform(platform) != "windows"} { - set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+] - puts $::tcltest::fd "puts foo; flush stdout" - flush $::tcltest::fd - if {[gets $::tcltest::fd data] < 0} { - error "unexpected EOF from \"$::tcltest::tktest\"" - } - if {[string compare $data foo]} { - error "unexpected output from background process \"$data\"" - } - fileevent $::tcltest::fd readable bgReady + set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+] + puts $::tcltest::fd "puts foo; flush stdout" + flush $::tcltest::fd + if {[gets $::tcltest::fd data] < 0} { + error "unexpected EOF from \"$::tcltest::tktest\"" + } + if {[string compare $data foo]} { + error "unexpected output from background process \"$data\"" } + fileevent $::tcltest::fd readable bgReady } # Send a command to the background process, catching errors and diff --git a/tests/unixMenu.test b/tests/unixMenu.test index ebc833b..30bb07a 100644 --- a/tests/unixMenu.test +++ b/tests/unixMenu.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixMenu.test,v 1.3 1999/04/16 01:51:42 stanton Exp $ +# RCS: @(#) $Id: unixMenu.test,v 1.4 1999/05/25 20:40:54 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -972,16 +972,3 @@ test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {} deleteWindows ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index 2b79a70..3ba93dd 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.3 1999/04/16 01:51:47 stanton Exp $ + * RCS: @(#) $Id: tkUnixSelect.c,v 1.4 1999/05/25 20:40:55 stanton Exp $ */ #include "tkInt.h" @@ -55,6 +55,10 @@ typedef struct IncrInfo { * changes. */ struct IncrInfo *nextPtr; /* Next in list of all INCR-style * retrievals currently pending. */ + Tcl_EncodingState state; /* State info for encoding conversions + * that span multiple buffers. */ + int flags; /* Encoding flags, set to TCL_ENCODING_START + * at the beginning of an INCR transfer. */ } IncrInfo; @@ -150,7 +154,9 @@ TkSelGetSelection(interp, tkwin, selection, target, proc, clientData) retr.clientData = clientData; retr.result = -1; retr.idleTime = 0; + retr.encFlags = TCL_ENCODING_START; retr.nextPtr = pendingRetrievals; + Tcl_DStringInit(&retr.buf); pendingRetrievals = &retr; /* @@ -195,6 +201,7 @@ TkSelGetSelection(interp, tkwin, selection, target, proc, clientData) } } } + Tcl_DStringFree(&retr.buf); return retr.result; } @@ -383,6 +390,7 @@ TkSelEventProc(tkwin, eventPtr) Atom type; int format, result; unsigned long numItems, bytesAfter; + Tcl_DString ds; for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) { if (retrPtr == NULL) { @@ -426,6 +434,7 @@ TkSelEventProc(tkwin, eventPtr) } if ((type == XA_STRING) || (type == dispPtr->textAtom) || (type == dispPtr->compoundTextAtom)) { + Tcl_Encoding encoding; if (format != 8) { char buf[64 + TCL_INTEGER_SPACE]; @@ -438,9 +447,30 @@ TkSelEventProc(tkwin, eventPtr) } interp = retrPtr->interp; Tcl_Preserve((ClientData) interp); + + /* + * Convert the X selection data into UTF before passing it + * to the selection callback. Note that the COMPOUND_TEXT + * uses a modified iso2022 encoding, not the current system + * encoding. For now we'll just blindly apply the iso2022 + * encoding. This is probably wrong, but it's a placeholder + * until we figure out what we're really supposed to do. + */ + + if (type == dispPtr->compoundTextAtom) { + encoding = Tcl_GetEncoding(NULL, "iso2022"); + } else { + encoding = NULL; + } + Tcl_ExternalToUtfDString(encoding, propInfo, (int)numItems, &ds); + if (encoding) { + Tcl_FreeEncoding(encoding); + } + retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, - interp, propInfo); - Tcl_Release((ClientData) interp); + interp, Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); + Tcl_Release((ClientData) interp); } else if (type == dispPtr->incrAtom) { /* @@ -873,11 +903,13 @@ SelRcvIncrProc(clientData, eventPtr) register XEvent *eventPtr; /* X PropertyChange event. */ { register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; - char *propInfo; + char *propInfo, *dst, *src; Atom type; - int format, result; + int format, result, srcLen, dstLen, srcRead, dstWrote, soFar; unsigned long numItems, bytesAfter; + Tcl_DString *dstPtr, temp; Tcl_Interp *interp; + Tcl_Encoding encoding; if ((eventPtr->xproperty.atom != retrPtr->property) || (eventPtr->xproperty.state != PropertyNewValue) @@ -898,9 +930,7 @@ SelRcvIncrProc(clientData, eventPtr) retrPtr->result = TCL_ERROR; goto done; } - if (numItems == 0) { - retrPtr->result = TCL_OK; - } else if ((type == XA_STRING) + if ((type == XA_STRING) || (type == retrPtr->winPtr->dispPtr->textAtom) || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) { if (format != 8) { @@ -915,11 +945,94 @@ SelRcvIncrProc(clientData, eventPtr) } interp = retrPtr->interp; Tcl_Preserve((ClientData) interp); - result = (*retrPtr->proc)(retrPtr->clientData, interp, propInfo); + + if (type == retrPtr->winPtr->dispPtr->compoundTextAtom) { + encoding = Tcl_GetEncoding(NULL, "iso2022"); + } else { + encoding = NULL; + } + + /* + * Check to see if there is any data left over from the previous + * chunk. If there is, copy the old data and the new data into + * a new buffer. + */ + + Tcl_DStringInit(&temp); + if (Tcl_DStringLength(&retrPtr->buf) > 0) { + Tcl_DStringAppend(&temp, Tcl_DStringValue(&retrPtr->buf), + Tcl_DStringLength(&retrPtr->buf)); + if (numItems > 0) { + Tcl_DStringAppend(&temp, propInfo, (int)numItems); + } + src = Tcl_DStringValue(&temp); + srcLen = Tcl_DStringLength(&temp); + } else if (numItems == 0) { + /* + * There is no new data, so we're done. + */ + + retrPtr->result = TCL_OK; + goto done; + } else { + src = propInfo; + srcLen = numItems; + } + + /* + * Set up the destination buffer so we can use as much space as + * is available. + */ + + dstPtr = &retrPtr->buf; + dst = Tcl_DStringValue(dstPtr); + dstLen = dstPtr->spaceAvl - 1; + + /* + * Now convert the data, growing the destination buffer as needed. + */ + + while (1) { + result = Tcl_ExternalToUtf(NULL, encoding, src, srcLen, + retrPtr->encFlags, &retrPtr->encState, + dst, dstLen, &srcRead, &dstWrote, NULL); + soFar = dst + dstWrote - Tcl_DStringValue(dstPtr); + retrPtr->encFlags &= ~TCL_ENCODING_START; + src += srcRead; + srcLen -= srcRead; + if (result != TCL_CONVERT_NOSPACE) { + Tcl_DStringSetLength(dstPtr, soFar); + break; + } + if (Tcl_DStringLength(dstPtr) == 0) { + Tcl_DStringSetLength(dstPtr, dstLen); + } + Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1); + dst = Tcl_DStringValue(dstPtr) + soFar; + dstLen = Tcl_DStringLength(dstPtr) - soFar - 1; + } + + result = (*retrPtr->proc)(retrPtr->clientData, interp, + Tcl_DStringValue(dstPtr)); Tcl_Release((ClientData) interp); + + /* + * Copy any unused data into the destination buffer so we can + * pick it up next time around. + */ + + Tcl_DStringSetLength(dstPtr, 0); + Tcl_DStringAppend(dstPtr, src, srcLen); + + Tcl_DStringFree(&temp); + if (encoding) { + Tcl_FreeEncoding(encoding); + } if (result != TCL_OK) { retrPtr->result = result; } + } else if (numItems == 0) { + retrPtr->result = TCL_OK; } else { char *string; |