# 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