* unix/tkUnixSelect.c:

* tests/unixSelect.test:
* generic/tkSelect.c: Fixed selection code to handle Unicode data
in COMPOUND_TEXT and STRING selections. [Bug: 1791]

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;
 	}