ttk::treeview widget: add 'tag names', 'tag add', and 'tag remove' methods.

8 files changed, 380 insertions, 40 deletions

diff --git a/ChangeLog b/ChangeLog
index a85aeec..cf7daeb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2010-03-28  Joe English  <jenglish@users.sourceforge.net>
+
+	* generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c,
+	generic/ttk/ttkTheme.h, generic/ttk/ttkTreeview.c,
+	generic/ttk/ttkWidget.h, doc/ttk_treeview.n,
+	tests/ttk/treetags.test: ttk::treeview widget: add 'tag names',
+	'tag add', and 'tag remove' methods.
+
 2010-03-23  Donal K. Fellows  <dkf@users.sf.net>
 
 	* unix/configure.in, unix/Makefile.in: [Bug 2965133]: Get rid of the
@@ -534,7 +542,7 @@
 	* unix/configure:	(regenerated)
 
 2009-12-22  Joe English  <jenglish@users.sourceforge.net>
-	
+
 	* library/ttk/sizegrip.tcl: [Bug 2912356]: Patch to avoid bizarro
 	behavior under compiz.
 
diff --git a/doc/ttk_treeview.n b/doc/ttk_treeview.n
index f351fb3..f1a491e 100644
--- a/doc/ttk_treeview.n
+++ b/doc/ttk_treeview.n
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: ttk_treeview.n,v 1.21 2009/11/15 21:09:22 dkf Exp $
+'\" RCS: @(#) $Id: ttk_treeview.n,v 1.22 2010/03/28 21:43:25 jenglish Exp $
 '\" 
 .so man.macros
 .TH ttk::treeview n 8.5 Tk "Tk Themed Widget"
@@ -378,6 +378,20 @@ If \fIitem\fR is specified, returns 1 or 0
 depending on whether the specified item has the named tag.
 Otherwise, returns a list of all items which have
 the specified tag.
+.TP
+\fIpathName \fBtag names\fR
+Returns a list of all tags used by the widget.
+.TP
+\fIpathName \fBtag add\fR \fItag\fR \fIitems\fR
+Adds the specified \fItag\fR to each of the listed \fIitems\fR.
+If \fItag\fR is already present for a particular item,
+then the \fB-tags\fR for that item are unchanged.
+.TP
+\fIpathName \fBtag remove\fR \fItag\fR ?\fIitems\fR?
+Removes the specified \fItag\fR from each of the listed \fIitems\fR.
+If \fIitems\fR is omitted, removes \fItag\fR from each item in the tree.
+If \fItag\fR is not present for a particular item,
+then the \fB-tags\fR for that item are unchanged.
 .RE
 .TP
 \fIpathName \fBxview \fIargs\fR
diff --git a/generic/ttk/ttkTagSet.c b/generic/ttk/ttkTagSet.c
index d925a78..dbf6a5c 100644
--- a/generic/ttk/ttkTagSet.c
+++ b/generic/ttk/ttkTagSet.c
@@ -1,4 +1,4 @@
-/* $Id: ttkTagSet.c,v 1.4 2008/05/23 20:20:05 jenglish Exp $
+/* $Id: ttkTagSet.c,v 1.5 2010/03/28 21:43:25 jenglish Exp $
  *
  * Tag tables.  3/4-baked, work in progress.
  *
@@ -17,7 +17,8 @@
  */
 struct TtkTag {
     int 	priority;		/* 1=>highest */
-    void	*tagRecord;
+    const char	*tagName;		/* Back-pointer to hash table entry */
+    void	*tagRecord;		/* User data */
 };
 
 struct TtkTagTable {
@@ -32,13 +33,14 @@ struct TtkTagTable {
 /*------------------------------------------------------------------------
  * +++ Tags.
  */
-static Ttk_Tag NewTag(Ttk_TagTable tagTable)
+static Ttk_Tag NewTag(Ttk_TagTable tagTable, const char *tagName)
 {
     Ttk_Tag tag = (Ttk_Tag)ckalloc(sizeof(*tag));
     tag->tagRecord = ckalloc(tagTable->recordSize);
     memset(tag->tagRecord, 0, tagTable->recordSize);
     /* Don't need Tk_InitOptions() here, all defaults should be NULL. */
     tag->priority = ++tagTable->nTags;
+    tag->tagName = tagName;
     return tag;
 }
 
@@ -89,7 +91,8 @@ Ttk_Tag Ttk_GetTag(Ttk_TagTable tagTable, const char *tagName)
 	&tagTable->tags, tagName, &isNew);
 
     if (isNew) {
-	Tcl_SetHashValue(entryPtr, NewTag(tagTable));
+	tagName = Tcl_GetHashKey(&tagTable->tags, entryPtr);
+	Tcl_SetHashValue(entryPtr, NewTag(tagTable,tagName));
     }
     return Tcl_GetHashValue(entryPtr);
 }
