summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog23
-rw-r--r--generic/tkInt.h3
-rw-r--r--generic/tkSelect.c119
-rw-r--r--library/console.tcl6
-rw-r--r--library/entry.tcl8
-rw-r--r--library/spinbox.tcl8
-rw-r--r--library/text.tcl8
-rw-r--r--library/tk.tcl34
-rw-r--r--tests/select.test70
-rw-r--r--unix/tkUnixSelect.c44
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 <jeffh@ActiveState.com>
+ * 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 <Insert> {
- catch {tkConsoleInsert %W [selection get -displayof %W]}
+ catch {tkConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
break
}
bind $win <KeyPress> {
@@ -397,7 +397,7 @@ proc tkConsoleBind {win} {
}
bind $win <<Paste>> {
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 <<Paste>> {
%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 <<Paste>> event, so we don't need to do anything here.
if {[string compare $tcl_platform(platform) "windows"]} {
bind Entry <Insert> {
- 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 <<Paste>> {
%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 <<Paste>> event, so we don't need to do anything here.
if {[string compare $tcl_platform(platform) "windows"]} {
bind Spinbox <Insert> {
- 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 <<PasteSelection>> {
}
}
bind Text <Insert> {
- catch {tkTextInsert %W [selection get -displayof %W]}
+ catch {tkTextInsert %W [::tk::GetSelection %W PRIMARY]}
}
bind Text <KeyPress> {
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;
generated by cgit v0.12 at 2024-07-03 02:07:01 (GMT)