#! /bin/sh
# If executed as a shell script, the next line replaces the shell \
exec tclsh "$0" ${1+"$@"}

#
# DETERMINE TEST CONTEXT
#

# Check whether this script was called from a master test script
# (e.g. all.tcl) which called [runAllTests]).
set CALLED_FROM_MASTER_TEST [info exists ::env(TCLTEST_MASTER_SCRIPT)]

proc getScriptDir {} {
	set scriptname [info script]
	if {$scriptname eq ""} {
		return -code error "Called [info level 0] outside the active invocation of a script."
	}
	return [file dirname [file normalize $scriptname]]
}

# directory names, and cd into test dir
set Dir(test) [getScriptDir]
set Dir(install) [file dirname $Dir(test)]
cd $Dir(test)

# proces command line arguments as test configuration options
array set testconf $argv
array set tcltestconf $argv
if {[info exists tcltestconf(-wtune)]} { 
	unset tcltestconf(-wtune)
	if {! [regexp {^\d+\.?\d*|\.\d+$} $testconf(-wtune)] || ($testconf(-wtune) <= 0)} {
		set errMsg "error: invalid value \"$testconf(-wtune)\" for option -wtune"
		if {$tcl_interactive} {
			return -code error $errMsg
		} else {
			puts stderr $errMsg
			exit 1
		}
	}
} else {
	set testconf(-wtune) 1.0
}


#
# LOAD TEST HARNESS AND TEST UTILITIES, AND
# PERFORM GENERIC TEST INITIALIZATION
#
package require tcltest 2.2
source [file join $Dir(test) tkwintracktest-utils.tcl]
namespace import -force ::tcltest::*

if {! $CALLED_FROM_MASTER_TEST} {
	tcltest::configure -verbose {body pass error}
	if {$argc > 0} {
		# pass command line arguments to tcltest
		eval tcltest::configure [array get tcltestconf]
	}
}
unset tcltestconf

testConstraint no_initial_tk [catch {package present Tk}]

#
# On MS Windows, Tcl bug b80ccfcf32 restores environment variables to their
# original values upon [interp create tkwintrack], both in the parent and
# in the child interp, disregarding any changes made to them previously in Tcl.
#
# This bug has been fixed in Tcl version: not yet (== 999.999.999);
# highest current Tcl releases: 8.6.11, 8.7a5, 9.0a3
#
testConstraint no_TclBug_b80ccfcf32 [expr {($tcl_platform(platform) ne "windows") || ([package vcompare $tcl_patchLevel 999.999.999] >= 0)}]
enableTestsOnDarwin
enableOutputFromInterp -auto

#
# Prevent that [package] in the tests below, inadvertently
# loads a version of tkwintrack installed elsewhere.
#
package forget tkwintrack
set sav(auto_path) $auto_path; set auto_path [list $Dir(install)]

# Use a fake clean HOME directory so that we are sure not to read any
# existing tkwintrack configuration file.
set home [file normalize ~/tkwintracktest_home]
file delete -force $home
file mkdir $home
set sav(HOME) $env(HOME)
set env(HOME) $home

#
# INTRO
#
set pkgVersion [getPackageVersion $Dir(install)]
puts "\n[set starline [string repeat * 46]]\n* Test tkwintrack $pkgVersion\n*\n* DO NOT HANDLE THE MOUSE DURING THESE TESTS\n$starline\n"
flush stdout
after 2000

# Output relevant system properties for issue reporting
array set platform [array get tcl_platform]
unset -nocomplain platform(user) platform(byteOrder) platform(machine) platform(pathSeparator) platform(pointerSize) platform(wordSize)
puts "Test environment\n----------------"
puts "Executable: [file tail [info nameofexecutable]]"
puts "Tcl patch level: $tcl_patchLevel"
if {! [testConstraint no_initial_tk]} {
	puts "Tk patch level: $tk_patchLevel"
}
parray platform
puts ""
unset platform
puts "Test configuration\n------------------"
parray testconf
puts ""

#
# START TESTS
#

# package-1
#
# REQUIREMENT ERRORS
#
test package-1.1 {package require fails if Tk is not loaded} -constraints no_initial_tk -setup {
	set result {}
} -body {
	lappend result [catch {package require -exact tkwintrack $pkgVersion} errMsg]
	lappend result $errMsg
	lappend result [namespace exists ::tkwintrack]
} -cleanup {
	unset result
} -result [list 1 "tkwintrack requires a running Tk application" 0]

test package-1.2 {package require fails with too old Tk version} -constraints no_initial_tk -setup {
	package provide Tk 8.4
	set result {}
} -body {
	lappend result [catch {package require -exact tkwintrack $pkgVersion} errMsg]
	lappend result $errMsg
	lappend result [namespace exists ::tkwintrack]
} -cleanup {
	unset result
	package forget Tk
} -result [list 1 "tkwintrack $pkgVersion requires Tk 8.5 or newer" 0]

#
# Nrs. 1.50 and beyond are used for tests that may be removed in a newer version
#

