# 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.
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-3.3 {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}
# Create a 40x40 item
# Check bounds via [item bbox], [marquee identify] and [item id "nearest x y"]
# Configure -canvaspadx and -canvaspady with positive values
# Check item bounds
# Create another 40x40 item to right of the first (horizontal layout)
# Check item bounds
# Configure -itemgapx with positive value
# Check item bounds
test display-4.1 {item layout} -setup {
catch {destroy .t}
pack [treectrl .t -width 500 -height 500]
.t configure -showroot 0 -showheader 0 -highlightthickness 0 \
-borderwidth 0 -orient horizontal
.t column create -tags C1
.t element create E1 rect -width 40 -height 40
.t style create S1
.t style elements S1 [list E1]
.t item create -parent root -tags I1
.t item style set I1 C1 S1
update ; # make sure it is visible
} -body {
.t item bbox I1
} -result {0 0 40 40}
test display-4.2 {item layout} -setup {
.t configure -canvaspadx 10
} -body {
.t item bbox I1
} -result {10 0 50 40}
test display-4.3 {item layout} -setup {
.t configure -canvaspadx 0 -canvaspady 10
} -body {
.t item bbox I1
} -result {0 10 40 50}
test display-4.4 {item layout} -setup {
.t configure -canvaspadx 10 -canvaspady 10
} -body {
.t item bbox I1
} -result {10 10 50 50}
test display-4.5 {item layout} -body {
.t identify 0 0
} -result {}
test display-4.6 {item layout} -body {
.t identify 9 9
} -result {}
test display-4.7 {item layout} -body {
.t identify 50 50
} -result {}
test display-4.8 {item layout} -body {
.t identify 50 10
} -result {}
test display-4.9 {item layout} -body {
.t identify 10 50
} -result {}
test display-4.10 {item layout} -body {
.t identify 10 10
} -result {item 1 column 0 elem E1}
test display-4.11 {item layout} -body {
.t identify 49 10
} -result {item 1 column 0 elem E1}
test display-4.12 {item layout} -body {
.t identify 10 49
} -result {item 1 column 0 elem E1}
test display-4.13 {item layout} -setup {
.t item create -parent root -tags I2
.t item style set I2 C1 S1
} -body {
.t item bbox I2
} -result {50 10 90 50}
test display-4.14 {item layout} -body {
.t identify 50 10
} -result {item 2 column 0 elem E1}
test display-4.15 {item layout} -body {
.t identify 90 10
} -result {}
test display-4.16 {item layout} -body {
.t item id "nearest 0 0"
} -result {1}
test display-4.17 {item layout} -body {
.t item id "nearest 10 10"
} -result {1}
test display-4.18 {item layout} -body {
.t item id "nearest 100 100"
} -result {2}
test display-4.19 {item layout} -body {
.t marquee coords 0 0 100 10
.t marquee identify
} -result {}
test display-4.20 {item layout} -body {
.t marquee coords 0 50 100 60
.t marquee identify
} -result {}
test display-4.21 {item layout} -body {
.t marquee coords 90 0 100 100
.t marquee identify
} -result {}
test display-4.22 {item layout} -body {
.t marquee coords 10 10 11 11
.t marquee identify
} -result {{1 {0 E1}}}
test display-4.23 {item layout} -body {
.t marquee coords 50 10 51 11
.t marquee identify
} -result {{2 {0 E1}}}
test display-4.24 {item layout} -body {
.t marquee coords 49 10 61 11
.t marquee identify
} -result {{1 {0 E1}} {2 {0 E1}}}
test display-4.25 {item layout} -setup {
.t configure -itemgapx 10
} -body {
.t item bbox I1
} -result {10 10 50 50}
test display-4.26 {item layout} -body {
.t item bbox I2
} -result {60 10 100 50}
test display-4.27 {item layout} -body {
.t identify 50 10
} -result {}
test display-4.28 {item layout} -body {
.t identify 59 10
} -result {}
test display-4.29 {item layout} -body {
.t identify 60 10
} -result {item 2 column 0 elem E1}
test display-4.30 {item layout} -body {
.t marquee coords 50 0 60 100
.t marquee identify
} -result {}
test display-4.31 {item layout} -body {
.t marquee coords 100 0 110 100
.t marquee identify
} -result {}
test display-4.32 {item layout} -body {
.t marquee coords 10 10 60 20
.t marquee identify
} -result {{1 {0 E1}}}
test display-4.33 {item layout} -body {
.t marquee coords 10 10 61 20
.t marquee identify
} -result {{1 {0 E1}} {2 {0 E1}}}
test display-4.34 {item layout} -body {
.t item id "nearest 50 10"
} -result {1}
test display-4.35 {item layout: < half-way between} -body {
.t item id "nearest 54 10"
} -result {1}
test display-4.36 {item layout: >= half-way between} -body {
.t item id "nearest 55 10"
} -result {2}
test display-5.1 {item layout} -setup {
catch {destroy .t}
pack [treectrl .t -width 500 -height 500]
.t configure -showroot 0 -showheader 0 -highlightthickness 0 \
-borderwidth 0 -orient vertical -indent 20
.t column create -tags C1
.t configure -treecolumn C1
.t element create E1 rect -width 100 -height 20
.t style create S1
.t style elements S1 [list E1]
.t item create -button yes -parent root -tags I1
.t item style set I1 C1 S1
update ; # make sure it is visible
} -body {
.t item bbox I1
} -result {0 0 120 20}
test display-5.2 {button hit-testing} -setup {
} -body {
.t identify 0 0
} -result {item 1 button}
test display-5.3 {button hit-testing} -setup {
.t configure -canvaspadx 20
} -body {
.t identify 20 0
} -result {item 1 button}
test display-6.1 {no unlocked columns: no canvaspadx/y} -setup {
destroy .t
pack [treectrl .t]
.t configure -showheader no -borderwidth 5 -highlightthickness 5
.t column create -tags C0 -lock left -width 100
.t item configure root -height 20
if 0 {
.t style create s
.t style elements s [.t element create e rect -fill blue]
.t style layout s e -iexpand xy
.t item style set root C0 s
}
update
} -body {
.t item bbox root C0
} -result {10 10 110 30}
test display-6.2 {no unlocked columns: -canvaspadx ignored, -canvaspady used} -setup {
.t configure -canvaspadx 10 -canvaspady 10
} -body {
.t item bbox root C0
} -result {10 20 110 40}
test display-6.3 {no unlocked columns: -canvaspadx ignored, -canvaspady used} -body {
.t identify 10 10
} -result {}
test display-6.4 {no unlocked columns: -canvaspadx ignored, -canvaspady used} -body {
.t identify 10 19
} -result {}
test display-6.5 {no unlocked columns: -canvaspadx ignored, -canvaspady used} -body {
.t identify 10 20
} -result {item 0 column 0}
proc colWid {args} {
foreach c $args {
lappend result [.t column width $c]
}
return $result
}
test display-7.0 {column spanning: span=1} -setup {
destroy .t
pack [treectrl .t]
.t configure -showheader no -borderwidth 0 -highlightthickness 0
.t column create -tags C0
.t element create e1 rect -width 100 -height 20
.t style create s1 -orient horizontal
.t style elements s1 e1
.t item style set root C0 s1
} -body {
colWid C0
} -result {100}
test display-7.1 {column spanning: span=2} -setup {
.t column create -tags C1
.t item span root C0 2
} -body {
colWid C0 C1
} -result {50 50}
test display-7.2 {column spanning: span=3} -setup {
.t column create -tags C2
.t item span root C0 3
} -body {
colWid C0 C1 C2
} -result {34 33 33}
test display-7.3 {column spanning: span=4} -setup {
.t column create -tags C3
.t item span root C0 4
} -body {
colWid C0 C1 C2 C3
} -result {25 25 25 25}
test display-7.4 {column spanning: span=5} -setup {
.t column create -tags C4
.t item span root C0 5
} -body {
colWid C0 C1 C2 C3 C4
} -result {20 20 20 20 20}
test display-7.5 {column spanning: minwidth > 0} -setup {
.t column configure all -minwidth 10
} -body {
colWid C0 C1 C2 C3 C4
} -result {20 20 20 20 20}
test display-7.6 {column spanning: minwidth > 0} -setup {
.t column configure C0 -minwidth 30
} -body {
colWid C0 C1 C2 C3 C4
} -result {30 18 18 17 17}
test display-7.7 {column spanning: minwidth > 0} -setup {
.t column configure C2 -minwidth 30
} -body {
colWid C0 C1 C2 C3 C4
} -result {30 14 30 13 13}
test display-7.8 {column spanning: minwidth > 0} -setup {
.t column configure all -minwidth 30
} -body {
colWid C0 C1 C2 C3 C4
} -result {30 30 30 30 30}
test display-7.20 {column spanning: maxwidth > 0} -setup {
.t column configure all -minwidth ""
.t column configure C1 -maxwidth 15
} -body {
colWid C0 C1 C2 C3 C4
} -result {22 15 21 21 21}
test display-7.21 {column spanning: maxwidth > 0} -setup {
.t column configure C0 -maxwidth 15
} -body {
colWid C0 C1 C2 C3 C4
} -result {15 15 24 23 23}
test display-7.30 {column spanning: width > 0} -setup {
.t column configure all -maxwidth ""
.t column configure C3 -width 50
} -body {
colWid C0 C1 C2 C3 C4
} -result {13 13 12 50 12}
test display-7.31 {column spanning: width > 0} -setup {
.t column configure C0 -width 20
} -body {
colWid C0 C1 C2 C3 C4
} -result {20 10 10 50 10}
test display-7.40 {column spanning: hidden columns} -setup {
.t column configure all -width ""
.t column configure C2 -visible no
} -body {
colWid C0 C1 C2 C3 C4
} -result {25 25 0 25 25}
test display-7.41 {column spanning: hidden columns} -setup {
.t column configure C4 -visible no
} -body {
colWid C0 C1 C2 C3 C4
} -result {34 33 0 33 0}
test display-7.42 {column spanning: hidden columns} -setup {
.t column configure all -visible no
} -body {
colWid C0 C1 C2 C3 C4
} -result {0 0 0 0 0}
test display-7.50 {column spanning: trim the fat} -setup {
.t column configure all -visible yes
.t item span root all 1
.t item style set root C1 s1
.t item element configure root C0 e1 -width 75
.t item element configure root C1 e1 -width 25
.t item create -tags item1
.t item style set item1 C0 s1
.t item element configure item1 C0 e1 -width 100
.t item span item1 C0 2
} -body {
colWid C0 C1 C2 C3 C4
} -result {75 25 0 0 0}
proc itemWid {args} {
foreach i $args {
scan [.t item bbox $i] "%d %d %d %d" x1 y1 x2 y2
lappend result [expr {$x2 - $x1}]
}
return $result
}
test display-8.1 {item width} -setup {
destroy .t
pack [treectrl .t]
.t column create -tags C0
.t element create e rect -width 55 -height 20
.t style create s
.t style elements s e
.t item style set root C0 s
} -body {
itemWid root
} -result {55}
test display-8.2 {-itemwidth ignored without wrapping} -body {
.t configure -itemwidth 100
itemWid root
} -result {55}
test display-8.3 {-itemwidth plus -wrap} -body {
.t configure -itemwidth 100 -wrap {1 items}
itemWid root
} -result {100}
test display-8.4 {-itemwidth overrides -itemwidthmultiple} -body {
.t configure -itemwidth 100 -itemwidthmultiple 55
itemWid root
} -result {100}
test display-8.5 {-itemwidthmultiple} -body {
.t configure -itemwidth "" -itemwidthmultiple 55
itemWid root
} -result {55}
test display-8.6 {-itemwidthmultiple} -body {
.t configure -itemwidth "" -itemwidthmultiple 60
itemWid root
} -result {60}
test display-8.7 {-itemwidthmultiple} -body {
.t configure -itemwidth "" -itemwidthmultiple 50
itemWid root
} -result {100}
test display-8.20 {item width} -setup {
.t item create -tags item1 -parent root
.t item style set item1 C0 s
.t item element configure item1 C0 e -width 40
.t configure -itemwidth "" -itemwidthmultiple ""
} -body {
itemWid root item1
} -result {55 40}
test display-8.21 {-itemwidthmultiple} -body {
.t configure -itemwidth "" -itemwidthmultiple 55
itemWid root item1
} -result {55 55}
test display-8.22 {-itemwidthmultiple} -body {
.t configure -itemwidth "" -itemwidthmultiple 40
itemWid root item1
} -result {80 40}
test display-8.23 {-itemwidth} -body {
.t configure -itemwidth 100 -itemwidthmultiple 40
itemWid root item1
} -result {100 100}
test display-8.24 {-itemwidthequal} -body {
.t configure -itemwidth "" -itemwidthmultiple "" -itemwidthequal yes
itemWid root item1
} -result {55 55}
test display-8.25 {-itemwidthequal with -itemwidthmultiple} -body {
.t configure -itemwidth "" -itemwidthmultiple 40 -itemwidthequal yes
itemWid root item1
} -result {80 80}
test display-8.30 {column width} -body {
colWid C0
} -result {55}
test display-8.31 {column -width overrides -itemwidth} -body {
.t column configure C0 -width 123
itemWid root item1
} -result {123 123}
test display-8.32 {header width doesn't affect item width with -wrap} -setup {
image create photo headerImage -width 175 -height 20
} -body {
.t column configure C0 -width "" -image headerImage -imagepadx 0
.t configure -itemwidth "" -itemwidthmultiple "" -itemwidthequal no
concat [colWid C0] [itemWid root item1]
} -result {175 55 40}
test display-8.33 {header width doesn't affect item width with -wrap} -body {
.t configure -itemwidth "" -itemwidthmultiple "" -itemwidthequal yes
concat [colWid C0] [itemWid root item1]
} -result {175 55 55}
test display-8.34 {header width does affect item width without -wrap} -body {
.t configure -itemwidth "" -itemwidthmultiple "" -itemwidthequal yes -wrap {}
concat [colWid C0] [itemWid root item1]
} -result {175 175 175}
test display-8.35 {horizontal layout, item width unaffected by -wrap} -body {
.t configure -orient horizontal
concat [colWid C0] [itemWid root item1]
} -result {175 55 55}
test display-8.36 {horizontal layout, item width unaffected by -wrap} -body {
.t configure -itemwidthequal no
concat [colWid C0] [itemWid root item1]
} -result {175 55 40}
test style-99.1 {some needed cleanup} -body {
destroy .t
} -result {}
# cleanup
::tcltest::cleanupTests
return