summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog10
-rw-r--r--doc/ttk_treeview.n16
-rw-r--r--generic/ttk/ttkTagSet.c73
-rw-r--r--generic/ttk/ttkTheme.c14
-rw-r--r--generic/ttk/ttkTheme.h4
-rw-r--r--generic/ttk/ttkTreeview.c104
-rw-r--r--generic/ttk/ttkWidget.h9
-rw-r--r--tests/ttk/treetags.test190
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