test package-1.99 {package require fails under macOS} -setup {
	set sav(os) $tcl_platform(os)
	set tcl_platform(os) "Darwin"; # impersonate
} -body {
	lappend result [catch {package require -exact tkwintrack $pkgVersion} errMsg]
	lappend result $errMsg
	lappend result [namespace exists ::tkwintrack]
} -cleanup {
	set tcl_platform(os) $sav(os)
	unset sav(os) result
} -result [list 1 "tkwintrack $pkgVersion does not support macOS (or OS X / Mac OS X)" 0]


#
# INITIALIZATION FOR TESTS REQUIRING A VALID TK
#
set auto_path $sav(auto_path)
if {[testConstraint no_initial_tk]} {
	package require Tk 8.5
	puts "\nUsing Tk $tk_patchLevel\n"
} else {
	# ensure that the package database is created
	catch {package require [expr {rand()}] 999}
}
if {[package ifneeded windetect 1.0] eq ""} {
	# If package windetect is not found, [with_cfgDialog] generates a background
	# error which may be perceived as confusing. Abort test execution.
	puts stderr "error: package windetect 1.0 is not in the current auto_path:\n$auto_path\nTest script execution aborted."
	exit 1
}
source [file join $Dir(test) gn gn.tcl]
namespace import gn::*

# One time initial configuration of the root window for all tests
wm geometry . +300+300
pack propagate . 0
twait 40

# Tk specific test constraints
set haveTkBug(e3888d5820) [expr {[package vcompare [package present Tk] 8.6.10] <= 0}]
testConstraint no_TkBug_e3888d5820 [expr {! $haveTkBug(e3888d5820)}]

# launch scripts for test setup
set launchScript(base) {
	unset -nocomplain state result; # safeguard
	. configure -width 200 -height 200
	wm deiconify .
	update idletasks
	event generate . <Motion> -warp 1 -x -50 -y 100 -when now
	twait 400
}
set launchScript(button_continue) {
	catch {::tkwintrack::exit}; # ensure a cleaned up environment
	eval $launchScript(base)
	with_cfgDialog on_pkg_load continue {}
}

#
# START TESTS REQUIRING Tk
#

# package-2
#
# NO ERRORS FORESEEN
#
test package-2.1 {package require provides package} -setup {
	# Prevent that [package] inadvertently loads a tkwintrack version installed
	# elsewhere, but ensure that any windetect versions in the auto_path
	# end up in the package database, by searching for a non existent package.
	set auto_path $sav(auto_path)
	if {! [catch {package require non_existent}]} {
		error "package non_existent does exist"
	}
	package forget tkwintrack; set auto_path [list $Dir(install)]
	# schedule cleanup
	after [wtune 1000] {interp eval tkwintrack {set ::TkWintrack(dlgChoice) "exit"}}
} -body {
	package require tkwintrack
} -cleanup {
	set auto_path $sav(auto_path)
} -result $pkgVersion

test package-2.2 {package launch displays config dialog and creates pathname widget} -setup $launchScript(base) -body {
	with_cfgDialog on_pkg_load exit {
		list [winfo ismapped $TkWintrack(cfgFrame)] [winfo exists $TkWintrack(pnWidget)]
	}
} -result {1 1}

test exit-1.1 {by clicking the exit button} -setup {
	eval $launchScript(base)
	catch {tkwintrack::exit}
} -body {
	with_cfgDialog on_pkg_load exit {}
	# check whether all package related objects are destroyed
	list [interp exists tkwintrack] [namespace exists ::tkwintrack] [catch {package present tkwintrack}]
} -result {0 0 1}

test config_dlg-1.1 {right-clicking the pathname widget} -setup {
	eval $launchScript(button_continue)
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
} -body {
	with_cfgDialog on_pnw_click exit {
		list [winfo ismapped $TkWintrack(cfgFrame)] [winfo ismapped $TkWintrack(pnWidget)]
	}
} -result {1 0}

test mainwin-1.1 {position of dialog relative to main window} -setup $launchScript(base) -body {
	#
	# A. large root win unmapped, smaller child toplevel mapped
	#
	# prepare windows, their geometries and mapped state
	wm withdraw .
	toplevel .small -width 100 -height 100
	wm geometry .small +500+300
	wm deiconify .small
	tkwait visibility .small
	twait 200
	
	array set geom [list \
		mainwin_rootx,A [winfo rootx .small] \
		mainwin_width,A [winfo width .small] \
	]
	set geom(dlg_wm_x,A) [with_cfgDialog on_pkg_load continue {
		regexp -- {\d\+(\d+)\+} [wm geometry .] -- x
		set x
	}]
	set result [expr {$geom(dlg_wm_x,A) == ($geom(mainwin_rootx,A) + $geom(mainwin_width,A)/2)}]
	
	#
	# B. large root win mapped + smaller child toplevel mapped in the same session
	#
	# prepare windows, their geometries and mapped state
	wm deiconify .
	mouse_move .small c
	twait 400
	array set geom [list \
		mainwin_rootx,B [winfo rootx .] \
		mainwin_width,B [winfo width .] \
	]
	set geom(dlg_wm_x,B) [with_cfgDialog on_pnw_click exit {
		regexp -- {\d\+(\d+)\+} [wm geometry .] -- x
		set x
	}]
	lappend result [expr {$geom(dlg_wm_x,B) == ($geom(mainwin_rootx,B) + $geom(mainwin_width,B)/2)}]
} -cleanup {
	unset geom result
	destroy .small
} -result {1 1}

