# Commands covered:  treectrl's widget command header
#
# This file contains a collection of tests for the header 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) 2011 by Tim Baker.
#
# 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 header-0.1 {some needed preparations} -body {
    pack [treectrl .t -usetheme no]
    # The default borderwidth in Tk 8.4 is "2" while in Tk 8.5 it is "1"
    .t configure -borderwidth 1
    # If a treectrl has never been mapped then Tk_Width and Tk_Height return 1
    update
} -result {}

test header-0.2 {create an image} -body {
    image create photo emptyImg
} -result {emptyImg}

test header-1.1 {missing args} -body {
    .t header
} -returnCodes error -result {wrong # args: should be ".t header command ?arg arg ...?"}

test header-1.2 {unknown command} -body {
    .t header foo
} -returnCodes error -result {bad command "foo": must be *} -match glob

test header-1.3 {default header exists} -body {
    .t header count
} -result {1}

test header-1.4 {default header exists} -body {
    .t header id all
} -result {0}

test header-1.5 {no header exists with numerical index} -body {
    .t header configure 1
} -returnCodes error -result {header "1" doesn't exist}

test header-1.6 {configure: no header exists with tag} -body {
    .t header configure header0
} -returnCodes error -result {header "header0" doesn't exist}

test header-1.7 {header-column tail exists} -body {
    .t header cget 0 tail -arrow
} -result {none}

test header-2.1 {header bbox: missing args} -body {
    .t header bbox
} -returnCodes error -result {wrong # args: should be ".t header bbox header ?column? ?element?"}

test header-2.2 {header bbox: too many args} -body {
    .t header bbox a b c d
} -returnCodes error -result {wrong # args: should be ".t header bbox header ?column? ?element?"}

test header-2.3 {header bbox: invalid header} -body {
    .t header bbox foo
} -returnCodes error -result {header "foo" doesn't exist}

test header-2.4 {header bbox: no visible columns, tail isn't shown} -body {
    # When there are no visible columns, a header isn't ReallyVisible
    .t header bbox 0
} -result {}

test header-2.5 {header bbox: zero-sized visible column} -setup {
    .t column create -width 0 -tags column0
}  -body {
    .t header bbox 0
} -result {2 2 202 6}

test header-2.6 {header bbox: zero-sized visible -lock=left column} -setup {
    .t column configure column0 -lock left
}  -body {
    .t header bbox 0
} -cleanup {
    .t column configure column0 -lock none
} -result {2 2 202 6}

test header-2.6.1 {header bbox: no visible columns is same as no columns} -setup {
    .t column configure column0 -lock left -visible no
}  -body {
    # When there are no visible columns, a header isn't ReallyVisible
    .t header bbox 0
} -result {}

test header-2.7 {header bbox: tree doesn't show headers} -setup {
    .t configure -showheader 0
}  -body {
    .t header bbox 0
} -cleanup {
    .t column delete column0
    .t configure -showheader 1
} -result {}

test header-2.8 {header bbox: header is not visible} -setup {
    .t header configure first -visible no
} -body {
    .t header bbox first
} -result {}

if 0 {
test header-2.9 {header bbox: header is ownerdrawn but has no style} -setup {
    .t header configure first -visible yes -ownerdrawn yes
} -body {
    .t header bbox first
} -cleanup {
    .t header configure first -ownerdrawn no
} -result {2 2 202 2}
}

test header-2.20 {header bbox: invalid column} -body {
    .t header configure first -visible yes
    .t header bbox 0 first
} -returnCodes error -result {column "first" doesn't exist}

test header-2.21 {header bbox: tree doesn't show headers} -setup {
    .t column create -tags column0
    .t element create e rect -width 482 -height 20
    .t style create s
    .t style elements s e
    set i [.t item create -parent root]
    .t item style set $i column0 s
    .t column create -tags column1
    .t configure -showheader 0
} -body {
    .t header bbox 0 column0
} -result {}

test header-2.22 {header bbox: tree does show headers} -setup {
    .t configure -showheader 1
} -body {
    .t header bbox 0 column0
} -cleanup {
    .t style delete s
    .t element delete e
} -result {2 2 484 6}

test header-2.23 {header bbox: tail column not allowed} -body {
    .t header bbox first tail
} -returnCodes error -result {can't specify "tail" for this command}

test header-2.30 {header bbox: no style} -body {
    .t header bbox first column0 foo
} -returnCodes error -result {header 0 column 0 has no style}

test header-2.31 {header bbox: unknown element} -setup {
    .t style create s -statedomain header
    .t element create e rect -statedomain header -width 482 -height 20
    .t style elements s e
    .t header style set first column0 s
} -body {
    .t header bbox first column0 foo
} -returnCodes error -result {element "foo" doesn't exist}

test header-2.32 {header bbox: element} -body {
    .t column configure column0 -width ""
    .t header bbox first column0 e
} -cleanup {
    .t header style set first column0 ""
} -result {2 2 484 22}

test header-3.1 {header configure: missing args} -body {
    .t header configure
} -returnCodes error -result {wrong # args: should be ".t header configure header ?column? ?option? ?value? ?option value ...?"}

test header-3.2 {header configure: invalid header} -body {
    .t header configure foo
} -returnCodes error -result {header "foo" doesn't exist}

test header-3.3 {header configure: list all options} -body {
    .t header configure first column1
} -result {{-arrow {} {} none none} *} -match glob

test header-3.4 {header configure: tail column} -body {
    .t header configure first tail
} -result {{-arrow {} {} none none} *} -match glob

test header-3.4a {header configure: invalid option} -body {
    .t header configure first tail -foo
} -returnCodes error -result {unknown option "-foo"}

test header-3.5 {header configure: invalid -arrow} -body {
    .t header configure first column1 -arrow straight
} -returnCodes error -result {bad arrow "straight": must be none, up, or down}

test header-3.6 {header configure/cget: -arrow} -body {
    .t header configure first column1 -arrow up
    .t header cget first column1 -arrow
} -result {up}

test header-3.7 {header configure: invalid -arrowside} -body {
    .t header configure first column1 -arrowside up
} -returnCodes error -result {bad arrowside "up": must be left or right}

test header-3.8 {header configure/cget: -arrowside} -body {
    .t header configure first column1 -arrowside left
    .t header cget first column1 -arrowside
} -result {left}

test header-3.9 {header configure: invalid -arrowgravity} -body {
    .t header configure first column1 -arrowgravity both
} -returnCodes error -result {bad arrowgravity "both": must be left or right}

test header-3.10 {header configure/cget: -arrowgravity} -body {
    .t header configure first column1 -arrowgravity right
    .t header cget first column1 -arrowgravity
} -result {right}

test header-3.11 {header configure: invalid -arrowpadx} -body {
    .t header configure first column1 -arrowpadx x
} -returnCodes error -result {bad pad amount "x": must be a list of 1 or 2 positive screen distances}

test header-3.11a {header configure: invalid 2 element -arrowpadx} -body {
    .t header configure first column1 -arrowpadx {3 x}
} -returnCodes error -result {bad pad amount "3 x": must be a list of 1 or 2 positive screen distances}

test header-3.12 {header configure/cget: -arrowpadx} -body {
    .t header configure first column1 -arrowpadx 8
    .t header cget first column1 -arrowpadx
} -result {8}

test header-3.12a {header configure/cget: 2 element -arrowpadx} -body {
    .t header configure first column1 -arrowpadx {8 5}
    .t header cget first column1 -arrowpadx
} -result {8 5}

test header-3.13 {header configure: invalid -bitmap} -body {
    .t header configure first column1 -bitmap no-such-bitmap
} -returnCodes error -result {bitmap "no-such-bitmap" not defined}

test header-3.14 {header configure/cget: -bitmap} -body {
    .t header configure first column1 -bitmap questhead
    .t header cget first column1 -bitmap
} -result {questhead}

test header-3.15 {header configure: invalid -background} -body {
    .t header configure first column1 -background foo
} -returnCodes error -result {unknown color name "foo"}

test header-3.16 {header configure/cget: -background} -body {
    .t header configure first column1 -background magenta
    .t header cget first column1 -background
} -result {magenta}

test header-3.17 {header configure: invalid -borderwidth} -body {
    .t header configure first column1 -borderwidth x
} -returnCodes error -result {bad screen distance "x"}

test header-3.18 {header configure/cget: -borderwidth} -body {
    .t header configure first column1 -borderwidth 4
    .t header cget first column1 -borderwidth
} -result {4}

test header-3.19 {header configure: invalid -button} -body {
    .t header configure first column1 -button ""
} -returnCodes error -result {expected boolean value but got ""}

test header-3.20 {header configure/cget: -button} -body {
    .t header configure first column1 -button off
    .t header cget first column1 -button
} -result {0}

###

test header-3.23 {header configure: invalid -image} -body {
    .t header configure first column1 -image questhead
} -returnCodes error -result {image "questhead" doesn't exist}

test header-3.24 {header configure/cget: -image} -body {
    .t header configure first column1 -image emptyImg
    .t header cget first column1 -image
} -result {emptyImg}

test header-3.25 {header configure: invalid -imagepadx} -body {
    .t header configure first column1 -imagepadx y
} -returnCodes error -result {bad pad amount "y": must be a list of 1 or 2 positive screen distances}

test header-3.25a {header configure: invalid 2 element -imagepadx} -body {
    .t header configure first column1 -imagepadx "y \{"
} -returnCodes error -result {unmatched open brace in list}

test header-3.26 {header configure/cget: -imagepadx} -body {
    .t header configure first column1 -imagepadx 9 -imagepady 4
    list [.t header cget first column1 -imagepadx] \
	 [.t header cget first column1 -imagepady]
} -result {9 4}

test header-3.26a {header configure/cget: 2 element -imagepadx/y} -body {
    .t header configure first column1 -imagepadx {9 0} -imagepady {4 3}
    list [.t header cget first column1 -imagepadx] \
	 [.t header cget first column1 -imagepady]
} -result {{9 0} {4 3}}

###

test header-3.31 {header configure: invalid -justify} -body {
    .t header configure first column1 -justify no
} -returnCodes error -result {bad justification "no": must be left, right, or center}

test header-3.32 {header configure/cget: simple -justify} -body {
    .t header configure first column1 -justify center
    .t header cget first column1 -justify
} -result {center}

###

test header-3.35 {header configure: invalid -state} -body {
    .t header configure first column1 -state yes
} -returnCodes error -result {bad state "yes": must be normal, active, or pressed}

test header-3.36 {header configure/cget: -state} -body {
    .t header configure first column1 -state pressed
    .t header cget first column1 -state
} -result {pressed}

###

test header-3.41 {header configure: -text} -body {
    .t header configure first column1 -text "Text above Column 1"
    .t header cget first column1 -text
} -result {Text above Column 1}

test header-3.42 {header configure: invalid -textpadx} -body {
    .t header configure first column1 -textpadx baz
} -returnCodes error -result {bad pad amount "baz": must be a list of 1 or 2 positive screen distances}

test header-3.42a {header configure: invalid 2 element -textpadx} -body {
    .t header configure first column1 -textpadx {foo bar baz}
} -returnCodes error -result {bad pad amount "foo bar baz": must be a list of 1 or 2 positive screen distances}

test header-3.43 {header configure/cget: -textpadx/y} -body {
    .t header configure first column1 -textpadx 8 -textpady 5
    list [.t header cget first column1 -textpadx] \
	 [.t header cget first column1 -textpady]
} -result {8 5}

test header-3.43a {header configure/cget: 2 element -textpadx/y} -body {
    .t header configure first column1 -textpadx {8 4} -textpady {4 5}
    list [.t header cget first column1 -textpadx] \
	 [.t header cget first column1 -textpady]
} -result {{8 4} {4 5}}

###

test header-3.46 {header configure: invalid -visible} -body {
    .t header configure first -visible never
} -returnCodes error -result {expected boolean value but got "never"}

test header-3.47 {header configure/cget: -visible} -body {
    .t header configure first -visible no
    .t header cget first -visible
} -result {0}

###

test header-4.1 {header configure: -tags} -body {
    .t header configure first -tags header0
    .t header cget header1 -tags
} -returnCodes error -result {header "header1" doesn't exist}

test header-4.2 {header configure: -tags} -body {
    .t header cget header0 -tags
} -result {header0}

###

test header-5.1 {header delete: missing args} -body {
    .t header delete
} -returnCodes error -result {wrong # args: should be ".t header delete header"}

test header-5.2 {header delete: too many args} -body {
    .t header delete a b
} -returnCodes error -result {wrong # args: should be ".t header delete header"}

test header-5.3 {header delete: first header} -setup {
    .t header create -tags header1
} -body {
    .t header delete header1
} -result {}

test header-5.4 {deleted header doesn't exist} -body {
    .t header cget header1 -tags
} -returnCodes error -result {header "header1" doesn't exist}

test header-5.5 {header delete: 'all' ignores header 0} -setup {
    .t header create
    .t header create
    .t header create
} -body {
    .t header delete all
    .t header id all
} -result {0}

test header-5.6 {header delete: delete one} -body {
    .t header create -tags header1
    .t header create -tags header2
    .t header create -tags header3
    .t header create -tags header4
    .t header delete header1
    .t header id all
} -result {0 2 3 4}

test header-5.7 {header delete: delete two} -body {
    .t header delete header4
    .t header delete header3
    .t header id all
} -result {0 2}

test header-5.8 {header delete: deleting all headers resets the next unique id} -body {
    .t header delete all
    .t header create
} -result {1}

test header-6.1 {header id: missing args} -setup {
    .t header delete all
    .t header configure header0 -visible no
    .t header create -tags header1
    .t header create -tags header2
} -body {
    .t header id
} -returnCodes error -result {wrong # args: should be ".t header id header"}

test header-6.2 {header id: too many args} -body {
    .t header id a b
} -returnCodes error -result {wrong # args: should be ".t header id header"}

test header-6.3 {header id: by ID} -setup {
    .t header delete header1
} -body {
    .t header id 2
} -result {2}

test header-6.4 {header id: by tag} -body {
    .t header id header2
} -result {2}

test header-6.5 {header id: by keyword first} -body {
    .t header id first
} -result {0}

test header-6.6 {header id: by keyword last} -body {
    .t header id last
} -result {2}

test header-6.7 {header id: by keyword end} -body {
    .t header id end
} -result {2}

test header-6.8 {header id: by tag expression} -body {
    .t header id header2||header0
} -result {0 2}

test header-6.9 {header id: qualifier 'tag'} -body {
    .t header id {tag header2}
} -result {2}

test header-6.10 {header id: qualifier 'tag'} -body {
    .t header id {all tag header2}
} -result {2}

test header-6.11 {header id: qualifier 'tag'} -body {
    .t header id {first tag header2}
} -result {2}

test header-6.12 {header id: qualifier 'visible'} -body {
    .t header id visible
} -result {2}

test header-6.13 {header id: qualifier 'visible'} -body {
    .t header id {last visible}
} -result {2}

test header-6.14 {header id: qualifier '!visible'} -body {
    .t header id !visible
} -result {0}

test header-6.15 {header id: qualifier '!visible'} -body {
    .t header id {all !visible}
} -result {0}

###

test header-11.1 {header count: too many args} -body {
    .t header count a b
} -returnCodes error -result {wrong # args: should be ".t header count ?headerDesc?"}

test header-11.2 {header count: no args} -setup {
    .t header delete all
} -body {
    .t header count
} -result {1}

test header-11.3 {header count: with desc} -body {
    .t header count first
} -result {1}

test header-11.4 {header count: all} -body {
    .t header count all
} -result {1}

test header-11.5 {header count: unknown tag} -body {
    .t header count foo
} -result {0}

test header-11.6 {header count: 2 new headers} -setup {
    .t header create -tags header1
    .t header create -tags header2
} -body {
    .t header count
} -result {3}

test header-11.7 {header count: delete a header} -setup {
    .t header delete header1
} -body {
    .t header count
} -result {2}

test header-11.8 {header count: delete another header} -setup {
    .t header delete header2
} -body {
    .t header count
} -result {1}

test header-12.1 {header dragconfigure: no args} -setup {
    .t header delete all
    .t header create -tags header1
} -body {
    .t header dragconfigure
} -result {{-enable {} {} 0 0} *} -match glob

test header-12.2 {header dragconfigure: unknown option} -body {
    .t header dragconfigure -foo
} -returnCodes error -result {unknown option "-foo"}

test header-12.3 {header dragconfigure: bad option-value} -body {
    .t header dragconfigure -enable foo
} -returnCodes error -result {expected boolean value but got "foo"}

test header-12.4 {header dragconfigure: missing option-value} -body {
    .t header dragconfigure -enable yes -imagespan
} -returnCodes error -result {value for "-imagespan" missing}

test header-12.5 {header dragconfigure: tail column forbidden} -body {
    .t header dragconfigure -imagecolumn tail
} -returnCodes error -result {can't specify "tail" for this command}

test header-12.6 {header dragconfigure: negative spans not an error} -body {
    .t header dragconfigure -imagespan -10
} -result {}

test header-12.20 {header dragconfigure: unknown header} -body {
    .t header dragconfigure foo
} -returnCodes error -result {header "foo" doesn't exist}

test header-12.21 {header dragconfigure: valid header} -body {
    .t header dragconfigure first
} -result {{-draw {} {} 1 1} *} -match glob

test header-12.22 {header dragconfigure: multiple headers not allowed} -body {
    .t header dragconfigure all
} -returnCodes error -result {can't specify > 1 header for this command}

test header-12.23 {header dragconfigure: multiple headers not allowed} -body {
    .t header dragconfigure all -foo
} -returnCodes error -result {can't specify > 1 header for this command}

test header-12.24 {header dragconfigure: multiple headers unknown option} -body {
    .t header dragconfigure all -foo bar
} -returnCodes error -result {unknown option "-foo"}

test header-12.25 {header dragconfigure: multiple headers ok} -body {
    .t header dragconfigure all -draw no
} -result {}

test header-12.26 {header dragconfigure: single header ok} -body {
    .t header dragconfigure first -draw yes
} -result {}

test header-12.30 {header dragconfigure: deleting a column clears -imagecolumn} -setup {
#    .t header configure 0 -visible yes
    .t column delete all
    .t column create -tags column0 -text "Column 0"
    .t column create -tags column1 -text "Column 1"
    .t column create -tags column2 -text "Column 2"
    .t header dragconfigure -imagecolumn column0
    update
    .t column delete column0
} -body {
    .t header dragcget -imagecolumn
} -result {}

test header-12.31 {header dragconfigure: deleting a column clears -indicatorcolumn} -setup {
    .t header dragconfigure -indicatorcolumn column1
    update
    .t column delete column1
} -body {
    .t header dragcget -indicatorcolumn
} -result {}

test header-13.1 {header dragcget: too few args} -body {
    .t header dragcget
} -returnCodes error -result {wrong # args: should be ".t header dragcget ?header? option"}

test header-13.2 {header dragcget: too many args} -body {
    .t header dragcget a b c
} -returnCodes error -result {wrong # args: should be ".t header dragcget ?header? option"}

test header-13.3 {header dragcget: unknown option} -body {
    .t header dragcget -foo
} -returnCodes error -result {unknown option "-foo"}

test header-13.4 {header dragcget: valid option} -body {
    .t header dragcget -enable
} -result {0}

test header-13.5 {header dragcget: unknown header} -body {
    .t header dragcget foo -bar
} -returnCodes error -result {header "foo" doesn't exist}

test header-13.6 {header dragcget: multiple headers not allowed} -body {
    .t header dragcget all -foo
} -returnCodes error -result {can't specify > 1 header for this command}

test header-13.7 {header dragcget: single header, valid option} -body {
    .t header dragcget first -enable
} -result {1}

test header-20.1 {unknown column config options are passed to the first header} -setup {
    .t header delete all
    .t column delete all
} -body {
    .t column create -text "Column 0" -tags column0
    .t header cget first column0 -text
} -result {Column 0}

test header-20.2 {unknown column config options are retrieved from the first header} -body {
    .t header configure first column0 -text "Header 0, Column 0"
    .t column cget column0 -text
} -result {Header 0, Column 0}

test header-20.3 {unknown header config options are passed to the underlying item} -body {
    .t header configure first -visible no
} -result {}

test header-20.4 {unknown header config options are retrieved from the underlying item} -body {
    .t header cget first -visible
} -result {0}

test header-21.1 {column create doesn't mess up header-columns} -setup {
    .t header delete all
    .t column delete all
    .t style create stail -statedomain header
    .t header style set first all stail
} -body {
    .t header style set first
} -result {stail}

test header-21.2 {column create doesn't mess up header-columns} -setup {
    .t column create -tags column0
    .t style create s0 -statedomain header
    .t header style set first column0 s0
} -body {
    .t header style set first
} -result {s0 stail}

test header-21.3 {column create doesn't mess up header-columns} -setup {
    .t column create -tags columnL -lock left
    .t style create sL -statedomain header
    .t header style set first columnL sL
} -body {
    .t header style set first
} -result {sL s0 stail}

test header-21.4 {column create doesn't mess up header-columns} -setup {
    .t column create -tags columnR -lock right
    .t style create sR -statedomain header
    .t header style set first columnR sR
} -body {
    .t header style set first
} -result {sL s0 sR stail}

test header-21.5 {aborted column create doesn't mess up header-columns} -setup {
    catch {.t column create -foo bar}
} -body {
    .t header style set first
} -result {sL s0 sR stail}

test header-22.1 {changing column -width invalidates needed height of headers} -body {
    .t header delete all
    .t column delete all
    .t header conf 0 -visible 1
    .t column create -tags column0 -text "Here is a long line of text that will wrap" -textlines 0
    scan [.t header bbox 0 column0] "%d %d %d %d" left top right bottom
    .t column configure column0 -width [expr {($right - $left) / 2}]
    scan [.t header bbox 0 column0] "%d %d %d %d" left1 top1 right1 bottom1
    set fh [font metrics [.t cget -font] -linespace]
    expr {$bottom1 >= $bottom + $fh}
} -result {1}

test header-22.2 {squeezing columns invalidates needed height of headers} -body {
    .t column configure column0 -width "" -squeeze yes
    set nw [.t column neededwidth column0]
    .t configure -width [expr {$nw * 1.5}]
    update idletasks ; # <Configure>
    scan [.t header bbox 0 column0] "%d %d %d %d" left top right bottom
    .t configure -width [expr {$nw * 0.5}]
    update idletasks ; # <Configure>
    scan [.t header bbox 0 column0] "%d %d %d %d" left1 top1 right1 bottom1
    set fh [font metrics [.t cget -font] -linespace]
    expr {$bottom1 >= $bottom + $fh}
} -result {1}

test header-22.3 {-canvaspadx is added to width of leftmost unlocked column when calculating needed height} -body {
    .t column configure column0 -width "" -squeeze no
    scan [.t header bbox 0 column0] "%d %d %d %d" left top right bottom
    .t column configure column0 -width [.t column neededwidth column0]
    .t configure -canvaspadx 50
    scan [.t header bbox 0 column0] "%d %d %d %d" left1 top1 right1 bottom1
    expr {$bottom1 == $bottom}
} -cleanup {
    .t configure -canvaspadx 0
} -result {1}

test header-23.1 {layout: no bitmap/image/text/arrow, as tall as borders} -setup {
    .t header delete all
    .t column delete all
    .t column create -tags C0 -width 100
    .t header configure 0 C0 -borderwidth 3
    .t configure -showheader yes -usetheme no -highlightthickness 0 -borderwidth 0
} -body {
    .t header bbox 0 C0
} -result {0 0 100 6}

test header-23.2 {layout: no bitmap/image/text, add a sort arrow} -setup {
    .t header configure 0 C0 -arrow up
} -body {
    # Assuming non-themed arrow height==9
    .t header bbox 0 C0
} -result {0 0 100 15}

test header-23.3 {layout: no bitmap/image/text, width is -arrowpadx plus arrow width} -setup {
    .t column configure C0 -width ""
} -body {
    # Assuming non-themed arrow width==9 and -arrowpadx==6, borders ignored
    .t header bbox 0 C0
} -result {0 0 21 15}

test header-23.4 {layout: -arrowpady added to height} -setup {
    .t header configure 0 C0 -arrowpady 2
} -body {
    # height was 3 + 9 + 3, -arrowpady adds +4
    .t header bbox 0 C0
} -result {0 0 21 19}

test header-23.5 {layout: add an -image} -setup {
    image create photo headerImage -width 20 -height 20
    .t header configure 0 C0 -image headerImage
} -body {
    # width = 6 + img=20 + max(6,6) + arrow=9 + 6
    # height = 3 + 20 + 3
    .t header bbox 0 C0
} -result {0 0 47 26}

test header-23.6 {layout: -imagepadx and -arrowpadx overlap} -setup {
    .t header configure 0 C0 -imagepadx {6 0}
} -body {
    .t header bbox 0 C0
} -cleanup {
    .t header configure 0 C0 -imagepadx 6
} -result {0 0 47 26}

test header-23.7 {layout: -canvaspadx adds to the width} -setup {
    .t configure -canvaspadx 10
} -body {
    .t header bbox 0 C0
} -cleanup {
    .t configure -canvaspadx 0
} -result {0 0 57 26}

test header-23.8 {layout: -imagepady adds to height} -setup {
    .t header configure 0 C0 -imagepady 2
} -body {
    .t header bbox 0 C0
} -result {0 0 47 30}

test header-23.9 {layout: arrow on the left doesn't change anything} -setup {
    .t header configure 0 C0 -arrowside left
} -body {
    .t header bbox 0 C0
} -result {0 0 47 30}

test header-24.1 {custom style: } -setup {
    .t header delete all
    .t column delete all
    .t column create -tags C0 -width ""
    .t header configure 0 C0
    .t configure -showheader yes -usetheme no -highlightthickness 0 -borderwidth 0

    .t element create custom.header header -statedomain header -borderwidth 3
    .t element create custom.image image -statedomain header -image headerImage
    .t style create custom -statedomain header -orient horizontal
    .t style elements custom {custom.header custom.image}
    .t style layout custom custom.header -union custom.image
    .t style layout custom custom.image -padx 6

    .t header style set 0 C0 custom
} -body {
    .t header bbox 0 C0
} -result {0 0 32 26}

test header-24.2 {custom style: header element sees -arrow option} -setup {
    # Not configuring header element's -arrow here, it checks the header state flags
    .t header configure 0 C0 -arrow down
} -body {
    # 6 + img=20 + max(6,6) + arrow=9 + 6
    list [.t header bbox 0 C0] [.t header bbox 0 C0 custom.image]
} -result {{0 0 47 26} {6 3 26 23}}

test header-24.3 {custom style: arrow on the left} -setup {
    .t element configure custom.header -arrowside left
} -body {
    # 6 + arrow=9 + max(6,6) + img=20 + 6
    list [.t header bbox 0 C0] [.t header bbox 0 C0 custom.image]
} -result {{0 0 47 26} {21 3 41 23}}

test header-24.4 {custom style: unequal padding} -setup {
    .t element configure custom.header -arrowpadx {6 12}
} -body {
    # 6 + arrow=9 + max(12,6) + img=20 + 6
    list [.t header bbox 0 C0] [.t header bbox 0 C0 custom.image]
} -result {{0 0 53 26} {27 3 47 23}}

test header-24.5 {custom style: unequal padding} -setup {
    .t element configure custom.header -arrowpadx {6 0}
} -body {
    # 6 + arrow=9 + max(0,6) + img=20 + 6
    list [.t header bbox 0 C0] [.t header bbox 0 C0 custom.image]
} -result {{0 0 47 26} {21 3 41 23}}

test header-24.6 {custom style: external padding of header doesn't change its width} -setup {
    .t style layout custom custom.header -padx 10
} -body {
    # 10 + 6 + arrow=9 + max(0,6) + img=20 + 6 + 10
    list [.t header bbox 0 C0] [.t header bbox 0 C0 custom.image]
} -result {{0 0 67 26} {31 3 51 23}}

test header-30.1 {library: CursorAction} -setup {
    destroy .t
    treectrl .t -usetheme no -borderwidth 0 -highlightthickness 0
    pack .t
    .t header configure 0 -tags header0
    .t header create -tags header1
    .t header configure all -height 20
    foreach tag {left1 left2} {
        .t column create -tags $tag  -lock left
    }
    foreach tag {none1 none2 none3 none4} {
        .t column create -tags $tag -lock none
    }
    foreach tag {right1 right2} {
        .t column create -tags $tag -lock right
    }
    .t column configure all -width 50
    .t header span header0 left1 2 none1 2 none3 2 right1 2
    # 50-pixel gap between last non-locked column and first right-locked column
    .t configure -width [expr {[.t column count] * 50 + 50}]
    update
} -body {
    array unset v
    TreeCtrl::CursorAction .t 0 0 v
    parray v
} -output {v(action) = header-button
v(column) = 0
v(header) = 0
}

test header-30.2 {library: CursorAction} -body {
    array unset v
    TreeCtrl::CursorAction .t 49 0 v
    parray v
} -output {v(action) = header-button
v(column) = 0
v(header) = 0
}

test header-30.3 {library: CursorAction} -body {
    array unset v
    TreeCtrl::CursorAction .t 99 0 v
    parray v
} -output {v(action) = header-resize
v(column) = 1
v(header) = 0
}

test header-30.4 {library: CursorAction} -body {
    array unset v
    TreeCtrl::CursorAction .t 100 0 v
    parray v
} -output {v(action) = header-resize
v(column) = 1
v(header) = 0
}

test header-30.5 {library: CursorAction} -body {
    array unset v
    TreeCtrl::CursorAction .t 4 0 v
    parray v
} -output {v(action) = header-button
v(column) = 0
v(header) = 0
}

test header-30.6 {library: CursorAction} -body {
    array unset v
    TreeCtrl::CursorAction .t 104 0 v
    parray v
} -output {v(action) = header-button
v(column) = 2
v(header) = 0
}

test header-30.7 {library: CursorAction} -body {
    array unset v
    TreeCtrl::CursorAction .t 199 0 v
    parray v
} -output {v(action) = header-resize
v(column) = 3
v(header) = 0
}

test header-30.8 {library: CursorAction} -body {
    array unset v
    TreeCtrl::CursorAction .t 203 0 v
    parray v
} -output {v(action) = header-resize
v(column) = 3
v(header) = 0
}

test header-30.9 {library: CursorAction} -body {
    array unset v
    TreeCtrl::CursorAction .t 204 0 v
    parray v
} -output {v(action) = header-button
v(column) = 4
v(header) = 0
}

#----------------------------------------------------------------------
#
# Procedures needed by this test file
#
#----------------------------------------------------------------------

proc HeaderXY {H C xpos ypos _x _y} {
    upvar $_x x $_y y
    scan [.t header bbox $H $C] "%d %d %d %d" x1 y1 x2 y2
    if {[string match "left*" $xpos]} {
        set dx [string range $xpos 4 end]
        set x $x1
    } elseif {[string match "right*" $xpos]} {
        set dx [string range $xpos 5 end]
        set x $x2
    } else {
        set dx $xpos
        set x $x1
    }
    if {[string match "top*" $xpos]} {
        set dy [string range $ypos 4 end]
        set y $y1
    } elseif {[string match "bottom*" $ypos]} {
        set dy [string range $ypos 5 end]
        set y $y2
    } else {
        set dy $ypos
        set y $y1
    }
    incr x $dx
    incr y $dy
    return
}

proc Motion {H C xpos ypos} {
    HeaderXY $H $C $xpos $ypos x y
    event generate .t <Motion> -x $x -y $y
    set ::gx $x
    set ::gy $y
    return
}

proc Press1 {} {
    event generate .t <ButtonPress-1> -x $::gx -y $::gy
    return
}

proc Release1 {} {
    event generate .t <ButtonRelease-1> -x $::gx -y $::gy
    return
}

proc Drag1 {dx dy} {
    incr ::gx $dx
    incr ::gy $dy
    event generate .t <Button1-Motion> -x $::gx -y $::gy
    return
}

test header-40.1 {bindings: enter + invoke 0,0} -setup {
    .t notify install <Header-state>
    .t notify install <Header-invoke>
    .t notify bind test <Header-state> {lappend v state %H %C %s}
    .t notify bind test <Header-invoke> {lappend v invoke %H %C}
} -body {
    array unset v
    set v {}
    Motion header0 left1 0 0
    lappend v |
    Press1
    lappend v |
    Release1
    lappend v | [.t cget -cursor]
    set v
} -result {state 0 0 active | state 0 0 pressed | state 0 0 active invoke 0 0 | {}}

test header-40.2 {bindings: hover left side of 1,0} -body {
    set v {}
    Motion header1 left1 0 0
    lappend v | [.t cget -cursor]
    set v
} -result {state 0 0 normal state 1 0 active | {}}

test header-40.3 {bindings: hover 1 pixel left of right side of 1,0} -body {
    set v {}
    Motion header1 left1 right-5 0
    lappend v | [.t cget -cursor]
} -result {| {}}

test header-40.4 {bindings: hover right side of 1,0} -body {
    set v {}
    Motion header1 left1 right-4 0
    lappend v | [.t cget -cursor]
} -result {| sb_h_double_arrow}

test header-40.5 {bindings: hover left side of 1,1} -body {
    set v {}
    Motion header1 left2 3 0
    lappend v | [.t cget -cursor]
    set v
} -result {| sb_h_double_arrow}

test header-40.6 {bindings: hover 1 pixel right of left side of 1,1} -body {
    set v {}
    Motion header1 left2 4 0
    lappend v | [.t cget -cursor]
    set v
} -result {state 1 0 normal state 1 1 active | {}}

test header-40.7 {bindings: hover right side of 1,1} -body {
    set v {}
    Motion header1 left2 right-1 0
    lappend v | [.t cget -cursor]
    set v
} -result {| sb_h_double_arrow}

test header-40.8 {bindings: hover left side of 1,2} -body {
    set v {}
    Motion header1 none1 0 0
    lappend v | [.t cget -cursor]
    set v
} -result {| sb_h_double_arrow}

test header-40.9 {bindings: hover right side of 1,5} -body {
    set v {}
    Motion header1 none4 right-1 0
    lappend v | [.t cget -cursor]
    set v
} -result {state 1 1 normal state 1 5 active | sb_h_double_arrow}

test header-40.10 {bindings: hover left side of 1,tail} -body {
    set v {}
    Motion header1 none4 right+0 0
    lappend v | [.t cget -cursor]
    set v
} -result {| sb_h_double_arrow}

test header-40.11 {bindings: hover 1 pixel right of left side of 1,tail} -body {
    set v {}
    Motion header1 none4 right+4 0
    lappend v | [.t cget -cursor]
    set v
} -result {state 1 5 normal | {}}

test header-40.12 {bindings: hover 5 pixels left of left side of 1,6} -body {
    set v {}
    Motion header1 right1 -5 0
    lappend v | [.t cget -cursor]
    set v
} -result {| {}}

test header-40.13 {bindings: hover 4 pixels left of left side of 1,6} -body {
    set v {}
    Motion header1 right1 -4 0
    lappend v | [.t cget -cursor]
    set v
} -result {state 1 6 active | sb_h_double_arrow}

test header-40.14 {bindings: hover left side of 1,6} -body {
    set v {}
    Motion header1 right1 0 0
    lappend v | [.t cget -cursor]
    set v
} -result {| sb_h_double_arrow}

test header-40.15 {bindings: hover left side of 1,6} -body {
    set v {}
    Motion header1 right1 3 0
    lappend v | [.t cget -cursor]
    set v
} -result {| sb_h_double_arrow}

test header-40.16 {bindings: hover 1 pixel right of left side of 1,6} -body {
    set v {}
    Motion header1 right1 4 0
    lappend v | [.t cget -cursor]
    set v
} -result {| {}}

test header-40.17 {bindings: hover right side of 1,6} -body {
    set v {}
    Motion header1 right1 right-1 0
    lappend v | [.t cget -cursor]
    set v
} -result {state 1 6 normal state 1 7 active | sb_h_double_arrow}

test header-40.18 {bindings: hover left side of 1,7} -body {
    set v {}
    Motion header1 right2 0 0
    lappend v | [.t cget -cursor]
    set v
} -result {| sb_h_double_arrow}

test header-40.19 {bindings: hover right side of 1,7} -body {
    set v {}
    Motion header1 right2 right-1 0
    lappend v | [.t cget -cursor]
    set v
} -result {| {}}

test header-41.1 {bindings: resize -lock=left span=2} -body {
    Motion header0 left1 right-1 0
    Press1
    Drag1 -25 0
    Release1
    .t column cget left2 -width
} -result {25}

test header-41.2 {bindings: resize -lock=none span=2} -body {
    Motion header0 none1 right-1 0
    Press1
    Drag1 -25 0
    Release1
    .t column cget none2 -width
} -result {25}

test header-41.3 {bindings: resize -lock=none span=2} -body {
    Motion header0 none3 right-1 0
    Press1
    Drag1 -25 0
    Release1
    .t column cget none4 -width
} -result {25}

test header-41.4 {bindings: resize -lock=right span=2} -body {
    Motion header0 right1 0 0
    Press1
    Drag1 +25 0
    Release1
    .t column cget right1 -width
} -result {25}

test header-41.5 {bindings: resize span with hidden column} -setup {
    .t column configure all -width 50
    .t column configure none2 -visible no
} -body {
    Motion header0 none1 right-1 0
    Press1
    Drag1 +25 0
    Release1
    .t column cget none1 -width ; # not none2
} -result {75}

test header-41.6 {bindings: resize too-large span} -setup {
    .t column configure all -width 50
    .t column configure none2 -visible yes
    .t header span header0 none3 20
} -body {
    Motion header0 none3 right-1 0
    Press1
    Drag1 +25 0
    Release1
    .t column cget none4 -width
} -result {75}

test header-99.1 {some needed cleanup} -body {
    destroy .t
} -result {}

# cleanup
image delete emptyImg
image delete headerImage
::tcltest::cleanupTests
return