@@ -139,6 +142,21 @@ Ttk_TagSet Ttk_GetTagSetFromObj(
     return tagset;
 }
 
+/* Ttk_NewTagSetObj --
+ * 	Construct a fresh Tcl_Obj * from a tag set.
+ */
+Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet tagset)
+{
+    Tcl_Obj *result = Tcl_NewListObj(0,0);
+    int i;
+
+    for (i = 0; i < tagset->nTags; ++i) {
+	Tcl_ListObjAppendElement(
+	    NULL, result, Tcl_NewStringObj(tagset->tags[i]->tagName, -1));
+    }
+    return result;
+}
+
 void Ttk_FreeTagSet(Ttk_TagSet tagset)
 {
     ckfree((ClientData)tagset->tags);
@@ -158,10 +176,55 @@ int Ttk_TagSetContains(Ttk_TagSet tagset, Ttk_Tag tag)
     return 0;
 }
 
+/* Ttk_TagSetAdd -- add a tag to a tag set.
+ *
+ * Returns: 0 if tagset already contained tag,
+ * 1 if tagset was modified.
+ */
+int Ttk_TagSetAdd(Ttk_TagSet tagset, Ttk_Tag tag)
+{
+    int i;
+    for (i = 0; i < tagset->nTags; ++i) {
+	if (tagset->tags[i] == tag) {
+	    return 0;
+	}
+    }
+    tagset->tags = (void*)ckrealloc((void*)tagset->tags, 
+	    (tagset->nTags+1)*sizeof(tagset->tags[0]));
+    tagset->tags[tagset->nTags++] = tag;
+    return 1;
+}
+
+/* Ttk_TagSetRemove -- remove a tag from a tag set.
+ *
+ * Returns: 0 if tagset did not contain tag,
+ * 1 if tagset was modified.
+ */
+int Ttk_TagSetRemove(Ttk_TagSet tagset, Ttk_Tag tag)
+{
+    int i = 0, j = 0;
+    while (i < tagset->nTags) {
+	if ((tagset->tags[j] = tagset->tags[i]) != tag) {
+	    ++j;
+	}
+	++i;
+    }
+    tagset->nTags = j;
+    return j != i;
+}
+
 /*------------------------------------------------------------------------
  * +++ Utilities for widget commands.
  */
 
+/* Ttk_EnumerateTags -- implements [$w tag names]
+ */
+int Ttk_EnumerateTags(
+    Tcl_Interp *interp, Ttk_TagTable tagTable)
+{
+    return TtkEnumerateHashTable(interp, &tagTable->tags);
+}
+
 /* Ttk_EnumerateTagOptions -- implements [$w tag configure $tag]
  */
 int Ttk_EnumerateTagOptions(
@@ -171,6 +234,8 @@ int Ttk_EnumerateTagOptions(
 	tagTable->optionSpecs, tagTable->optionTable, tagTable->tkwin);
 }
 