test mainwin-1.2 {initial position of pathname widget relative to main window if not following mouse} -setup $launchScript(base) -body {
	#
	# A large root win unmapped, smaller child toplevel mapped
	#
	# prepare windows, their geometries and mapped state
	wm withdraw .
	toplevel .small -width 100 -height 100
	wm geometry .small +500+300
	wm deiconify .small
	tkwait visibility .small
	twait 200
	
	with_cfgDialog on_pkg_load continue {
		set TkWintrack(pnw,followMouse) 0
	}
	array set geom [list \
		mainwin,rootx [winfo rootx .small] \
		mainwin,width [winfo width .small] \
		mainwin,rooty [winfo rooty .small] \
		mainwin,height [winfo height .small] \
	]
	array set geom [interp eval tkwintrack {
	    regexp -- {^(\d+)x(\d+)\+(\d+)\+(\d+)$} [wm geometry $TkWintrack(pnWidget)] -- geom(pnw,width) geom(pnw,height) geom(pnw,rootx) geom(pnw,rooty)
	    array get geom
	}]
	set result [list [expr {$geom(pnw,rootx) == ($geom(mainwin,rootx) + $geom(mainwin,width)/2)}] \
			[expr {$geom(pnw,rooty) == ($geom(mainwin,rooty) + $geom(mainwin,height)/2)}] \
	]
} -cleanup {
	tkwintrack::exit
	unset geom result
	destroy .small
} -result {1 1}


# config-10-
#
# TESTS REGARDING THE CONFIGURATION FILE
#   1. config file can be created
#	2. config file validity
#
test config-1.1 {relevant environment variables don't exist} -constraints no_TclBug_b80ccfcf32 -setup {
	set varList {HOME APPDATA LOCALAPPDATA}
	foreach var $varList {
		if {[info exists env($var)]} {
			set envSav($var) $env($var)
			unset env($var)
		}
	}
} -body {
	with_cfgDialog on_pkg_load exit {set TkWintrack(outline,color)}
} -cleanup {
	foreach var $varList {
		if {[info exists envSav($var)]} {
			set env($var) $envSav($var)
		}
	}
	unset -nocomplain varList envSav
} -result #FF0000 -output "warning: cannot save/restore configuration because*the environment variable*exist*\n" -match glob

test config-1.2 {the dirs referenced by env don't exist} -setup {
	set varList {HOME APPDATA LOCALAPPDATA}
	foreach var $varList {
		if {[info exists env($var)]} {
			set envSav($var) $env($var)
			set env($var) @nonexistent.$var@
		}
	}
} -body {
	with_cfgDialog on_pkg_load exit {set TkWintrack(outline,color)}
} -cleanup {
	foreach var $varList {
		if {[info exists envSav($var)]} {
			set env($var) $envSav($var)
		}
	}
	unset -nocomplain varList envSav
} -result #FF0000 -output "warning: cannot save/restore configuration because no writable location was found in *\n" -match glob

test config-1.3 {home dir not writable} -constraints unix -setup {
	file attributes $env(HOME) -permissions u-w
} -body {
	with_cfgDialog on_pkg_load exit {set TkWintrack(outline,color)}
} -cleanup {
	file attributes $env(HOME) -permissions u+w
} -result #FF0000 -output "warning: cannot save/restore configuration because no writable location was found in *\n" -match glob

test config-2.1 {config file exceeds size limit} -setup {
	set str [string repeat "Too large for tkwintrack\n" 300]
	set configFile [getConfigFile]
	set fd [open $configFile w]
	puts $fd $str
	close $fd
} -body {
	with_cfgDialog on_pkg_load exit {set TkWintrack(outline,color)}
} -cleanup {
	file delete $configFile
	unset configFile
} -result #FF0000 -output "warning: size of the config file * exceeded the allowed maximum (5000 bytes). Will continue using defaults.\n" -match glob

test config-2.2 {disregard rubbish in config file} -setup {
	set configFile [getConfigFile]
	set fd [open $configFile w]
	puts $fd "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
	close $fd
} -body {
	with_cfgDialog on_pkg_load exit {set TkWintrack(outline,color)}
} -cleanup {
	file delete $configFile
	unset configFile
} -result #FF0000 -output {}

