Tk Source Code

Changes On Branch tip-574
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch bug-1bb2f1d7ab Excluding Merge-Ins

This is equivalent to a diff from 9a619439 to 69cfdac8

2020-05-24
08:46
Merge implementation of TIP #574 following acceptation by vote. check-in: 5137a72f user: fvogel tags: trunk
2020-05-09
12:41
Fix [88c9e0928b]: Treeview: wrong keyboard navigation with -selectmode none. Patch from Emiliano Gavilan. check-in: 702ebb7e user: fvogel tags: trunk
2020-05-08
16:04
A few cosmetic changes Closed-Leaf check-in: 69cfdac8 user: fvogel tags: bug-1bb2f1d7ab, tip-574
14:44
Add test treetags-1.11 testing [.tree tag delete]. Also remove old proc in since Tcl features this operator natively. By Emiliano Gavilan. check-in: 0585636a user: fvogel tags: bug-1bb2f1d7ab, tip-574
14:43
Fix [1bb2f1d7ab]: ttk::treeview doesn't delete tags. Patch from Emiliano Gavilan. check-in: 026c74c5 user: fvogel tags: bug-1bb2f1d7ab, tip-574
2020-05-07
02:04
Restore sheets in Mac file dialogs check-in: 9a619439 user: kevin_walzer tags: trunk
2020-05-05
18:05
Implement rfe [4cda3ff048]: more efficient conversion from Tcl UTF to NSString based on a suggestion by Christopher Chavez. check-in: 3c7ba230 user: culler tags: trunk

Changes to doc/ttk_treeview.n.

340
341
342
343
344
345
346





347
348
349
350
351
352
353
.TP
\fIpathname \fBstate\fR ?\fIstateSpec\fR?
Modify or query the widget state; see \fIttk::widget(n)\fR.
.TP
\fIpathName \fBtag \fIargs...\fR
.RS
.TP





\fIpathName \fBtag bind \fItagName \fR?\fIsequence\fR? ?\fIscript\fR?
Add a Tk binding script for the event sequence \fIsequence\fR
to the tag \fItagName\fR.  When an X event is delivered to an item,
binding scripts for each of the item's \fB\-tags\fR are evaluated
in order as per \fIbindtags(n)\fR.
.RS
.PP







>
>
>
>
>







340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
.TP
\fIpathname \fBstate\fR ?\fIstateSpec\fR?
Modify or query the widget state; see \fIttk::widget(n)\fR.
.TP
\fIpathName \fBtag \fIargs...\fR
.RS
.TP
\fIpathName \fBtag add \fItag items\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 bind \fItagName \fR?\fIsequence\fR? ?\fIscript\fR?
Add a Tk binding script for the event sequence \fIsequence\fR
to the tag \fItagName\fR.  When an X event is delivered to an item,
binding scripts for each of the item's \fB\-tags\fR are evaluated
in order as per \fIbindtags(n)\fR.
.RS
.PP
368
369
370
371
372
373
374






375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
If a single \fIoption\fR is specified,
returns the value of that option
(or the empty string if the option has not been specified for \fItagName\fR).
With no additional arguments,
returns a dictionary of the option settings for \fItagName\fR.
See \fBTAG OPTIONS\fR for the list of available options.
.TP






\fIpathName \fBtag has \fItagName\fR ?\fIitem\fR?
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 \fItag items\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 \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
.PP







>
>
>
>
>
>









<
<
<
<
<







373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394





395
396
397
398
399
400
401
If a single \fIoption\fR is specified,
returns the value of that option
(or the empty string if the option has not been specified for \fItagName\fR).
With no additional arguments,
returns a dictionary of the option settings for \fItagName\fR.
See \fBTAG OPTIONS\fR for the list of available options.
.TP
\fIpathName \fBtag delete \fItagName\fR
Deletes all tag information for the \fItagName\fR argument. The
command removes the tag from all items in the widget and also deletes any
other information associated with the tag, such as bindings and display
information. The command returns an empty string.
.TP
\fIpathName \fBtag has \fItagName\fR ?\fIitem\fR?
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 remove \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
.PP

Changes to generic/ttk/ttkTagSet.c.

75
76
77
78
79
80
81











82
83
84
85
86
87
88
	DeleteTag(tagTable, (Ttk_Tag)Tcl_GetHashValue(entryPtr));
	entryPtr = Tcl_NextHashEntry(&search);
    }

    Tcl_DeleteHashTable(&tagTable->tags);
    ckfree(tagTable);
}












Ttk_Tag Ttk_GetTag(Ttk_TagTable tagTable, const char *tagName)
{
    int isNew = 0;
    Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
	&tagTable->tags, tagName, &isNew);