+/* Ttk_TagOptionValue -- implements [$w tag configure $tag -option]
+ */
 Tcl_Obj *Ttk_TagOptionValue(
     Tcl_Interp *interp,
     Ttk_TagTable tagTable,
diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c
index 5bf362d..59df20d 100644
--- a/generic/ttk/ttkTheme.c
+++ b/generic/ttk/ttkTheme.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.
  *
- * $Id: ttkTheme.c,v 1.22 2010/02/05 21:33:14 jenglish Exp $
+ * $Id: ttkTheme.c,v 1.23 2010/03/28 21:43:25 jenglish Exp $
  */
 
 #include <stdlib.h>
@@ -1118,7 +1118,7 @@ Ttk_DrawElement(
  */
 
 /*
- * EnumerateHashTable --
+ * TtkEnumerateHashTable --
  * 	Helper routine.  Sets interp's result to the list of all keys
  * 	in the hash table.
  *
@@ -1126,7 +1126,8 @@ Ttk_DrawElement(
  * Side effects: Sets interp's result.
  */
 
-static int EnumerateHashTable(Tcl_Interp *interp, Tcl_HashTable *ht)
+MODULE_SCOPE
+int TtkEnumerateHashTable(Tcl_Interp *interp, Tcl_HashTable *ht)
 {
     Tcl_HashSearch search;
     Tcl_Obj *result = Tcl_NewListObj(0, NULL);
@@ -1436,7 +1437,7 @@ static int StyleThemeNamesCmd(
     ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
 {
     StylePackageData *pkgPtr = clientData;
-    return EnumerateHashTable(interp, &pkgPtr->themeTable);
+    return TtkEnumerateHashTable(interp, &pkgPtr->themeTable);
 }
 
 /* + style theme settings $theme $script
@@ -1516,7 +1517,7 @@ static int StyleElementNamesCmd(
 	Tcl_WrongNumArgs(interp, 3, objv, NULL);
 	return TCL_ERROR;
     }
-    return EnumerateHashTable(interp, &theme->elementTable);
+    return TtkEnumerateHashTable(interp, &theme->elementTable);
 }
 
 /* + style element options $element --
@@ -1661,7 +1662,8 @@ StyleObjCmd(
     return Ttk_InvokeEnsemble(StyleEnsemble, 1, clientData,interp,objc,objv);
 }
 
-MODULE_SCOPE int Ttk_InvokeEnsemble(	/* Run an ensemble command */
+MODULE_SCOPE 
+int Ttk_InvokeEnsemble(	/* Run an ensemble command */
     const Ttk_Ensemble *ensemble, int cmdIndex,
     void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
 {
diff --git a/generic/ttk/ttkTheme.h b/generic/ttk/ttkTheme.h
index a123db5..0b7c935 100644
--- a/generic/ttk/ttkTheme.h
+++ b/generic/ttk/ttkTheme.h
@@ -1,4 +1,4 @@
-/* $Id: ttkTheme.h,v 1.18 2010/01/31 22:50:56 jenglish Exp $
+/* $Id: ttkTheme.h,v 1.19 2010/03/28 21:43:25 jenglish Exp $
  * Copyright (c) 2003 Joe English.  Freely redistributable.
  *
  * Declarations for Tk theme engine.
@@ -421,6 +421,8 @@ MODULE_SCOPE int Ttk_InvokeEnsemble(	/* Run an ensemble command */
     const Ttk_Ensemble *commands, int cmdIndex,
     void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
 
+MODULE_SCOPE int TtkEnumerateHashTable(Tcl_Interp *, Tcl_HashTable *);
+
 /*------------------------------------------------------------------------
  * +++ Stub table declarations.
  */
diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c
index a1380ba..a023eaf 100644
--- a/generic/ttk/ttkTreeview.c
+++ b/generic/ttk/ttkTreeview.c
@@ -1,4 +1,4 @@
-/* $Id: ttkTreeview.c,v 1.37 2010/02/20 21:30:37 jenglish Exp $
+/* $Id: ttkTreeview.c,v 1.38 2010/03/28 21:43:25 jenglish Exp $
  * Copyright (c) 2004, Joe English
  *
  * ttk::treeview widget implementation.
@@ -3114,10 +3114,110 @@ static int TreeviewTagHasCommand(
     }
 }
 
+/* + $tv tag names $tag
+ */
+static int TreeviewTagNamesCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Treeview *tv = recordPtr;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 3, objv, "");
+	return TCL_ERROR;
+    }
+
+    return Ttk_EnumerateTags(interp, tv->tree.tagTable);
+}
+
+/* + $tv tag add $tag $items
+ */
+static void AddTag(TreeItem *item, Ttk_Tag tag)
+{
+    if (Ttk_TagSetAdd(item->tagset, tag)) {
+	Tcl_DecrRefCount(item->tagsObj);
+	item->tagsObj = Ttk_NewTagSetObj(item->tagset);
+	Tcl_IncrRefCount(item->tagsObj);
+    }
+}
+
+static int TreeviewTagAddCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Treeview *tv = recordPtr;
+    Ttk_Tag tag;
+    TreeItem **items;
+    int i;
+
+    if (objc != 5) {
+	Tcl_WrongNumArgs(interp, 3, objv, "tagName items");
+	return TCL_ERROR;
+    }
+
+    tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+    items = GetItemListFromObj(interp, tv, objv[4]);
+
+    if (!items) {
+	return TCL_ERROR;
+    }
+
+    for (i=0; items[i]; ++i) {
+	AddTag(items[i], tag);
+    }
+
+    return TCL_OK;
+}
+
+/* + $tv tag remove $tag $items
+ */
+static void RemoveTag(TreeItem *item, Ttk_Tag tag)
+{
+    if (Ttk_TagSetRemove(item->tagset, tag)) {
+	Tcl_DecrRefCount(item->tagsObj);
+	item->tagsObj = Ttk_NewTagSetObj(item->tagset);
+	Tcl_IncrRefCount(item->tagsObj);
+    }
+}
+
+static int TreeviewTagRemoveCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Treeview *tv = recordPtr;
+    Ttk_Tag tag;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 3, objv, "tagName items");
+	return TCL_ERROR;
+    }
+
+    tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+
+    if (objc == 5) {
+	TreeItem **items = GetItemListFromObj(interp, tv, objv[4]);
+	int i;
+
+	if (!items) {
+	    return TCL_ERROR;
+	}
+	for (i=0; items[i]; ++i) {
+	    RemoveTag(items[i], tag);
+	}
+    } else if (objc == 4) {
+	TreeItem *item = tv->tree.root;
+	while (item) {
+	    RemoveTag(item, tag);
+	    item=NextPreorder(item);
+	}
+    }
+    return TCL_OK;
+}
+
 static const Ttk_Ensemble TreeviewTagCommands[] = {
+    { "add",		TreeviewTagAddCommand,0 },
     { "bind",		TreeviewTagBindCommand,0 },
     { "configure",	TreeviewTagConfigureCommand,0 },
-    { "has", 		TreeviewTagHasCommand,0 },
+    { "has",		TreeviewTagHasCommand,0 },
+    { "names",		TreeviewTagNamesCommand,0 },
+    { "remove",		TreeviewTagRemoveCommand,0 },
     { 0,0,0 }
 };
 