test config-2.3 {config file save/restore ok} -body {
	set configFile [with_cfgDialog on_pkg_load exit {
		set TkWintrack(outline,color) #AAAAAA
		set TkWintrack(config,fileName)
	}]
	set fileSize [file size $configFile]
	lappend result [with_cfgDialog on_pkg_load exit {set TkWintrack(outline,color)}]
	lappend result [expr {[file size $configFile~] == $fileSize}]
	set result
} -cleanup {
	file delete $configFile
	unset result configFile
} -result [list #AAAAAA 1] -output {}

test config-2.4 {support old wintrackgui config file, read ok} -setup {
	set configFile [with_cfgDialog on_pkg_load exit {
		set index [lsearch $TkWintrack(config,optionNames) outline,color]
		set TkWintrack(config,optionNames) [lreplace $TkWintrack(config,optionNames) $index $index outlineColor]
		set index [lsearch $TkWintrack(config,optionNames) outline,width]
		set TkWintrack(config,optionNames) [lreplace $TkWintrack(config,optionNames) $index $index outlineWidth]
		array unset TkWintrack outline,*
		set TkWintrack(outlineColor) #BBBBBB
		set TkWintrack(outlineWidth) 4
		set TkWintrack(config,fileName)
	}]
	set oldConfigFile [file join $env(HOME) wintrackgui.conf]
	file rename $configFile $oldConfigFile
} -body {
	set result [with_cfgDialog on_pkg_load exit {list $TkWintrack(outline,color) $TkWintrack(outline,width)}]
} -cleanup {
	file delete $configFile $oldConfigFile
	unset result configFile oldConfigFile
} -result [list #BBBBBB 4]

#
# THE FOLLOWING TESTS PREREQUIRE A LOADED PACKAGE
#
eval $launchScript(button_continue)
puts [outputChannel] "\nUsing package windetect [set v [package present windetect]] installed at [file dirname [lindex [package ifneeded windetect $v] 1]]\n"
unset v

# track_case-1
#
# MOUSE POINTER MOTION INTO AND OUT OF A WINDOW
#
test track_case-1.1 {Pointer motion into and out of a window, skip virtual crossings} -setup {
	eval $launchScript(base)
	frame .f
	pack [label .f.l -bg green -width 10 -height 2]
	pack .f -anchor se -side bottom
	twait 200
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	set log {}
	proc log {W args} {
		lappend ::log $W
	}
	trace add execution ::tkwintrack::update_screen enter {log $W}
} -body {
	mouse_move .f.l c
	twait 200
	record state(1,outline) outline .f.l
	record state(1,pnw) pnw
	mouse_move .f nw out
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw) $log]
} -cleanup {
	trace remove execution ::tkwintrack::update_screen enter {log $W}
	unset result state log
	rename log {}
	destroy .f
} -result {.f.l .f}

test track_case-1.2 {Pointer motion into and out of a window, include virtual crossings} -setup {
	eval $launchScript(base)
	frame .f
	pack [label .f.l -bg green -width 10 -height 2]
	pack .f -anchor se -side bottom
	twait 200
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	set log {}
	proc log {W args} {
		lappend ::log $W
	}
	::windetect::configure -delay 0
	trace add execution ::tkwintrack::update_screen enter {log $W}
} -body {
	mouse_move .f.l c
	twait 200
	record state(1,outline) outline .f.l
	record state(1,pnw) pnw
	mouse_move .f nw out
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw) $log]
} -cleanup {
	trace remove execution ::tkwintrack::update_screen enter {log $W}
	::windetect::configure -delay 50
	unset result state log
	rename log {}
	destroy .f
} -result {.f .f.l .f.l .f}

test track_case-1.3 {Pointer motion out of the active client area} -setup $launchScript(base) -body {
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	record state(1,outline) outline .
	record state(1,pnw) pnw
	event generate . <Motion> -warp 1 -x -50 -y -50 -when now
	twait 1000
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw)]
} -cleanup {
	unset result state
} -result [list 2,outline: outline.unmapped 2,pnw: pnw.unmapped]

test track_case-1.4 {Pointer motion into and out of an overlapping grabbed toplevel} -setup {
	eval $launchScript(base)
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	toplevel .grab
	wm geometry .grab +[expr {[winfo rootx .]+100}]+[expr {[winfo rooty .]+100}]
	wm transient .grab .
	focus .grab
	raise .grab
	wm deiconify .grab
	tkwait visibility .grab
	grab .grab
	twait 100
} -body {
	event generate .grab <Motion> -warp 1 -x 50 -y 50 -when now; # enter .grab
	twait 200
	record state(1,outline,root) outline .
	record state(1,outline,grab) outline .grab
	record state(1,pnw) pnw
	event generate .grab <Motion> -warp 1 -x -50 -y -50 -when now; # leave .grab
	twait 200
	record state(2,outline,root) outline .
	record state(2,outline,grab) outline .grab
	record state(2,pnw) pnw
	set result [concat $state(1,outline,root) $state(1,outline,grab) $state(1,pnw) $state(2,outline,root) $state(2,outline,grab) $state(2,pnw)]
} -cleanup {
	destroy .grab
	unset result state
} -result [list 1,outline,root: outline.unmapped 2,outline,root: outline.unmapped 2,outline,grab: outline.unmapped 2,pnw: pnw.unmapped]

# track_case-2
#
# RESIZING OF THE TRACKED WINDOW
#
# Important: exercise the resizing on a window whose contents can't be clipped
# (like occurs with a toplevel)
test track_case-2.1 {Tracked window resizes while pointer remains inside it} -setup {
	eval $launchScript(base)
	pack [frame .f -bg green -width 50 -height 50] -side right -padx 50
	twait 200
} -body {
	mouse_move .f c
	twait 200
	record state(1,outline) outline .f
	record state(1,pnw) pnw
	.f configure -width 80 -height 80
	twait 200
	record state(2,frame) outline .f
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,frame) $state(2,pnw)]
} -cleanup {
	destroy .f
	unset result state
} -result {}

