summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorstanton <stanton>1999-06-03 18:50:45 (GMT)
committerstanton <stanton>1999-06-03 18:50:45 (GMT)
commit0e98ba9d85ade423311b36597aac1c0dad9e7f52 (patch)
tree3d3a9cd37eb4ab2165e0e578e370bd471b1ee333
parent5076106e0dd6f3f514e876162568fb5ed028931c (diff)
downloadtk-0e98ba9d85ade423311b36597aac1c0dad9e7f52.zip
tk-0e98ba9d85ade423311b36597aac1c0dad9e7f52.tar.gz
tk-0e98ba9d85ade423311b36597aac1c0dad9e7f52.tar.bz2
* unix/tkUnixSelect.c:
* tests/unixSelect.test: * generic/tkSelect.c: Fixed selection code to handle Unicode data in COMPOUND_TEXT and STRING selections. [Bug: 1791]
-rw-r--r--doc/selection.n24
-rw-r--r--generic/tkSelect.c107
-rw-r--r--tests/unixSelect.test238
-rw-r--r--unix/tkUnixSelect.c16
4 files changed, 351 insertions, 34 deletions
diff --git a/doc/selection.n b/doc/selection.n
index f6caddd..a67678b 100644
--- a/doc/selection.n
+++ b/doc/selection.n
@@ -5,10 +5,10 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: selection.n,v 1.2 1998/09/14 18:22:59 stanton Exp $
+'\" RCS: @(#) $Id: selection.n,v 1.3 1999/06/03 18:50:45 stanton Exp $
'\"
.so man.macros
-.TH selection n 4.0 Tk "Tk Built-In Commands"
+.TH selection n 8.1 Tk "Tk Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -70,19 +70,21 @@ and \fItype\fR is the requested type, \fIcommand\fR will be executed
as a Tcl command with two additional numbers appended to it
(with space separators).
The two additional numbers
-are \fIoffset\fR and \fImaxBytes\fR: \fIoffset\fR specifies a starting
-character position in the selection and \fImaxBytes\fR gives the maximum
-number of bytes to retrieve. The command should return a value consisting
-of at most \fImaxBytes\fR of the selection, starting at position
-\fIoffset\fR. For very large selections (larger than \fImaxBytes\fR)
+.VS
+are \fIoffset\fR and \fImaxChars\fR: \fIoffset\fR specifies a starting
+character position in the selection and \fImaxChars\fR gives the maximum
+number of characters to retrieve. The command should return a value consisting
+of at most \fImaxChars\fR of the selection, starting at position
+\fIoffset\fR. For very large selections (larger than \fImaxChars\fR)
the selection will be retrieved using several invocations of \fIcommand\fR
with increasing \fIoffset\fR values. If \fIcommand\fR returns a string
-whose length is less than \fImaxBytes\fR, the return value is assumed to
+whose length is less than \fImaxChars\fR, the return value is assumed to
include all of the remainder of the selection; if the length of
-\fIcommand\fR's result is equal to \fImaxBytes\fR then
+\fIcommand\fR's result is equal to \fImaxChars\fR then
\fIcommand\fR will be invoked again, until it eventually
-returns a result shorter than \fImaxBytes\fR. The value of \fImaxBytes\fR
-will always be relatively large (thousands of bytes).
+returns a result shorter than \fImaxChars\fR. The value of \fImaxChars\fR
+will always be relatively large (thousands of characters).
+.VE
.PP
If \fIcommand\fR returns an error then the selection retrieval is rejected
just as if the selection didn't exist at all.
diff --git a/generic/tkSelect.c b/generic/tkSelect.c
index fe8f119..bc7743f 100644
--- a/generic/tkSelect.c
+++ b/generic/tkSelect.c
@@ -11,7 +11,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.c,v 1.3 1999/04/16 01:51:21 stanton Exp $
+ * RCS: @(#) $Id: tkSelect.c,v 1.4 1999/06/03 18:50:46 stanton Exp $
*/
#include "tkInt.h"
@@ -26,6 +26,11 @@
typedef struct {
Tcl_Interp *interp; /* Interpreter in which to invoke command. */
int cmdLength; /* # of non-NULL bytes in command. */
+ int charOffset; /* The offset of the next char to retrieve. */
+ int byteOffset; /* The expected byte offset of the next
+ * chunk. */
+ char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character
+ * that is split across chunks.*/
char command[4]; /* Command to invoke. Actual space is
* allocated as large as necessary. This
* must be the last entry in the structure. */
@@ -243,7 +248,12 @@ Tk_DeleteSelHandler(tkwin, selection, target)
prevPtr->nextPtr = selPtr->nextPtr;
}
if (selPtr->proc == HandleTclCommand) {
- ckfree((char *) selPtr->clientData);
+ /*
+ * Mark the CommandInfo as deleted and free it if we can.
+ */
+
+ ((CommandInfo*)selPtr->clientData)->interp = NULL;
+ Tcl_EventuallyFree(selPtr->clientData, Tcl_Free);
}
ckfree((char *) selPtr);
}
@@ -793,6 +803,9 @@ Tk_SelectionCmd(clientData, interp, argc, argv)
cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
sizeof(CommandInfo) - 3 + cmdLength));
cmdInfoPtr->interp = interp;
+ cmdInfoPtr->charOffset = 0;
+ cmdInfoPtr->byteOffset = 0;
+ cmdInfoPtr->buffer[0] = '\0';
cmdInfoPtr->cmdLength = cmdLength;
strcpy(cmdInfoPtr->command, args[1]);
Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
@@ -989,7 +1002,12 @@ TkSelDeadWindow(winPtr)
}
}
if (selPtr->proc == HandleTclCommand) {
- ckfree((char *) selPtr->clientData);
+ /*
+ * Mark the CommandInfo as deleted and free it if we can.
+ */
+
+ ((CommandInfo*)selPtr->clientData)->interp = NULL;
+ Tcl_EventuallyFree(selPtr->clientData, Tcl_Free);
}
ckfree((char *) selPtr);
}
@@ -1184,21 +1202,42 @@ HandleTclCommand(clientData, offset, buffer, maxBytes)
int spaceNeeded, length;
#define MAX_STATIC_SIZE 100
char staticSpace[MAX_STATIC_SIZE];
- char *command;
- Tcl_Interp *interp;
+ char *command, *string;
+ Tcl_Interp *interp = cmdInfoPtr->interp;
Tcl_DString oldResult;
+ Tcl_Obj *objPtr;
+ int extraBytes, charOffset, count, numChars;
+ char *p;
/*
- * We must copy the interpreter pointer from CommandInfo because the
- * command could delete the handler, freeing the CommandInfo data before we
- * are done using it. We must also protect the interpreter from being
- * deleted too soo.
+ * We must also protect the interpreter and the command from being
+ * deleted too soon.
*/
- interp = cmdInfoPtr->interp;
+ Tcl_Preserve(clientData);
Tcl_Preserve((ClientData) interp);
/*
+ * Compute the proper byte offset in the case where the last chunk
+ * split a character.
+ */
+
+ if (offset == cmdInfoPtr->byteOffset) {
+ charOffset = cmdInfoPtr->charOffset;
+ extraBytes = strlen(cmdInfoPtr->buffer);
+ if (extraBytes > 0) {
+ strcpy(buffer, cmdInfoPtr->buffer);
+ maxBytes -= extraBytes;
+ buffer += extraBytes;
+ }
+ } else {
+ cmdInfoPtr->byteOffset = 0;
+ cmdInfoPtr->charOffset = 0;
+ extraBytes = 0;
+ charOffset = 0;
+ }
+
+ /*
* First, generate a command by taking the command string
* and appending the offset and maximum # of bytes.
*/
@@ -1209,7 +1248,7 @@ HandleTclCommand(clientData, offset, buffer, maxBytes)
} else {
command = (char *) ckalloc((unsigned) spaceNeeded);
}
- sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
+ sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes);
/*
* Execute the command. Be sure to restore the state of the
@@ -1219,15 +1258,41 @@ HandleTclCommand(clientData, offset, buffer, maxBytes)
Tcl_DStringInit(&oldResult);
Tcl_DStringGetResult(interp, &oldResult);
if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
- length = strlen(Tcl_GetStringResult(interp));
- if (length > maxBytes) {
- length = maxBytes;
+ objPtr = Tcl_GetObjResult(interp);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ count = (length > maxBytes) ? maxBytes : length;
+ memcpy((VOID *) buffer, (VOID *) string, (size_t) count);
+ buffer[count] = '\0';
+
+ /*
+ * Update the partial character information for the next
+ * retrieval if the command has not been deleted.
+ */
+
+ if (cmdInfoPtr->interp != NULL) {
+ if (length <= maxBytes) {
+ cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1);
+ cmdInfoPtr->buffer[0] = '\0';
+ } else {
+ p = string;
+ string += count;
+ numChars = 0;
+ while (p < string) {
+ p = Tcl_UtfNext(p);
+ numChars++;
+ }
+ cmdInfoPtr->charOffset += numChars;
+ length = p - string;
+ if (length > 0) {
+ strncpy(cmdInfoPtr->buffer, string, (size_t) length);
+ }
+ cmdInfoPtr->buffer[length] = '\0';
+ }
+ cmdInfoPtr->byteOffset += count + extraBytes;
}
- memcpy((VOID *) buffer, (VOID *) Tcl_GetStringResult(interp),
- (size_t) length);
- buffer[length] = '\0';
+ count += extraBytes;
} else {
- length = -1;
+ count = -1;
}
Tcl_DStringResult(interp, &oldResult);
@@ -1235,8 +1300,10 @@ HandleTclCommand(clientData, offset, buffer, maxBytes)
ckfree(command);
}
+
+ Tcl_Release(clientData);
Tcl_Release((ClientData) interp);
- return length;
+ return count;
}
/*
@@ -1364,7 +1431,7 @@ TkSelDefaultSelection(infoPtr, target, buffer, maxBytes, typePtr)
static void
LostSelection(clientData)
- ClientData clientData; /* Pointer to CommandInfo structure. */
+ ClientData clientData; /* Pointer to LostCommand structure. */
{
LostCommand *lostPtr = (LostCommand *) clientData;
Tcl_Obj *objPtr;
diff --git a/tests/unixSelect.test b/tests/unixSelect.test
new file mode 100644
index 0000000..4cc0921
--- /dev/null
+++ b/tests/unixSelect.test
@@ -0,0 +1,238 @@
+# This file contains tests for the tkUnixSelect.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1999 by Scriptics Corporation.
+#
+# 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.1 1999/06/03 18:50:46 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {$tcl_platform(platform) != "unix"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
+ return
+}
+
+eval destroy [winfo child .]
+
+global longValue selValue selInfo
+
+set selValue {}
+set selInfo {}
+
+proc handler {type offset count} {
+ global selValue selInfo
+ lappend selInfo $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+proc errIncrHandler {type offset count} {
+ global selValue selInfo pass
+ if {$offset == 4000} {
+ if {$pass == 0} {
+ # Just sizing the selection; don't do anything here.
+ set pass 1
+ } else {
+ # Fetching the selection; wait long enough to cause a timeout.
+ after 6000
+ }
+ }
+ lappend selInfo $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+proc errHandler args {
+ error "selection handler aborted"
+}
+
+proc badHandler {path type offset count} {
+ global selValue selInfo
+ selection handle -type $type $path {}
+ lappend selInfo $path $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+proc reallyBadHandler {path type offset count} {
+ global selValue selInfo pass
+ if {$offset == 4000} {
+ if {$pass == 0} {
+ set pass 1
+ } else {
+ selection handle -type $type $path {}
+ }
+ }
+ lappend selInfo $path $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+# Eliminate any existing selection on the screen. This is needed in case
+# there is a selection in some other application, in order to prevent races
+# from causing false errors in the tests below.
+
+selection clear .
+after 1500
+
+# common setup code
+proc setup {{path .f1} {display {}}} {
+ catch {destroy $path}
+ if {$display == {}} {
+ frame $path
+ } else {
+ toplevel $path -screen $display
+ wm geom $path +0+0
+ }
+ selection own $path
+}
+
+# set up a very large buffer to test INCR retrievals
+set longValue ""
+foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
+ set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
+ append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
+}
+
+test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} {unixOnly} {
+ setupbg
+ entry .e
+ pack .e
+ update
+ .e insert 0 [encoding convertfrom identity \u00fcber]
+ .e selection range 0 end
+ set result [dobg {string bytelength [selection get]}]
+ cleanupbg
+ destroy .e
+ set result
+} {5}
+test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} {unixOnly} {
+ setupbg
+ dobg {
+ entry .e; pack .e; update
+ .e insert 0 \u00fc\u0444
+ .e selection range 0 end
+ }
+ set x [selection get]
+ cleanupbg
+ list [string equal \u00fc? $x] \
+ [string length $x] [string bytelength $x]
+} {1 2 3}
+test unixSelect-1.4 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} {
+ setupbg
+ setup
+ selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
+ {handler COMPOUND_TEXT}
+ selection own .
+ set selValue \u00fc\u0444
+ set selInfo {}
+ set result [dobg {
+ set x [selection get -type COMPOUND_TEXT]
+ list [string equal \u00fc\u0444 $x] \
+ [string length $x] [string bytelength $x]
+ }]
+ cleanupbg
+ lappend result $selInfo
+} {1 2 4 {COMPOUND_TEXT 0 4000}}
+test unixSelect-1.5 {TkSelGetSelection procedure: INCR i18n text, iso2022} {unixOnly} {
+ setupbg
+ setup
+ selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
+ {handler COMPOUND_TEXT}
+ selection own .
+ set selValue [string repeat x 3999]\u00fc\u0444[string repeat x 3999]
+ set selInfo {}
+ set result [dobg {
+ set x [selection get -type COMPOUND_TEXT]
+ list [string equal \
+ [string repeat x 3999]\u00fc\u0444[string repeat x 3999] $x] \
+ [string length $x] [string bytelength $x]
+ }]
+ cleanupbg
+ lappend result $selInfo
+} {1 8000 8002 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}}
+test unixSelect-1.6 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} {
+ setupbg
+ setup
+ selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
+ {handler COMPOUND_TEXT}
+ selection own .
+ set selValue \u00fc\u0444
+ set selInfo {}
+ set result [dobg {
+ set x [selection get -type COMPOUND_TEXT]
+ list [string equal \u00fc\u0444 $x] \
+ [string length $x] [string bytelength $x]
+ }]
+ cleanupbg
+ lappend result $selInfo
+} {1 2 4 {COMPOUND_TEXT 0 4000}}
+test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} {
+ setupbg
+ dobg "entry .e; pack .e; update
+ .e insert 0 \[encoding convertfrom identity \\u00fcber\]$longValue
+ .e selection range 0 end"
+ set result [string bytelength [selection get]]
+ cleanupbg
+ set result
+} [expr {5 + [string bytelength $longValue]}]
+test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} {
+ setupbg
+ dobg {
+ entry .e; pack .e; update
+ .e insert 0 [string repeat x 3999]\u00fc
+ .e selection range 0 end
+ }
+ set x [selection get]
+ cleanupbg
+ list [string equal [string repeat x 3999]\u00fc $x] \
+ [string length $x] [string bytelength $x]
+} {1 4000 4001}
+test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} {
+ setupbg
+ dobg {
+ entry .e; pack .e; update
+ .e insert 0 \u00fc[string repeat x 3999]
+ .e selection range 0 end
+ }
+ set x [selection get]
+ cleanupbg
+ list [string equal \u00fc[string repeat x 3999] $x] \
+ [string length $x] [string bytelength $x]
+} {1 4000 4001}
+test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} {
+ setupbg
+ dobg {
+ entry .e; pack .e; update
+ .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000]
+ .e selection range 0 end
+ }
+ set x [selection get]
+ cleanupbg
+ list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \
+ [string length $x] [string bytelength $x]
+} {1 8000 8001}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c
index c94c0be..e3d6b56 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.5 1999/06/01 18:51:20 stanton Exp $
+ * RCS: @(#) $Id: tkUnixSelect.c,v 1.6 1999/06/03 18:50:46 stanton Exp $
*/
#include "tkInt.h"
@@ -24,7 +24,7 @@ typedef struct ConvertInfo {
* offset of the next chunk of data to
* transfer. */
Tcl_EncodingState state; /* The encoding state needed across chunks. */
- char buffer[TCL_UTF_MAX+1]; /* A buffer to hold part of a UTF character
+ char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character
* that is split across chunks.*/
} ConvertInfo;
@@ -322,6 +322,7 @@ TkSelPropProc(eventPtr)
*/
numItems = 0;
+ length = 0;
} else {
TkSelInProgress ip;
ip.selPtr = selPtr;
@@ -424,6 +425,10 @@ TkSelPropProc(eventPtr)
}
Tcl_DStringSetLength(&ds, soFar);
+ if (encoding) {
+ Tcl_FreeEncoding(encoding);
+ }
+
/*
* Set the property to the encoded string value.
*/
@@ -484,7 +489,12 @@ TkSelPropProc(eventPtr)
incrPtr->converts[i].offset = -2;
}
} else {
- incrPtr->converts[i].offset += numItems;
+ /*
+ * Advance over the selection data that was consumed
+ * this time.
+ */
+
+ incrPtr->converts[i].offset += numItems - length;
}
return;
}