diff --git a/generic/ttk/ttkWidget.h b/generic/ttk/ttkWidget.h
index a5694be..99df0fb 100644
--- a/generic/ttk/ttkWidget.h
+++ b/generic/ttk/ttkWidget.h
@@ -1,4 +1,4 @@
-/* $Id: ttkWidget.h,v 1.14 2010/02/05 21:33:14 jenglish Exp $
+/* $Id: ttkWidget.h,v 1.15 2010/03/28 21:43:25 jenglish Exp $
  * Copyright (c) 2003, Joe English
  * Helper routines for widget implementations.
  */
@@ -215,18 +215,21 @@ MODULE_SCOPE Tcl_Obj *Ttk_TagOptionValue(
 MODULE_SCOPE int Ttk_EnumerateTagOptions(
     Tcl_Interp *, Ttk_TagTable, Ttk_Tag);
 
+MODULE_SCOPE int Ttk_EnumerateTags(Tcl_Interp *, Ttk_TagTable);
+
 MODULE_SCOPE int Ttk_ConfigureTag(
     Tcl_Interp *interp, Ttk_TagTable tagTable, Ttk_Tag tag,
     int objc, Tcl_Obj *const objv[]);
 
 MODULE_SCOPE Ttk_TagSet Ttk_GetTagSetFromObj(
     Tcl_Interp *interp, Ttk_TagTable, Tcl_Obj *objPtr);
+MODULE_SCOPE Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet);
 
 MODULE_SCOPE void Ttk_FreeTagSet(Ttk_TagSet);
 
 MODULE_SCOPE int Ttk_TagSetContains(Ttk_TagSet, Ttk_Tag tag);
-MODULE_SCOPE void Ttk_TagSetAdd(Ttk_TagSet, Ttk_Tag tag);
-MODULE_SCOPE void Ttk_TagSetRemove(Ttk_TagSet, Ttk_Tag tag);
+MODULE_SCOPE int Ttk_TagSetAdd(Ttk_TagSet, Ttk_Tag tag);
+MODULE_SCOPE int Ttk_TagSetRemove(Ttk_TagSet, Ttk_Tag tag);
 
 MODULE_SCOPE void Ttk_TagSetValues(Ttk_TagTable, Ttk_TagSet, void *record);
 MODULE_SCOPE void Ttk_TagSetApplyStyle(Ttk_TagTable,Ttk_Style,Ttk_State,void*);