# track_case-3
#
# MOVING THE TRACKED WINDOW
#
test track_case-3.1 {Tracked window is moved to another position inside its master while the mouse pointer remains inside it} -setup {
	eval $launchScript(base)
	pack [frame .f -bg green -width 150 -height 30] -anchor se -side bottom
	twait 200
} -body {
	mouse_move .f c
	twait 200
	record state(1,outline) outline .f
	record state(1,pnw) pnw
	pack configure .f -anchor sw
	twait 200
	record state(2,frame) outline .f
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,frame) $state(2,pnw)]
} -cleanup {
	unset result state
	destroy .f
} -result {}

test track_case-3.2 {Leaving the tracked window by moving it to another position inside its master} -setup {
	eval $launchScript(base)
	pack [frame .f -bg green -width 50 -height 20] -anchor se -side bottom
	twait 200
} -body {
	mouse_move .f c
	twait 200
	record state(1,outline) outline .f
	record state(1,pnw) pnw
	pack configure .f -anchor sw
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw)]
} -cleanup {
	unset result state
	destroy .f
} -result {}

# track_case-4
#
# MAPPING/UNMAPPING THE TRACKED WINDOW
#
test track_case-4.1 {Leaving and entering a packed widget through its unmapping/remapping} -setup {
	eval $launchScript(base)
	pack [frame .f -bg green -width 50 -height 50] -anchor se -side bottom
	twait 200
} -body {
	mouse_move .f c
	twait 200
	record state(1,outline) outline .f
	record state(1,pnw) pnw
	pack forget .f
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	pack .f -anchor se -side bottom
	twait 200
	record state(3,outline) outline .f
	record state(3,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw) $state(3,outline) $state(2,pnw)]
} -cleanup {
	unset result state
	destroy .f
} -result {}

test track_case-4.2 {Leaving and entering the active client area by successive unmapping/remapping} -setup {
	eval $launchScript(base)
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
} -body {
	wm withdraw .
	twait 400
	record state(1,outline) outline .
	record state(1,pnw) pnw
	wm deiconify .
	twait 400
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw)]
} -cleanup {
	unset result state
} -result [list 1,outline: outline.unmapped 1,pnw: pnw.unmapped]

# track_case-5
#
# DESTRUCTION OF THE TRACKED WINDOW
#
test track_case-5.1 {Leaving a toplevel through its destruction, entering root window} -setup {
	eval $launchScript(base)
	toplevel .two -width 200 -height 200
	wm geometry .two +[expr {[winfo rootx .]+50}]+[expr {[winfo rooty .]+50}]
	wm transient .two .
	wm deiconify .two
	focus .two
	raise .two
	tkwait visibility .two
	after [wtune 200]
	event generate .two <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	record state(1,outline,root) outline .
	record state(1,outline,two) outline .two
	record state(1,pnw) pnw
} -body {
	destroy .two
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline,root) $state(1,outline,two) $state(1,pnw) $state(2,outline) $state(2,pnw)]
} -cleanup {
	destroy .two
	unset result state
} -result [list 1,outline,root: outline.unmapped]

test track_case-5.2 {Leaving a toplevel through its destruction, entering screen outside client application} -setup {
	eval $launchScript(base)
	toplevel .two -width 200 -height 200
	wm geometry .two +[expr {[winfo rootx .]+150}]+[expr {[winfo rooty .]+150}]
	wm transient .two .
	wm deiconify .two
	focus .two
	raise .two
	tkwait visibility .two
	after [wtune 100]
	event generate .two <Motion> -warp 1 -x 150 -y 150 -when now
	twait 200
	record state(1,outline,root) outline .
	record state(1,outline,two) outline .two
	record state(1,pnw) pnw
} -body {
	destroy .two
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline,root) $state(1,outline,two) $state(1,pnw) $state(2,outline) $state(2,pnw)]
} -cleanup {
	unset result state
} -result [list 1,outline,root: outline.unmapped 2,outline: outline.unmapped 2,pnw: pnw.unmapped]

test track_case-5.3 {Leaving a packed window by its destruction} -setup {
	eval $launchScript(base)
	pack [frame .f -bg green -width 50 -height 20] -anchor se -side bottom
	twait 200
} -body {
	mouse_move .f c
	twait 200
	record state(1,outline) outline .f
	record state(1,pnw) pnw
	destroy .f
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw)]
} -cleanup {
	unset result state
} -result {}

# track_case-6
#
# GRABS ONLY, AFFECTING THE DETECTION OF WINDOWS
#
test track_case-6.1 {Leave a window by grabbing a toplevel outside the pointer window} -setup {
	eval $launchScript(base)
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
} -body {
	toplevel .grab
	wm geometry .grab +[expr {[winfo rootx .]+100}]+[expr {[winfo rooty .]+100}]
	wm transient .grab .
	focus .grab
	raise .grab
	wm deiconify .grab
	tkwait visibility .grab
	record state(1,outline,root) outline .
	record state(1,outline,grab) outline .grab
	record state(1,pnw) pnw
	grab .grab
	twait 200
	record state(2,outline,root) outline .
	record state(2,outline,grab) outline .grab
	record state(2,pnw) pnw
	set result [concat $state(1,outline,root) $state(1,outline,grab) $state(1,pnw) $state(2,outline,root) $state(2,outline,grab) $state(2,pnw)]
} -cleanup {
	destroy .grab
	unset result state
} -result [list 1,outline,grab: outline_top.not_exists 2,outline,root: outline.unmapped 2,outline,grab: outline_top.not_exists 2,pnw: pnw.unmapped]

