blob: e19783db2d5e11ab75bee27238d8b641ad2dfb6b (
plain)
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
# Commands covered: display code
#
# This file contains a collection of tests for the style widget command of
# the tktreectrl extension. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 2000 by Scriptics Corporation.
# Copyright (c) 2002 by Christian Krone.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# CVS: @(#) $Id: display.test,v 1.1 2006/11/25 21:40:07 treectrl Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import ::tcltest::*
}
package require Tk
package require treectrl
test display-0.1 {some needed preparations} -body {
# The size of the window is important.
pack [treectrl .t -width 500 -height 400]
.t element create e1 text -text "Hello,"
.t element create e2 window -destroy yes
.t element create e3 text -text " world!"
.t style create S1
.t style elements S1 {e1 e2 e3}
.t style layout S1 e2 -iexpand x -squeeze x
.t column create -text "Column 0" -tags C0 -itemstyle S1
.t column create -text "Column 1" -tags C1 -itemstyle S1
.t column create -text "Column 2" -tags C2 -itemstyle S1
.t column create -text "Column 3" -tags C3 -itemstyle S1
foreach I [.t item create -count 10 -parent root] {
foreach C [.t column list] {
.t item element configure $I $C e2 -window [entry .t.w${I}C$C]
}
}
update ; # make sure it is visible
} -result {}
test display-1.1 {<ItemVisibility>: hide some items} -body {
.t notify bind .t <ItemVisibility> {
puts -nonewline "%P visible=[list [lsort -integer %v]] hidden=[list [lsort -integer %h]]"
}
.t item configure {list {2 5 9}} -visible no
update idletasks
} -output {<ItemVisibility> visible={} hidden={2 5 9}}
test display-1.2 {<ItemVisibility>: show some items} -body {
.t item configure {list {9 2}} -visible yes
update idletasks
} -output {<ItemVisibility> visible={2 9} hidden={}}
test display-1.3 {<ItemVisibility>: hide & show some items} -body {
.t item configure {list {5}} -visible yes
.t item configure {list {6 7}} -visible no
update idletasks
} -output {<ItemVisibility> visible=5 hidden={6 7}}
test display-1.4 {<ItemVisibility>: delete an item when it becomes visible} -body {
.t notify bind .t <ItemVisibility> {
%T item delete {list %v}
}
.t notify bind .t <ItemDelete> {
puts -nonewline "%P [list [lsort -integer %i]]"
}
.t item configure 6 -visible yes
# Deleting an item that is being displayed should not segfault.
update idletasks
} -output {<ItemDelete> 6}
test display-2.1 {<Configure>: resizing a column resizes a window element} -body {
set w [.t item element cget 2 C1 e2 -window]
bind $w <Configure> {
puts -nonewline "<Configure> %W"
}
.t column configure C1 -width 100
update idletasks
} -output {<Configure> .t.w2C1}
test display-2.2 {<Configure>: delete a column when a window in a previous column is resized during a display update} -body {
set w [.t item element cget 2 C1 e2 -window]
bind $w <Configure> {+
.t column delete C2
}
.t column configure C1 -width 150
# Deleting a column while displaying an item should not segfault.
update idletasks
} -output {<Configure> .t.w2C1}
test display-2.3 {<Configure>: delete a column when a window in a previous column is resized during a display update} -body {
set w [.t item element cget 2 C1 e2 -window]
bind $w <Configure> {
.t item delete 2
}
.t column configure C1 -width 100
# Deleting an item while displaying it should not segfault.
update idletasks
} -output {<ItemDelete> 2}
test display-3.1 {<Scroll>} -body {
.t configure -width 200
update idletasks
.t notify bind .t <Scroll-x> {
puts -nonewline "%P"
}
.t xview moveto 1.0
update idletasks
} -output {<Scroll-x>}
test display-3.2 {<Scroll>: delete an item while scrolling} -body {
.t notify bind .t <Scroll-x> {
.t item delete 8
.t notify unbind .t <Scroll-x>
}
.t xview moveto 0.0
# Causing a display update while scrolling (during a display update) should
# restart the display update and not operate on deleted items.
update idletasks
} -output {<ItemDelete> 8}
test display-99.1 {delete the tree during a display update} -body {
.t notify bind .t <ItemVisibility> {
destroy .t
}
.t item configure 4 -visible no
update idletasks
winfo exists .t
} -result {0}
# cleanup
::tcltest::cleanupTests
return
|