>
>
>
>
>
>
>
>
>
>
>







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
	DeleteTag(tagTable, (Ttk_Tag)Tcl_GetHashValue(entryPtr));
	entryPtr = Tcl_NextHashEntry(&search);
    }

    Tcl_DeleteHashTable(&tagTable->tags);
    ckfree(tagTable);
}

void Ttk_DeleteTagFromTable(Ttk_TagTable tagTable, Ttk_Tag tag)
{
    Tcl_HashEntry *entryPtr;

    entryPtr = Tcl_FindHashEntry(&tagTable->tags, tag->tagName);
    if (entryPtr != NULL) {
        DeleteTag(tagTable, tag);
        Tcl_DeleteHashEntry(entryPtr);
    }
}

Ttk_Tag Ttk_GetTag(Ttk_TagTable tagTable, const char *tagName)
{
    int isNew = 0;
    Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
	&tagTable->tags, tagName, &isNew);

Changes to generic/ttk/ttkTreeview.c.

75
76
77
78
79
80
81



82
83
84
85
86
87
88
    {TK_OPTION_STRING, "-tags", "tags", "Tags",
	NULL, offsetof(TreeItem,tagsObj), TCL_AUTO_LENGTH,
	TK_OPTION_NULL_OK,0,ITEM_OPTION_TAGS_CHANGED },

    {TK_OPTION_END, 0,0,0, NULL, TCL_AUTO_LENGTH,TCL_AUTO_LENGTH, 0,0,0}
};




/* + NewItem --
 * 	Allocate a new, uninitialized, unlinked item
 */
static TreeItem *NewItem(void)
{
    TreeItem *item = (TreeItem *)ckalloc(sizeof(*item));








>
>
>







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
    {TK_OPTION_STRING, "-tags", "tags", "Tags",
	NULL, offsetof(TreeItem,tagsObj), TCL_AUTO_LENGTH,
	TK_OPTION_NULL_OK,0,ITEM_OPTION_TAGS_CHANGED },

    {TK_OPTION_END, 0,0,0, NULL, TCL_AUTO_LENGTH,TCL_AUTO_LENGTH, 0,0,0}
};

/* Forward declaration */
static void RemoveTag(TreeItem *, Ttk_Tag);

/* + NewItem --
 * 	Allocate a new, uninitialized, unlinked item
 */
static TreeItem *NewItem(void)
{
    TreeItem *item = (TreeItem *)ckalloc(sizeof(*item));

2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970

    Treeview *tv = (Treeview *)recordPtr;
    int selop, i;
    TreeItem *item, **items;

    if (objc == 2) {
	Tcl_Obj *result = Tcl_NewListObj(0,0);
	for (item = tv->tree.root->children; item; item=NextPreorder(item)) {
	    if (item->state & TTK_STATE_SELECTED)
		Tcl_ListObjAppendElement(NULL, result, ItemID(tv, item));
	}
	Tcl_SetObjResult(interp, result);
	return TCL_OK;
    }








|







2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973

    Treeview *tv = (Treeview *)recordPtr;
    int selop, i;
    TreeItem *item, **items;

    if (objc == 2) {
	Tcl_Obj *result = Tcl_NewListObj(0,0);
	for (item = tv->tree.root->children; item; item = NextPreorder(item)) {
	    if (item->state & TTK_STATE_SELECTED)
		Tcl_ListObjAppendElement(NULL, result, ItemID(tv, item));
	}
	Tcl_SetObjResult(interp, result);
	return TCL_OK;
    }

2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
    if (!items) {
	return TCL_ERROR;
    }

    switch (selop)
    {
	case SELECTION_SET:
	    for (item=tv->tree.root; item; item=NextPreorder(item)) {
		item->state &= ~TTK_STATE_SELECTED;
	    }
	    /*FALLTHRU*/
	case SELECTION_ADD:
	    for (i=0; items[i]; ++i) {
		items[i]->state |= TTK_STATE_SELECTED;
	    }







|







2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
    if (!items) {
	return TCL_ERROR;
    }

    switch (selop)
    {
	case SELECTION_SET:
	    for (item=tv->tree.root; item; item = NextPreorder(item)) {
		item->state &= ~TTK_STATE_SELECTED;
	    }
	    /*FALLTHRU*/
	case SELECTION_ADD:
	    for (i=0; items[i]; ++i) {
		items[i]->state |= TTK_STATE_SELECTED;
	    }
3097
3098
3099
3100
3101
3102
3103




























3104
3105
3106
3107
3108
3109
3110
	} /* else */
	return TCL_ERROR;
    }
    /* else */
    TtkRedisplayWidget(&tv->core);
    return Ttk_ConfigureTag(interp, tagTable, tag, objc - 4, objv + 4);
}





