# track_case-7
#
# DETECTION EVENTS INVOLVING THE PATHNAME WIDGET
#
test track_case-7.1 {Entering and leaving the pathname widget, no grab} -setup $launchScript(base) -body {
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	record state(1,outline) outline .
	record state(1,pnw) pnw
	record state(1,pnwGeom) pnwGeom
	interp eval tkwintrack {mouse_move $TkWintrack(pnLabel) c}
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	record state(2,pnwGeom) pnwGeom
	interp eval tkwintrack {mouse_move $TkWintrack(pnWidget) w out}
	twait 200
	record state(3,outline) outline .
	record state(3,pnw) pnw
	record state(3,pnwGeom) pnwGeom
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw) $state(3,outline) $state(3,pnw) [expr {($state(1,pnwGeom) eq $state(2,pnwGeom)) && ($state(1,pnwGeom) eq $state(3,pnwGeom))}]]
} -cleanup {
	unset result state
} -result [list 2,pnw: pnw.pathname . 1]

test track_case-7.2 {Entering and leaving the pathname widget, with grab} -setup $launchScript(base) -body {
	grab .
	twait 200
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	record state(1,outline) outline .
	record state(1,pnw) pnw
	record state(1,pnwGeom) pnwGeom
	interp eval tkwintrack {mouse_move $TkWintrack(pnLabel) c}
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	record state(2,pnwGeom) pnwGeom
	interp eval tkwintrack {mouse_move $TkWintrack(pnWidget) w out}
	twait 200
	record state(3,outline) outline .
	record state(3,pnw) pnw
	record state(3,pnwGeom) pnwGeom
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw) $state(3,outline) $state(3,pnw) [expr {($state(1,pnwGeom) eq $state(2,pnwGeom)) && ($state(1,pnwGeom) eq $state(3,pnwGeom))}]]
} -cleanup {
	grab release .
	unset result state
} -result [list 2,pnw: pnw.pathname . 1]

# We can't test this with Tk <= 8.6.10 because of Tk bug e3888d5820,
# but manually exercising the functionality doesn't reveal any problem.
test track_case-7.3 {Entering the pathname widget, and dragging it with the mouse, with grab} -constraints no_TkBug_e3888d5820 -setup {
	eval $launchScript(base)
} -body {
	grab .
	twait 200
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	interp eval tkwintrack {mouse_move $TkWintrack(pnLabel) nw}
	twait 200
	record state(1,outline) outline .
	record state(1,pnw) pnw
	record state(1,pnwGeom) pnwGeom
	interp eval tkwintrack {event generate $TkWintrack(pnLabel) <ButtonPress-1> -rootx [winfo pointerx .] -rooty [winfo pointery .] -when now}
	update idletasks
	# the next command causes a wrong mouse pointer positioning if subject to Tk bug e3888d5820
	interp eval tkwintrack {event generate $TkWintrack(pnLabel) <B1-Motion> -warp 1 -x 30 -y 30 -when now}
	update idletasks
	record state(2,outline) outline .
	record state(2,pnw) pnw
	record state(2,pnwGeom) pnwGeom
	foreach stage {1 2} {
		scan $state($stage,pnwGeom) {%[x0-9]+%d+%d} size coords(x,$stage) coords(y,$stage)
	}
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw) [expr {$coords(x,2) - $coords(x,1)}] \
			[expr {$coords(y,2) - $coords(y,1)}]]
} -cleanup {
	grab release .
	unset result state size coords stage
} -result [list 1,pnw: pnw.pathname . 2,pnw: pnw.pathname . 30 30]

#
# KEYBOARD SHORTCUTS
#
test shortcutKey-1.1 {toggle detection off/on} -setup {
	eval $launchScript(base)
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
} -body {
	lappend result [interp eval tkwintrack {winfo ismapped $TkWintrack(pnWidget)}]
	event generate . <KeyPress-$::tkwintrack::TkWintrack(key,shortcutSeq,toggle)>
	twait 200
	lappend result [interp eval tkwintrack {winfo ismapped $TkWintrack(pnWidget)}]
	event generate . <KeyPress-$::tkwintrack::TkWintrack(key,shortcutSeq,toggle)>
	twait 200
	lappend result [interp eval tkwintrack {winfo ismapped $TkWintrack(pnWidget)}]
} -cleanup {
	unset result
} -result {1 0 1}

test shortcutKey-1.2 {copy pathname to clipboard} -setup {
	eval $launchScript(base)
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	clipboard clear
	clipboard append init|
} -body {
	set result [clipboard get]
	event generate . <KeyPress-$::tkwintrack::TkWintrack(key,shortcutSeq,copy)>
	update idletasks
	append result [clipboard get]
} -cleanup {
	unset result
} -result "init|."

test shortcutKey-1.3 {recall pathname widget} -setup {
	eval $launchScript(base)
	event generate . <Motion> -warp 1 -x 100 -y 100 -when now
	twait 200
} -body {
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	update idletasks
	event generate . <KeyPress-$::tkwintrack::TkWintrack(key,shortcutSeq,recall)>
	twait 20
	regexp -- {\+(\d+)\+(\d+)$} [interp eval tkwintrack {wm geometry $TkWintrack(pnWidget)}] -- X Y
	list [expr {[winfo pointerx .]-$X-[interp eval tkwintrack {winfo reqwidth $TkWintrack(pnWidget)}]/2}] [expr {[winfo pointery .]-$Y-[interp eval tkwintrack {winfo reqheight $TkWintrack(pnWidget)}]/2}]
} -cleanup {
	unset X Y
} -result {0 0}


