diff options
| -rw-r--r-- | doc/selection.n | 24 | ||||
| -rw-r--r-- | generic/tkSelect.c | 107 | ||||
| -rw-r--r-- | tests/unixSelect.test | 238 | ||||
| -rw-r--r-- | unix/tkUnixSelect.c | 16 |
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; } |