Fix [9b0f3ee54e]: Make the error message more specific when OpenClipboard fails (on Windows), and tell the user that another application grabbed the clipboard. This will help identification of false tests failures, specifically some winClipboard tests fail when a VNC viewer is open.

3 files changed, 16 insertions, 4 deletions

diff --git a/tests/clipboard.test b/tests/clipboard.test
index 513517d..81534d5 100644
--- a/tests/clipboard.test
+++ b/tests/clipboard.test
@@ -11,6 +11,11 @@
 # environment variable TK_ALT_DISPLAY is set to an alternate display.
 #
 
+#################################################################
+# Note that some of these tests may fail if another application #
+# is grabbing the clipboard (e.g. an X server, or a VNC viewer) #
+#################################################################
+
 package require tcltest 2.2
 namespace import ::tcltest::*
 eval tcltest::configure $argv
diff --git a/tests/winClipboard.test b/tests/winClipboard.test
index 2a7ad73..2f72966 100644
--- a/tests/winClipboard.test
+++ b/tests/winClipboard.test
@@ -15,8 +15,10 @@ eval tcltest::configure $argv
 tcltest::loadTestedCommands
 namespace import -force tcltest::test
 
-# Note that these tests may fail if another application is grabbing the
-# clipboard (e.g. an X server)
+#################################################################
+# Note that some of these tests may fail if another application #
+# is grabbing the clipboard (e.g. an X server, or a VNC viewer) #
+#################################################################
 
 test winClipboard-1.1 {TkSelGetSelection} -constraints win -setup {
     clipboard clear
diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c
index 03c0cde..877eed4 100644
--- a/win/tkWinClipboard.c
+++ b/win/tkWinClipboard.c
@@ -55,9 +55,14 @@ TkSelGetSelection(
     Tcl_Encoding encoding;
     int result, locale, noBackslash = 0;
 
+    if (!OpenClipboard(NULL)) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	        "clipboard cannot be opened, another application grabbed it"));
+        Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "BUSY", NULL);
+        return TCL_ERROR;
+    }
     if ((selection != Tk_InternAtom(tkwin, "CLIPBOARD"))
-	    || (target != XA_STRING)
-	    || !OpenClipboard(NULL)) {
+	    || (target != XA_STRING)) {
 	goto error;
     }