# track_case-11
#
# ENTERING/LEAVING THE OUTLINE WIDGETS
#
# This section addresses the oddities that arise in the screen area of the outline widgets.
#
test track_case-11.1 {Mouse pointer enters outline widget and leaves window from there} -setup $launchScript(base) -body {
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
	record state(1,outline) outline .
	record state(1,pnw) pnw
	mouse_move . w
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	mouse_move . w out
	twait 1000; # needs long on my windows box
	record state(3,outline) outline .
	record state(3,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw) $state(3,outline) $state(3,pnw)]
} -cleanup {
	unset result state
} -result [list 2,pnw: pnw.pathname . 3,outline: outline.unmapped 3,pnw: pnw.unmapped]

#
# This test fails if the outline frame is insensitive to detection by <Enter> events.
#
test track_case-11.2 {Mouse pointer enters outline widget, coming from the pathname widget} -setup {
	eval $launchScript(base)
	pack [frame .f -bg green -width 150 -height 30] -anchor n -side top
	twait 200
	mouse_move .f c
	twait 200
	set rootY [winfo rooty .]
	set pnwVar [interp eval tkwintrack {set TkWintrack(pnWidget)}]
	interp eval tkwintrack [subst -nocommands {wm geometry $pnwVar +400+[expr {$rootY + 2}]}]
	twait 20; # allow for screen update on windows
} -body {
	interp eval tkwintrack {mouse_move $TkWintrack(pnLabel) c}
	twait 100
	record state(1,pnwGeom) pnwGeom
	interp eval tkwintrack {mouse_move $TkWintrack(pnLabel) n out}
	twait 200
	record state(2,frame) outline .f
	record state(2,pnw) pnw
	record state(2,pnwGeom) pnwGeom
	set result [concat $state(2,frame) $state(2,pnw) [expr {$state(1,pnwGeom) eq $state(2,pnwGeom)}]]
} -cleanup {
	destroy .f
	unset result state
} -result [list 2,pnw: pnw.pathname .f 1]

test track_case-11.3 {toggle detection off/on inside the outline widget} -setup {
	eval $launchScript(base)
} -body {
	event generate . <Motion> -warp 1 -x 1 -y 100 -when now
	twait 200
	record state(1,outline) outline .
	record state(1,pnw) pnw
	event generate . <KeyPress-$::tkwintrack::TkWintrack(key,shortcutSeq,toggle)>
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	event generate . <KeyPress-$::tkwintrack::TkWintrack(key,shortcutSeq,toggle)>
	twait 200
	record state(3,outline) outline .
	record state(3,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw) $state(3,outline) $state(3,pnw)]
} -cleanup { 
	unset result state
} -result {1,pnw: pnw.pathname . 2,outline: outline.unmapped 2,pnw: pnw.unmapped 3,pnw: pnw.pathname .}

#
# A window, smaller than the outline width, positioned within the outline
# area of its master window, cannot be detected when the mouse pointer
# comes from inside its master, because the outline is covering it entirely.
#
# When coming from outside its master, detection is possible and the
# outline widget will be moved to the single pixel window. This test
# exercises whether the reported pathname is correct under the different
# stages of outline highlighting.
#
test track_case-11.4 {Mouse motion into a single pixel window in the outline area} -setup {
	eval $launchScript(base)
	frame .f1 -width 50 -height 50 -bg yellow
	pack propagate .f1 0
	pack [frame .f1.f2 -width 1 -height 1 -bg darkblue] -side left -anchor c
	pack .f1 -anchor c -side right
	twait 200
	event generate . <Motion> -warp 1 -x 50 -y 50 -when now
	twait 200
} -body {
	mouse_move .f1.f2 c
	twait 200
	record state(1,outline) outline .f1.f2
	record state(1,pnw) pnw
	mouse_move .f1 w out
	twait 200
	record state(2,outline) outline .
	record state(2,pnw) pnw
	set result [concat $state(1,outline) $state(1,pnw) $state(2,outline) $state(2,pnw)]
} -cleanup {
	unset result state
	destroy .f1
} -result {1,pnw: pnw.pathname .f1.f2}


# config-11+
#
# RECONFIGURATION OF WIDGETS
#   11-20. outline related
#   21-30. pathname widget related
#   31-40. keyboard shortcuts related
#
test config-11.1 {reset outline width} -setup {
	eval $launchScript(base)
	mouse_move . c
	twait 200
} -body {
	with_cfgDialog on_pnw_click continue {
		$TkWintrack(cfgFrame).outline,width_value set 5
	}
	mouse_move . c
	twait 200
	record state(1,outline) outline .
	set result [list [$::tkwintrack::Outline(top) cget -height] $state(1,outline)]
	with_cfgDialog on_pnw_click continue {
		mouse_move $TkWintrack(button_reset) c
		mouse_button left click
	}
	mouse_move . c
	twait 200
	lappend result [$::tkwintrack::Outline(top) cget -height]
} -cleanup {
	unset result state
} -result [list 5 {} 2]