diff --git a/tests/ttk/treetags.test b/tests/ttk/treetags.test
index fe4dbcd..ed139a1 100644
--- a/tests/ttk/treetags.test
+++ b/tests/ttk/treetags.test
@@ -1,48 +1,147 @@
 #
-# $Id: treetags.test,v 1.2 2007/05/18 16:53:18 dgp Exp $
+# $Id: treetags.test,v 1.3 2010/03/28 21:43:25 jenglish Exp $
 #
 
-package require Tk 8.5
+package require Tk
 package require tcltest ; namespace import -force tcltest::*
 loadTestedCommands
-tk useinputmethods 0
 
-testConstraint treeview [llength [info commands ttk::treeview]]
-testConstraint nyi 0
+### treeview tag invariants:
+#
+
+proc assert {expr {message ""}} {
+    if {![uplevel 1 [list expr $expr]]} {
+        error "PANIC: $message ($expr failed)"
+    }
+}
+proc in {e l} { expr {[lsearch -exact $l $e] >= 0} }
+
+proc itemConstraints {tv item} {
+    # $tag in [$tv item $item -tags] <==> [$tv tag has $tag $item]
+    foreach tag [$tv item $item -tags] {
+	assert {[in $item [$tv tag has $tag]]}
+    }
+    foreach child [$tv children $item] {
+	itemConstraints $tv $child
+    }
+}
+
+proc treeConstraints {tv} {
+    # $item in [$tv tag has $tag] <==> [$tv tag has $tag $item]
+    #
+    foreach tag [$tv tag names] {
+	foreach item [$tv tag has $tag] {
+	    assert {[in $tag [$tv item $item -tags]]}
+	}
+    }
 
-test treetags-1.0 "Setup" -constraints treeview -body {
+    itemConstraints $tv {}
+}
+#
+###
+
+test treetags-1.0 "Setup" -body {
     set tv [ttk::treeview .tv]
     .tv insert {} end -id item1 -text "Item 1"
-    pack .tv 
+    pack .tv
+} -cleanup {
+    treeConstraints $tv
 }
 
-test treetags-1.1 "Bad tag list" -constraints treeview -body {
+test treetags-1.1 "Bad tag list" -body {
     $tv item item1 -tags {bad {list}here bad}
+    $tv item item1 -tags
 } -returnCodes error -result "list element in braces *" -match glob
 
-test treetags-1.2 "Good tag list" -constraints treeview -body {
+test treetags-1.2 "Good tag list" -body {
     $tv item item1 -tags tag1
     $tv item item1 -tags
+} -cleanup {
+    assert {[$tv tag has tag1 item1]}
+    treeConstraints $tv
 } -result [list tag1]
 
-test treetags-1.3 "Bad events" -constraints treeview -body {
-    $tv tag bind bad <Enter> { puts "Entered!" }
-} -returnCodes 1 -result "unsupported event <Enter>*" -match glob
+test treetags-1.3 "tag has - test" -body {
+    $tv insert {} end -id item2 -text "Item 2" -tags tag2
+    set result [list]
+    foreach item {item1 item2} {
+    	foreach tag {tag1 tag2 tag3} {
+	    lappend result $item $tag [$tv tag has $tag $item]
+	}
+    }
+    set result
+} -cleanup {
+    treeConstraints $tv
+} -result [list \
+	item1 tag1 1 item1 tag2 0 item1 tag3 0 \
+	item2 tag1 0 item2 tag2 1 item2 tag3 0 ]
+
+test treetags-1.4 "tag has - query" -body {
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list item1] [list item2] [list]]
+
+test treetags-1.5 "tag add" -body {
+    $tv tag add tag3 {item1 item2}
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list item1] [list item2] [list item1 item2]]
+
+test treetags-1.6 "tag remove - list" -body {
+    $tv tag remove tag3 {item1 item2}
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list item1] [list item2] [list]]
+
+test treetags-1.7 "tag remove - all items" -body {
+    $tv tag remove tag1
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list] [list item2] [list]]
+
+test treetags-1.8 "tag names" -body {
+    lsort [$tv tag names]
+} -result [list tag1 tag2 tag3]
+
+test treetags-1.9 "tag names - tag added to item" -body {
+    $tv item item1 -tags tag4 
+    lsort [$tv tag names]
+} -result [list tag1 tag2 tag3 tag4]
+
+test treetags-1.10 "tag names - tag configured" -body {
+    $tv tag configure tag5
+    lsort [$tv tag names]
+} -result [list tag1 tag2 tag3 tag4 tag5]
+
+test treetags-1.end "cleanup" -body {
+    $tv item item1 -tags tag1
+    $tv item item2 -tags tag2
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list item1] [list item2] [list]]
 
