From 57dee857622ab7a2a15091b6b097f057b0ace6f3 Mon Sep 17 00:00:00 2001 From: hobbs Date: Tue, 3 Jul 2001 01:03:16 +0000 Subject: * library/console.tcl: * library/entry.tcl: * library/spinbox.tcl: * library/text.tcl: * library/tk.tcl: added private ::tk::GetSelection command to handle requesting selection. This is to support requesting UTF8_STRING before generic STRING on Unix. Changed Text, Spinbox, Entry and Console to use this command. * tests/select.test: * generic/tkSelect.c (Tk_CreateSelHandler, Tk_DeleteSelHandler): on Unix, a UTF8_STRING handler will be created when the user requests a STRING handler (in addition to the STRING handler). This provides implicit support for the new UTF8_STRING selection target. * unix/tkUnixSelect.c (TkSelEventProc, ConvertSelection): Added support for UTF8_STRING target. [RFE #418653, Patch #433283] * generic/tkInt.h: added utf8Atom to TkDisplay structure. --- ChangeLog | 23 ++++++++++ generic/tkInt.h | 3 +- generic/tkSelect.c | 119 ++++++++++++++++++++++++++++++++++++++++++++-------- library/console.tcl | 6 +-- library/entry.tcl | 8 ++-- library/spinbox.tcl | 8 ++-- library/text.tcl | 8 ++-- library/tk.tcl | 34 ++++++++++++++- tests/select.test | 70 +++++++++++++++++++++++++++---- unix/tkUnixSelect.c | 44 +++++++++++++++++-- 10 files changed, 278 insertions(+), 45 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5157b01..4fb3baf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,28 @@ 2001-07-02 Jeff Hobbs + * library/console.tcl: + * library/entry.tcl: + * library/spinbox.tcl: + * library/text.tcl: + * library/tk.tcl: added private ::tk::GetSelection command to + handle requesting selection. This is to support requesting + UTF8_STRING before generic STRING on Unix. Changed Text, Spinbox, + Entry and Console to use this command. + + * tests/select.test: + * generic/tkSelect.c (Tk_CreateSelHandler, Tk_DeleteSelHandler): + on Unix, a UTF8_STRING handler will be created when the user + requests a STRING handler (in addition to the STRING handler). + This provides implicit support for the new UTF8_STRING selection + target. + * unix/tkUnixSelect.c (TkSelEventProc, ConvertSelection): Added + support for UTF8_STRING target. [RFE #418653, Patch #433283] + + * generic/tkInt.h: added utf8Atom to TkDisplay structure. + + * tests/listbox.test: changed 'darkblue' to 'white' in a test + because it isn't a portable color name. + * generic/tkEntry.c (DestroyEntry): used Tcl_EventuallyFree instead of ckfree for entryPtr to prevent FMRs. [Bug #413904] diff --git a/generic/tkInt.h b/generic/tkInt.h index bd7764f..8bf0617 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -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: tkInt.h,v 1.34 2000/11/22 01:49:38 ericm Exp $ + * RCS: $Id: tkInt.h,v 1.35 2001/07/03 01:03:16 hobbs Exp $ */ #ifndef _TKINT @@ -369,6 +369,7 @@ typedef struct TkDisplay { Atom applicationAtom; /* Atom for TK_APPLICATION. */ Atom windowAtom; /* Atom for TK_WINDOW. */ Atom clipboardAtom; /* Atom for CLIPBOARD. */ + Atom utf8Atom; /* Atom for UTF8_STRING. */ Tk_Window clipWindow; /* Window used for clipboard ownership and to * retrieve selections between processes. NULL diff --git a/generic/tkSelect.c b/generic/tkSelect.c index 951c5c7..9d6285d 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.6 2000/08/07 21:49:16 ericm Exp $ + * RCS: @(#) $Id: tkSelect.c,v 1.7 2001/07/03 01:03:16 hobbs Exp $ */ #include "tkInt.h" @@ -177,6 +177,48 @@ Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format) } else { selPtr->size = 32; } + + if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) NULL)) { + /* + * If the user asked for a STRING handler and we understand + * UTF8_STRING, we implicitly create a UTF8_STRING handler for them. + */ + + target = winPtr->dispPtr->utf8Atom; + for (selPtr = winPtr->selHandlerList; ; + selPtr = selPtr->nextPtr) { + if (selPtr == NULL) { + selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler)); + selPtr->nextPtr = winPtr->selHandlerList; + winPtr->selHandlerList = selPtr; + selPtr->selection = selection; + selPtr->target = target; + selPtr->format = target; /* We want UTF8_STRING format */ + selPtr->proc = proc; + if (selPtr->proc == HandleTclCommand) { + /* + * The clientData is selection controlled memory, so + * we should make a copy for this selPtr. + */ + selPtr->clientData = + (ClientData) ckalloc(sizeof(clientData)); + memcpy(selPtr->clientData, clientData, sizeof(clientData)); + } else { + selPtr->clientData = clientData; + } + selPtr->size = 8; + break; + } + if ((selPtr->selection == selection) + && (selPtr->target == target)) { + /* + * Looks like we had a utf-8 target already. Leave it alone. + */ + + break; + } + } + } } /* @@ -247,6 +289,36 @@ Tk_DeleteSelHandler(tkwin, selection, target) } else { prevPtr->nextPtr = selPtr->nextPtr; } + + if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) NULL)) { + /* + * If the user asked for a STRING handler and we understand + * UTF8_STRING, we may have implicitly created a UTF8_STRING handler + * for them. Look for it and delete it as necessary. + */ + TkSelHandler *utf8selPtr; + + target = winPtr->dispPtr->utf8Atom; + for (utf8selPtr = winPtr->selHandlerList; utf8selPtr != NULL; + utf8selPtr = utf8selPtr->nextPtr) { + if ((utf8selPtr->selection == selection) + && (utf8selPtr->target == target)) { + break; + } + } + if (utf8selPtr != NULL) { + if ((utf8selPtr->format == target) + && (utf8selPtr->proc == selPtr->proc) + && (utf8selPtr->size == selPtr->size)) { + /* + * This recursive call is OK, because we've + * changed the value of 'target' + */ + Tk_DeleteSelHandler(tkwin, selection, target); + } + } + } + if (selPtr->proc == HandleTclCommand) { /* * Mark the CommandInfo as deleted and free it if we can. @@ -524,8 +596,8 @@ Tk_GetSelection(interp, tkwin, selection, target, proc, clientData) TkSelInProgress ip; for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList; - selPtr != NULL; selPtr = selPtr->nextPtr) { - if ((selPtr->target == target) + selPtr != NULL; selPtr = selPtr->nextPtr) { + if ((selPtr->target == target) && (selPtr->selection == selection)) { break; } @@ -851,10 +923,9 @@ Tk_SelectionObjCmd(clientData, interp, objc, objv) register LostCommand *lostPtr; char *script = NULL; int cmdLength; - static char *ownOptionStrings[] = { "-command", - "-displayof", - "-selection", - (char *) NULL }; + static char *ownOptionStrings[] = { + "-command", "-displayof", "-selection", (char *) NULL + }; enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION }; int ownIndex; @@ -1047,7 +1118,7 @@ TkSelDeadWindow(winPtr) } if (selPtr->proc == HandleTclCommand) { /* - * Mark the CommandInfo as deleted and free it if we can. + * Mark the CommandInfo as deleted and free it when we can. */ ((CommandInfo*)selPtr->clientData)->interp = NULL; @@ -1106,15 +1177,29 @@ TkSelInit(tkwin) * Fetch commonly-used atoms. */ - dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE"); - dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR"); - dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS"); - dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP"); - dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT"); - dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); - dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION"); - dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW"); - dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD"); + dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE"); + dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR"); + dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS"); + dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP"); + dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT"); + dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION"); + dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW"); + dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD"); + + /* + * Using UTF8_STRING instead of the XA_UTF8_STRING macro allows us + * to support older X servers that didn't have UTF8_STRING yet. + * This is necessary on Unix systems. + * For more information, see: + * http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11 + */ + +#if !defined(__WIN32__) && !defined(MAC_TCL) + dispPtr->utf8Atom = Tk_InternAtom(tkwin, "UTF8_STRING"); +#else + dispPtr->utf8Atom = (Atom) NULL; +#endif } /* diff --git a/library/console.tcl b/library/console.tcl index 472dcf5..e996ea5 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -4,7 +4,7 @@ # can be used by non-unix systems that do not have built-in support # for shells. # -# RCS: @(#) $Id: console.tcl,v 1.10 2000/11/02 22:55:16 hobbs Exp $ +# RCS: @(#) $Id: console.tcl,v 1.11 2001/07/03 01:03:16 hobbs Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. @@ -350,7 +350,7 @@ proc tkConsoleBind {win} { } } bind $win { - catch {tkConsoleInsert %W [selection get -displayof %W]} + catch {tkConsoleInsert %W [::tk::GetSelection %W PRIMARY]} break } bind $win { @@ -397,7 +397,7 @@ proc tkConsoleBind {win} { } bind $win <> { catch { - set clip [selection get -displayof %W -selection CLIPBOARD] + set clip [::tk::GetSelection %W CLIPBOARD] set list [split $clip \n\r] tkConsoleInsert %W [lindex $list 0] foreach x [lrange $list 1 end] { diff --git a/library/entry.tcl b/library/entry.tcl index a826481..5392bcd 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk entry widgets and provides # procedures that help in implementing those bindings. # -# RCS: @(#) $Id: entry.tcl,v 1.14 2001/03/29 11:05:49 mdejong Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.15 2001/07/03 01:03:16 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -55,7 +55,7 @@ bind Entry <> { %W delete sel.first sel.last } } - %W insert insert [selection get -displayof %W -selection CLIPBOARD] + %W insert insert [::tk::GetSelection %W CLIPBOARD] tkEntrySeeInsert %W } } @@ -210,7 +210,7 @@ if {[string equal $tcl_platform(platform) "macintosh"]} { # generates the <> event, so we don't need to do anything here. if {[string compare $tcl_platform(platform) "windows"]} { bind Entry { - catch {tkEntryInsert %W [selection get -displayof %W]} + catch {tkEntryInsert %W [::tk::GetSelection %W PRIMARY]} } } @@ -408,7 +408,7 @@ proc tkEntryPaste {w x} { global tkPriv $w icursor [tkEntryClosestGap $w $x] - catch {$w insert insert [selection get -displayof $w]} + catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string compare "disabled" [$w cget -state]]} {focus $w} } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index b93479b..a1ba4f4 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk spinbox widgets and provides # procedures that help in implementing those bindings. # -# RCS: @(#) $Id: spinbox.tcl,v 1.1 2000/05/29 01:43:15 hobbs Exp $ +# RCS: @(#) $Id: spinbox.tcl,v 1.2 2001/07/03 01:03:16 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -60,7 +60,7 @@ bind Spinbox <> { %W delete sel.first sel.last } } - %W insert insert [selection get -displayof %W -selection CLIPBOARD] + %W insert insert [::tk::GetSelection %W CLIPBOARD] ::tk::spinbox::SeeInsert %W } } @@ -218,7 +218,7 @@ if {[string equal $tcl_platform(platform) "macintosh"]} { # generates the <> event, so we don't need to do anything here. if {[string compare $tcl_platform(platform) "windows"]} { bind Spinbox { - catch {::tk::spinbox::Insert %W [selection get -displayof %W]} + catch {::tk::spinbox::Insert %W [::tk::GetSelection %W PRIMARY]} } } @@ -504,7 +504,7 @@ proc ::tk::spinbox::Paste {w x} { global tkPriv $w icursor [::tk::spinbox::ClosestGap $w $x] - catch {$w insert insert [selection get -displayof $w]} + catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string equal "disabled" [$w cget -state]]} {focus $w} } diff --git a/library/text.tcl b/library/text.tcl index 79a49e1..38f2efc 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk text widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: text.tcl,v 1.14 2001/03/29 11:05:49 mdejong Exp $ +# RCS: @(#) $Id: text.tcl,v 1.15 2001/07/03 01:03:16 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -260,7 +260,7 @@ bind Text <> { } } bind Text { - catch {tkTextInsert %W [selection get -displayof %W]} + catch {tkTextInsert %W [::tk::GetSelection %W PRIMARY]} } bind Text { tkTextInsert %W %A @@ -627,7 +627,7 @@ proc tkTextKeyExtend {w index} { proc tkTextPaste {w x y} { $w mark set insert [tkTextClosestGap $w $x $y] - catch {$w insert insert [selection get -displayof $w]} + catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string equal [$w cget -state] "normal"]} {focus $w} } @@ -974,7 +974,7 @@ proc tk_textPaste w { $w delete sel.first sel.last } } - $w insert insert [selection get -displayof $w -selection CLIPBOARD] + $w insert insert [::tk::GetSelection $w CLIPBOARD] } } diff --git a/library/tk.tcl b/library/tk.tcl index daba5d6..64afbe7 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,7 +3,7 @@ # Initialization script normally executed in the interpreter for each # Tk-based application. Arranges class bindings for widgets. # -# RCS: @(#) $Id: tk.tcl,v 1.29 2001/03/31 05:46:10 hobbs Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.30 2001/07/03 01:03:16 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -151,6 +151,38 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { } } +# ::tk::GetSelection -- +# This tries to obtain the default selection. On Unix, we first try +# and get a UTF8_STRING, a type supported by modern Unix apps for +# passing Unicode data safely. We fall back on the default STRING +# type otherwise. On Windows, only the STRING type is necessary. +# Arguments: +# w The widget for which the selection will be retrieved. +# Important for the -displayof property. +# sel The source of the selection (PRIMARY or CLIPBOARD) +# Results: +# Returns the selection, or an error if none could be found +# +if {[string equal $tcl_platform(platform) "unix"]} { + proc ::tk::GetSelection {w {sel PRIMARY}} { + if {[catch {selection get -displayof $w -selection $sel \ + -type UTF8_STRING} txt] \ + && [catch {selection get -displayof $w -selection $sel} txt]} { + return -code error "could not find default selection" + } else { + return $txt + } + } +} else { + proc ::tk::GetSelection {w {sel PRIMARY}} { + if {[catch {selection get -displayof $w -selection $sel} txt]} { + return -code error "could not find default selection" + } else { + return $txt + } + } +} + # tkScreenChanged -- # This procedure is invoked by the binding mechanism whenever the # "current" screen is changing. The procedure does two things. diff --git a/tests/select.test b/tests/select.test index 4879a15..3682f28 100644 --- a/tests/select.test +++ b/tests/select.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: select.test,v 1.5 2000/08/07 21:49:17 ericm Exp $ +# RCS: @(#) $Id: select.test,v 1.6 2001/07/03 01:03:16 hobbs Exp $ # # Note: Multiple display selection handling will only be tested if the @@ -129,7 +129,13 @@ test select-1.3 {Tk_CreateSelHandler procedure} { set selInfo "" list [selection get TEST] $selInfo } {{Test value} {TEST 0 4000}} -test select-1.4 {Tk_CreateSelHandler procedure} { +test select-1.4.1 {Tk_CreateSelHandler procedure} {unixOnly} { + setup + selection handle .f1 {handler TEST} TEST + selection handle .f1 {handler STRING} + lsort [selection get TARGETS] +} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} +test select-1.4.2 {Tk_CreateSelHandler procedure} {macOrPc} { setup selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} @@ -144,7 +150,20 @@ test select-1.5 {Tk_CreateSelHandler procedure} { set selInfo "" list [selection get] $selInfo } {{} {STRING 0 4000}} -test select-1.6 {Tk_CreateSelHandler procedure} { +test select-1.6.1 {Tk_CreateSelHandler procedure} {unixOnly} { + global selValue selInfo + setup + selection handle .f1 {handler TEST} TEST + selection handle .f1 {handler STRING} + set selValue "" + set selInfo "" + selection get + selection get -type TEST + selection handle .f1 {handler TEST2} TEST + selection get -type TEST + list [set selInfo] [lsort [selection get TARGETS]] +} {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} +test select-1.6.2 {Tk_CreateSelHandler procedure} {macOrPc} { global selValue selInfo setup selection handle .f1 {handler TEST} TEST @@ -157,7 +176,15 @@ test select-1.6 {Tk_CreateSelHandler procedure} { selection get -type TEST list [set selInfo] [lsort [selection get TARGETS]] } {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-1.7 {Tk_CreateSelHandler procedure} { +test select-1.7.1 {Tk_CreateSelHandler procedure} {unixOnly} { + setup + selection own -selection CLIPBOARD .f1 + selection handle -selection CLIPBOARD .f1 {handler TEST} TEST + selection handle -selection PRIMARY .f1 {handler TEST2} STRING + list [lsort [selection get -selection PRIMARY TARGETS]] \ + [lsort [selection get -selection CLIPBOARD TARGETS]] +} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-1.7.2 {Tk_CreateSelHandler procedure} {macOrPc} { setup selection own -selection CLIPBOARD .f1 selection handle -selection CLIPBOARD .f1 {handler TEST} TEST @@ -173,7 +200,34 @@ test select-1.8 {Tk_CreateSelHandler procedure} { ############################################################################## -test select-2.1 {Tk_DeleteSelHandler procedure} { +test select-2.1 {Tk_DeleteSelHandler procedure} {unixOnly} { + setup + selection handle .f1 {handler STRING} + selection handle -type TEST .f1 {handler TEST} + selection handle -type USER .f1 {handler USER} + set result [list [lsort [selection get TARGETS]]] + selection handle -type TEST .f1 {} + lappend result [lsort [selection get TARGETS]] +} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}} +test select-2.2 {Tk_DeleteSelHandler procedure} {unixOnly} { + setup + selection handle .f1 {handler STRING} + selection handle -type TEST .f1 {handler TEST} + selection handle -type USER .f1 {handler USER} + set result [list [lsort [selection get TARGETS]]] + selection handle -type USER .f1 {} + lappend result [lsort [selection get TARGETS]] +} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} +test select-2.3 {Tk_DeleteSelHandler procedure} {unixOnly} { + setup + selection own -selection CLIPBOARD .f1 + selection handle -selection PRIMARY .f1 {handler STRING} + selection handle -selection CLIPBOARD .f1 {handler STRING} + selection handle -selection CLIPBOARD .f1 {} + list [lsort [selection get TARGETS]] \ + [lsort [selection get -selection CLIPBOARD TARGETS]] +} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-2.4 {Tk_DeleteSelHandler procedure} {macOrPc} { setup selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -182,7 +236,7 @@ test select-2.1 {Tk_DeleteSelHandler procedure} { selection handle -type TEST .f1 {} lappend result [lsort [selection get TARGETS]] } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}} -test select-2.2 {Tk_DeleteSelHandler procedure} { +test select-2.5 {Tk_DeleteSelHandler procedure} {macOrPc} { setup selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -191,7 +245,7 @@ test select-2.2 {Tk_DeleteSelHandler procedure} { selection handle -type USER .f1 {} lappend result [lsort [selection get TARGETS]] } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.3 {Tk_DeleteSelHandler procedure} { +test select-2.6 {Tk_DeleteSelHandler procedure} {macOrPc} { setup selection own -selection CLIPBOARD .f1 selection handle -selection PRIMARY .f1 {handler STRING} @@ -200,7 +254,7 @@ test select-2.3 {Tk_DeleteSelHandler procedure} { list [lsort [selection get TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] } {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.4 {Tk_DeleteSelHandler procedure} { +test select-2.7 {Tk_DeleteSelHandler procedure} { setup selection handle .f1 {handler STRING} list [selection handle .f1 {}] [selection handle .f1 {}] diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index e3d6b56..364469d 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.6 1999/06/03 18:50:46 stanton Exp $ + * RCS: @(#) $Id: tkUnixSelect.c,v 1.7 2001/07/03 01:03:16 hobbs Exp $ */ #include "tkInt.h" @@ -597,7 +597,7 @@ TkSelEventProc(tkwin, eventPtr) Tcl_Encoding encoding; if (format != 8) { char buf[64 + TCL_INTEGER_SPACE]; - + sprintf(buf, "bad format for string selection: wanted \"8\", got \"%d\"", format); @@ -633,6 +633,35 @@ TkSelEventProc(tkwin, eventPtr) interp, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); Tcl_Release((ClientData) interp); + } else if (type == dispPtr->utf8Atom) { + /* + * The X selection data is in UTF-8 format already. + * We can't guarantee that propInfo is NULL-terminated, + * so we might have to copy the string. + */ + char *propData = propInfo; + + if (format != 8) { + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, + "bad format for string selection: wanted \"8\", got \"%d\"", + format); + Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + retrPtr->result = TCL_ERROR; + return; + } + + if (propInfo[numItems] != '\0') { + propData = ckalloc((size_t) numItems + 1); + strcpy(propData, propInfo); + propData[numItems] = '\0'; + } + retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, + retrPtr->interp, propData); + if (propData != propInfo) { + ckfree((char *) propData); + } } else if (type == dispPtr->incrAtom) { /* @@ -657,7 +686,7 @@ TkSelEventProc(tkwin, eventPtr) if (format != 32) { char buf[64 + TCL_INTEGER_SPACE]; - + sprintf(buf, "bad format for selection: wanted \"32\", got \"%d\"", format); @@ -940,6 +969,15 @@ ConvertSelection(winPtr, eventPtr) XChangeProperty(reply.display, reply.requestor, property, type, format, PropModeReplace, (unsigned char *) propPtr, numItems); + } else if (type == winPtr->dispPtr->utf8Atom) { + /* + * This matches selection requests of type UTF8_STRING, + * which allows us to pass our utf-8 information untouched. + */ + + XChangeProperty(reply.display, reply.requestor, + property, type, 8, PropModeReplace, + (unsigned char *) buffer, numItems); } else if ((type == XA_STRING) || (type == winPtr->dispPtr->compoundTextAtom)) { Tcl_DString ds; -- cgit v0.12