test config-11.2 {reconfigure outline width} -setup {
	eval $launchScript(base)
	mouse_move . c
	twait 200
} -body {
	with_cfgDialog on_pnw_click continue {
		$TkWintrack(cfgFrame).outline,width_value set 5
	}
	mouse_move . c
	twait 200
	$::tkwintrack::Outline(top) cget -height
} -cleanup {
	interp eval tkwintrack config.reset; twait 100
} -result 5

test config-11.3 {reconfigure outline colour} -constraints unix -setup {
	eval $launchScript(base)
	mouse_move . c
	twait 200
} -body {
	with_cfgDialog on_pnw_click continue {
		userSim.setColor outline,color #0000ff
	}
	mouse_move . c
	twait 200
	$::tkwintrack::Outline(top) cget -background
} -cleanup {
	interp eval tkwintrack config.reset; twait 100
} -result #0000ff

test config-12.1 {reconfigure pathname widget, background} -constraints unix -setup {
	eval $launchScript(base)
	mouse_move . c
	twait 200
} -body {
	with_cfgDialog on_pnw_click continue {
		userSim.setColor pnw,background #ff00ff
	}
	mouse_move . c
	twait 200
	interp eval tkwintrack {$TkWintrack(pnLabel) cget -background}
} -cleanup {
	interp eval tkwintrack config.reset; twait 100
} -result #ff00ff

test config-12.2 {reconfigure pathname widget, foreground+border} -constraints unix -setup {
	eval $launchScript(base)
	mouse_move . c
	twait 200
} -body {
	with_cfgDialog on_pnw_click continue {
		userSim.setColor pnw,foreground #00ff00
	}
	mouse_move . c
	twait 200
	interp eval tkwintrack {list [$TkWintrack(pnWidget) cget -background] [$TkWintrack(pnLabel) cget -foreground] [$TkWintrack(pnLabel) cget -highlightbackground]}
} -cleanup {
	interp eval tkwintrack config.reset; twait 100
} -result [list #00ff00 #00ff00 #00ff00]

test config-12.3 {reconfigure pathname widget, follow mouse} -setup {
	eval $launchScript(base)
	mouse_move . nw
	twait 200
} -body {
	array set geom1 [interp eval tkwintrack {
	    regexp -- {\+(\d+)\+(\d+)$} [wm geometry $TkWintrack(pnWidget)] -- geom(rootx) geom(rooty)
	    array get geom
	}]
	with_cfgDialog on_pnw_click continue {
		mouse_move $TkWintrack(cfgFrame).pnw,followMouse_value c
		mouse_button left click
	}
	mouse_move . se
	twait 200
	array set geom2 [interp eval tkwintrack {
	    regexp -- {\+(\d+)\+(\d+)$} [wm geometry $TkWintrack(pnWidget)] -- geom(rootx) geom(rooty)
	    array get geom
	}]
	foreach name {rootx rooty} {
		lappend result [expr {$geom2($name) == $geom1($name)}]
	}
	set result
} -cleanup {
	unset geom1 geom2 name result
	interp eval tkwintrack config.reset; twait 100
} -result {1 1}

test config-13.1 {reconfigure keyboard shortcut for toggle detection} -setup {
	eval $launchScript(base)
	mouse_move . c
	twait 200
} -body {
	with_cfgDialog on_pnw_click continue {
		after 10 event generate . <KeyPress> -keysym Q
		mouse_move $TkWintrack(pnw,toggle) c
		twait 200
	}
	set ::tkwintrack::TkWintrack(key,shortcutSeq,toggle)
} -cleanup {
	interp eval tkwintrack config.reset; twait 100
} -result Q

test config-13.2 {reconfigure keyboard shortcut for copy pathname function} -setup {
	eval $launchScript(base)
	mouse_move . c
	twait 200
} -body {
	with_cfgDialog on_pnw_click continue {
		after 10 event generate . <KeyPress> -keysym Q
		mouse_move $TkWintrack(pnw,copy) c
		twait 200
	}
	set ::tkwintrack::TkWintrack(key,shortcutSeq,copy)
} -cleanup {
	interp eval tkwintrack config.reset; twait 100
} -result Q

test config-13.3 {reconfigure keyboard shortcut for recall pathname widget function} -setup {
	eval $launchScript(base)
	mouse_move . c
	twait 200
} -body {
	with_cfgDialog on_pnw_click continue {
		after 10 event generate . <KeyPress> -keysym Q
		mouse_move $TkWintrack(pnw,recall) c
		twait 200
	}
	set ::tkwintrack::TkWintrack(key,shortcutSeq,recall)
} -cleanup {
	interp eval tkwintrack config.reset; twait 100
} -result Q


#
# END OF TESTS, clean up and show results
#

# Allow for any handlers for <Destroy> events to update the internal
# registration of tkwintrack. Otherwise, we get errors on tkwintrack::exit
# if the last test that is run, destroys a window (in a test cleanup).
twait 400

tkwintrack::exit

# restore the original HOME directory
file delete -force $home
set env(HOME) $sav(HOME)

tcltest::cleanupTests
#
# It appears that cleanupTests also calls exit when running Tk non-interactively :-(
# Therefore, [cleanupTests] must be the very last command in this script.
#

# EOF
