summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2008-10-28 17:44:38 (GMT)
committerdgp <dgp@users.sourceforge.net>2008-10-28 17:44:38 (GMT)
commitc6809cbce555f56fd88713fb23268419af120d54 (patch)
tree972e11ab081e24201e5cde984e8e84395f1efa60
parentb88117d1876391881d90f05ad4bfabf9b05ade97 (diff)
downloadtk-c6809cbce555f56fd88713fb23268419af120d54.zip
tk-c6809cbce555f56fd88713fb23268419af120d54.tar.gz
tk-c6809cbce555f56fd88713fb23268419af120d54.tar.bz2
* win/tkWinTest.c: Revise [testclipboard] to form that
* tests/winClipboard.test: handles encodings. [Bug 2191960] * tests/constraints.tcl: [tcltest::bytestring] no longer used.
-rw-r--r--ChangeLog6
-rw-r--r--tests/constraints.tcl1
-rw-r--r--tests/winClipboard.test4
-rw-r--r--win/tkWinTest.c40
4 files changed, 23 insertions, 28 deletions
diff --git a/ChangeLog b/ChangeLog
index 034b873..22a6b31 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2008-10-28 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tkWinTest.c: Revise [testclipboard] to form that
+ * tests/winClipboard.test: handles encodings. [Bug 2191960]
+ * tests/constraints.tcl: [tcltest::bytestring] no longer used.
+
2008-10-24 Joe English <jenglish@users.sourceforge.net>
* tests/ttk/ttk.test: Disable test ttk-6.3, it's not
diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 03e3547..0750d7a 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -242,7 +242,6 @@ namespace import -force tcltest::removeDirectory
namespace import -force tcltest::interpreter
namespace import -force tcltest::testsDirectory
namespace import -force tcltest::cleanupTests
-namespace import -force tcltest::bytestring
deleteWindows
wm geometry . {}
diff --git a/tests/winClipboard.test b/tests/winClipboard.test
index 13f0349..90810f3 100644
--- a/tests/winClipboard.test
+++ b/tests/winClipboard.test
@@ -10,7 +10,7 @@
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winClipboard.test,v 1.15 2008/08/18 16:09:10 aniap Exp $
+# RCS: @(#) $Id: winClipboard.test,v 1.16 2008/10/28 17:44:38 dgp Exp $
package require tcltest 2.2
eval tcltest::configure $argv
@@ -71,7 +71,7 @@ test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} -constraints {
list [selection get -selection CLIPBOARD] [testclipboard]
} -cleanup {
clipboard clear
-} -result [list "line 1\u00c7\nline 2" [bytestring "line 1\u00c7\r\nline 2"]]
+} -result [list "line 1\u00c7\nline 2" "line 1\u00c7\r\nline 2"]
test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} -constraints {
diff --git a/win/tkWinTest.c b/win/tkWinTest.c
index 6de5563..18c72f8 100644
--- a/win/tkWinTest.c
+++ b/win/tkWinTest.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: tkWinTest.c,v 1.17 2008/04/27 22:39:17 dkf Exp $
+ * RCS: @(#) $Id: tkWinTest.c,v 1.18 2008/10/28 17:44:38 dgp Exp $
*/
#include "tkWinInt.h"
@@ -34,6 +34,7 @@ static int TestgetwindowinfoObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp);
+Tk_GetSelProc SetSelectionResult;
/*
@@ -176,12 +177,23 @@ AppendSystemError(
*/
static int
+SetSelectionResult(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ const char *selection)
+{
+ Tcl_AppendResult(interp, selection, NULL);
+ return TCL_OK;
+}
+
+static int
TestclipboardObjCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
+ Tk_Window tkwin = (Tk_Window) clientData;
HGLOBAL handle;
char *data;
int code = TCL_OK;
@@ -190,30 +202,8 @@ TestclipboardObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- if (OpenClipboard(NULL)) {
- /*
- * We could consider using CF_UNICODETEXT on NT, but then we would
- * have to convert it from External. Instead we'll just take this and
- * do "bytestring" at the Tcl level for Unicode inclusive text
- */
-
- handle = GetClipboardData(CF_TEXT);
- if (handle != NULL) {
- data = GlobalLock(handle);
- Tcl_AppendResult(interp, data, NULL);
- GlobalUnlock(handle);
- } else {
- Tcl_AppendResult(interp, "null clipboard handle", NULL);
- code = TCL_ERROR;
- }
- CloseClipboard();
- return code;
- } else {
- Tcl_AppendResult(interp, "couldn't open clipboard: ", NULL);
- AppendSystemError(interp, GetLastError());
- return TCL_ERROR;
- }
- return TCL_OK;
+ return TkSelGetSelection(interp, tkwin, Tk_InternAtom(tkwin, "CLIPBOARD"),
+ XA_STRING, SetSelectionResult, NULL);
}
/*