ttk::treeview: [$tv tag bind $tag <...> {}] now removes binding completely.

Fixes [Bug 3006842] (although there's still a problem somewhere
in Tk_CreateBinding()).

3 files changed, 41 insertions, 18 deletions

diff --git a/ChangeLog b/ChangeLog
index 54544a1..ee9628b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2010-05-27  Joe English <jenglish@users.sourceforge.net>
+
+	* generic/ttk/ttkTreeview.c, tests/ttk/treeview.test:
+	[$tv tag bind $tag <...> {}] now removes binding completely.
+	Fixes [Bug 3006842] (although there's still a problem somewhere
+	in Tk_CreateBinding()).
+
 2010-05-26  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* tests/wm.test: Fix 3 tests on Ubuntu 10.4, two of them timing dependent,
diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c
index a023eaf..6672318 100644
--- a/generic/ttk/ttkTreeview.c
+++ b/generic/ttk/ttkTreeview.c
@@ -1,4 +1,4 @@
-/* $Id: ttkTreeview.c,v 1.38 2010/03/28 21:43:25 jenglish Exp $
+/* $Id: ttkTreeview.c,v 1.39 2010/05/27 19:27:04 jenglish Exp $
  * Copyright (c) 2004, Joe English
  *
  * ttk::treeview widget implementation.
@@ -3005,6 +3005,8 @@ static int TreeviewTagBindCommand(
     void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
 {
     Treeview *tv = recordPtr;
+    Ttk_TagTable tagTable = tv->tree.tagTable;
+    Tk_BindingTable bindingTable = tv->tree.bindingTable;
     Ttk_Tag tag;
 
     if (objc < 4 || objc > 6) {
@@ -3012,37 +3014,40 @@ static int TreeviewTagBindCommand(
 	return TCL_ERROR;
     }
 
-    tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+    tag = Ttk_GetTagFromObj(tagTable, objv[3]);
     if (!tag) { return TCL_ERROR; }
 
     if (objc == 4) {		/* $tv tag bind $tag */
-	Tk_GetAllBindings(interp, tv->tree.bindingTable, tag);
+	Tk_GetAllBindings(interp, bindingTable, tag);
     } else if (objc == 5) { 	/* $tv tag bind $tag $sequence */
 	/* TODO: distinguish "no such binding" (OK) from "bad pattern" (ERROR)
 	 */
 	const char *script = Tk_GetBinding(interp,
-		tv->tree.bindingTable, tag, Tcl_GetString(objv[4]));
+		bindingTable, tag, Tcl_GetString(objv[4]));
 	if (script != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(script,-1));
 	}
     } else if (objc == 6) {	/* $tv tag bind $tag $sequence $script */
 	const char *sequence = Tcl_GetString(objv[4]);
 	const char *script = Tcl_GetString(objv[5]);
-	unsigned long mask = Tk_CreateBinding(interp,
-		tv->tree.bindingTable, tag, sequence, script, 0);
 
-	/* Test mask to make sure event is supported:
-	 */
-	if (mask & (~TreeviewBindEventMask)) {
-	    Tk_DeleteBinding(interp, tv->tree.bindingTable, tag, sequence);
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "unsupported event ", sequence,
-		"\nonly key, button, motion, and virtual events supported",
-		NULL);
-	    return TCL_ERROR;
+	if (!*script) { /* Delete existing binding */
+	    Tk_DeleteBinding(interp, bindingTable, tag, sequence);
+	} else {
+	    unsigned long mask = Tk_CreateBinding(interp,
+		    bindingTable, tag, sequence, script, 0);
+
+	    /* Test mask to make sure event is supported:
+	     */
+	    if (mask & (~TreeviewBindEventMask)) {
+		Tk_DeleteBinding(interp, bindingTable, tag, sequence);
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "unsupported event ", sequence,
+		    "\nonly key, button, motion, and virtual events supported",
+		    NULL);
+		return TCL_ERROR;
+	    }
 	}
-
-	return mask ? TCL_OK : TCL_ERROR;
     }
     return TCL_OK;
 }
diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test
index a56f778..2cb1704 100644
--- a/tests/ttk/treeview.test
+++ b/tests/ttk/treeview.test
@@ -1,5 +1,5 @@
 #
-# $Id: treeview.test,v 1.6 2008/12/27 18:54:56 jenglish Exp $
+# $Id: treeview.test,v 1.7 2010/05/27 19:27:04 jenglish Exp $
 #
 # [7Jun2005] TO CHECK: [$tv see {}] -- shouldn't work (at least, shouldn't do
 # what it currently does)
@@ -607,4 +607,15 @@ test treeview-10.1 "Root node properly initialized (#1541739)" -setup {
     destroy .tv
 }
 
+test treeview-3006842 "Null bindings" -setup {
+    ttk::treeview .tv -show tree
+} -body {
+    .tv tag bind empty <ButtonPress-1> {}
+    .tv insert {} end -text "Click me" -tags empty
+    event generate .tv <ButtonPress-1> -x 10 -y 10
+    .tv tag bind empty
+} -result {} -cleanup {
+    destroy .tv
+}
+
 tcltest::cleanupTests