/* + $tv tag has $tag ?$item?
 */
static int TreeviewTagHasCommand(
    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
    Treeview *tv = (Treeview *)recordPtr;







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
	} /* else */
	return TCL_ERROR;
    }
    /* else */
    TtkRedisplayWidget(&tv->core);
    return Ttk_ConfigureTag(interp, tagTable, tag, objc - 4, objv + 4);
}

/* + $tv tag delete $tag
 */
static int TreeviewTagDeleteCommand(
    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
    Treeview *tv = (Treeview *)recordPtr;
    Ttk_TagTable tagTable = tv->tree.tagTable;
    TreeItem *item = tv->tree.root;
    Ttk_Tag tag;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 3, objv, "tagName");
	return TCL_ERROR;
    }

    tag = Ttk_GetTagFromObj(tagTable, objv[3]);
    /* remove the tag from all items */
    while (item) {
	RemoveTag(item, tag);
	item = NextPreorder(item);
    }
    /* then remove the tag from the tag table */
    Ttk_DeleteTagFromTable(tagTable, tag);
    TtkRedisplayWidget(&tv->core);

    return TCL_OK;
}

/* + $tv tag has $tag ?$item?
 */
static int TreeviewTagHasCommand(
    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
    Treeview *tv = (Treeview *)recordPtr;
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246

3247
3248
3249
3250
3251
3252
3253
	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);
	}
    }

    TtkRedisplayWidget(&tv->core);

    return TCL_OK;
}

static const Ttk_Ensemble TreeviewTagCommands[] = {
    { "add",		TreeviewTagAddCommand,0 },
    { "bind",		TreeviewTagBindCommand,0 },
    { "configure",	TreeviewTagConfigureCommand,0 },

    { "has",		TreeviewTagHasCommand,0 },
    { "names",		TreeviewTagNamesCommand,0 },
    { "remove",		TreeviewTagRemoveCommand,0 },
    { 0,0,0 }
};

/*------------------------------------------------------------------------







|












>







3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
	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);
	}
    }

    TtkRedisplayWidget(&tv->core);

    return TCL_OK;
}

static const Ttk_Ensemble TreeviewTagCommands[] = {
    { "add",		TreeviewTagAddCommand,0 },
    { "bind",		TreeviewTagBindCommand,0 },
    { "configure",	TreeviewTagConfigureCommand,0 },
    { "delete",		TreeviewTagDeleteCommand,0 },
    { "has",		TreeviewTagHasCommand,0 },
    { "names",		TreeviewTagNamesCommand,0 },
    { "remove",		TreeviewTagRemoveCommand,0 },
    { 0,0,0 }
};

/*------------------------------------------------------------------------

Changes to generic/ttk/ttkWidget.h.

221
222
223
224
225
226
227


228
229
230
231
232
233
234
MODULE_SCOPE Tcl_Obj *Ttk_TagOptionValue(
    Tcl_Interp *, Ttk_TagTable, Ttk_Tag, Tcl_Obj *optionName);

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);







>
>







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
MODULE_SCOPE Tcl_Obj *Ttk_TagOptionValue(
    Tcl_Interp *, Ttk_TagTable, Ttk_Tag, Tcl_Obj *optionName);

MODULE_SCOPE int Ttk_EnumerateTagOptions(
    Tcl_Interp *, Ttk_TagTable, Ttk_Tag);

MODULE_SCOPE int Ttk_EnumerateTags(Tcl_Interp *, Ttk_TagTable);

MODULE_SCOPE void Ttk_DeleteTagFromTable(Ttk_TagTable, Ttk_Tag);

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);

Changes to tests/ttk/treetags.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

package require Tk
package require tcltest ; namespace import -force tcltest::*
loadTestedCommands

### 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]]}
	}
    }

    itemConstraints $tv {}
}
#
###













<




|











|







1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

package require Tk
package require tcltest ; namespace import -force tcltest::*
loadTestedCommands

### treeview tag invariants:
#

proc assert {expr {message ""}} {
    if {![uplevel 1 [list expr $expr]]} {
        error "PANIC: $message ($expr failed)"
    }
}


proc itemConstraints {tv item} {
    # $tag in [$tv item $item -tags] <==> [$tv tag has $tag $item]
    foreach tag [$tv item $item -tags] {
	assert {$item in [$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 {$tag in [$tv item $item -tags]}
	}
    }

    itemConstraints $tv {}
}
#
###
109
110
111
112
113
114
115






116
117
118
119
120
121
122
    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







>
>
>
>
>
>







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    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.11 "tag delete" -body {
    $tv tag delete tag5
    $tv tag delete tag4
    lsort [$tv tag names]
} -result [list tag1 tag2 tag3]

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