-test treetags-2.0 "tag bind" -constraints treeview -body {
+test treetags-2.0 "tag bind" -body {
     $tv tag bind tag1 <KeyPress> {set ::KEY %A}
     $tv tag bind tag1 <KeyPress>
+} -cleanup {
+    treeConstraints $tv
 } -result {set ::KEY %A}
 
-test treetags-2.1 "Events delivered to tags" -constraints treeview -body {
+test treetags-2.1 "Events delivered to tags" -body {
     focus -force $tv ; update	;# needed so [event generate] delivers KeyPress
     $tv focus item1
-    event generate .tv <KeyPress-a>
+    event generate $tv <KeyPress-a>
     set ::KEY
+} -cleanup {
+    treeConstraints $tv
 } -result a
 
-test treetags-2.2 "Events delivered to correct tags" -constraints treeview -body {
-    $tv insert {} end -id item2 -tags tag2
+test treetags-2.2 "Events delivered to correct tags" -body {
     $tv tag bind tag2 <KeyPress> [list set ::KEY2 %A]
 
     $tv focus item1
@@ -51,9 +150,11 @@ test treetags-2.2 "Events delivered to correct tags" -constraints treeview -body
     event generate $tv <KeyPress-c>
 
     list $::KEY $::KEY2
+} -cleanup {
+    treeConstraints $tv
 } -result [list b c]
 
-test treetags-2.3 "Virtual events delivered to focus item" -constraints treeview -body {
+test treetags-2.3 "Virtual events delivered to focus item" -body {
     set ::bong 0
     $tv tag bind tag2 <<Bing>> { incr bong }
     $tv focus item2
@@ -61,18 +162,63 @@ test treetags-2.3 "Virtual events delivered to focus item" -constraints treeview
     $tv focus item1
     event generate $tv <<Bing>>
     set bong
+} -cleanup {
+    treeConstraints $tv
 } -result 1
 
+test treetags-2.4 "Bad events" -body {
+    $tv tag bind bad <Enter> { puts "Entered!" }
+} -returnCodes 1 -result "unsupported event <Enter>*" -match glob
 
-test treetags-3.0 "tag configure" -constraints treeview -body {
+test treetags-3.0 "tag configure - set" -body {
     $tv tag configure tag1 -foreground blue -background red
+} -cleanup {
+    treeConstraints $tv
 } -result {}
 
-test treetags-3.1 "tag configure" -constraints treeview -body {
+test treetags-3.1 "tag configure - get" -body {
     $tv tag configure tag1 -foreground
-} -result [list blue]
+} -cleanup {
+    treeConstraints $tv
+} -result blue
+
+# @@@ fragile test
+test treetags-3.2 "tag configure - enumerate" -body {
+    $tv tag configure tag1
+} -cleanup {
+    treeConstraints $tv
+} -result [list \
+    -text {} -image {} -anchor {} -background red -foreground blue -font {} \
+]
+
+# The next test exercises tag resource management.
+# If options are not properly freed, the message:
+# Test file error: "Font times 20 still in cache."
+# will show up on stderr at program exit.
+#
+test treetags-3.3 "tag configure - set font" -body {
+    $tv tag configure tag2 -font {times 20}
+}
+
+test treetags-3.4 "stomp tags in tag binding procedure" -body {
+    set result [list]
+    $tv tag bind rm1 <<Remove>> { lappend ::result rm1 [%W focus] <<Remove>> }
+    $tv tag bind rm2 <<Remove>> {
+    	lappend ::result rm2 [%W focus] <<Remove>> 
+	%W item [%W focus] -tags {tag1}
+    }
+    $tv tag bind rm3 <<Remove>> { lappend ::result rm3 [%W focus] <<Remove>> }
 
+    $tv item item1 -tags {rm1 rm2 rm3} 
+    $tv focus item1
+    event generate $tv <<Remove>>
+    set result
+} -cleanup {
+    treeConstraints $tv
+} -result [list rm1 item1 <<Remove>> rm2 item1 <<Remove>> rm3 item1 <<Remove>>]
+
+#
 
-test treetags-end "Cleanup" -constraints treeview -body { destroy .tv }
+test treetags-end "Cleanup" -body { destroy $tv }
 
 tcltest::cleanupTests