summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorstanton <stanton>1999-05-25 20:40:54 (GMT)
committerstanton <stanton>1999-05-25 20:40:54 (GMT)
commita832d1a306d8da5f7dc70243e9d36cede2daa411 (patch)
treefa852789785f475f30f753c1ecb4264a09ccc049
parentd466dd025d9277c76d252aa33273925903181697 (diff)
downloadtk-a832d1a306d8da5f7dc70243e9d36cede2daa411.zip
tk-a832d1a306d8da5f7dc70243e9d36cede2daa411.tar.gz
tk-a832d1a306d8da5f7dc70243e9d36cede2daa411.tar.bz2
First pass at Unicode support in X selection code.
-rw-r--r--generic/tkSelect.h6
-rw-r--r--tests/defs.tcl26
-rw-r--r--tests/unixMenu.test15
-rw-r--r--unix/tkUnixSelect.c131
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;