Pratt 1.5.6

data/pkgs/tile-0.8.2/tests/paned.test

@@ -0,0 +1,298 @@
+#
+# paned.test,v 1.6 2007/11/25 17:17:10 jenglish Exp
+#
+
+package require Tk
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+lappend auto_path .
+package require tile
+
+proc propagate-geometry {} { update idletasks }
+
+# Basic sanity checks:
+#
+test paned-1.0 "Setup" -body {
+    ttk::panedwindow .pw
+} -result .pw
+
+test paned-1.1 "Make sure empty panedwindow doesn't crash" -body {
+    pack .pw -expand true -fill both
+    update
+}
+
+test paned-1.2 "Add a pane" -body {
+    .pw add [ttk::frame .pw.f1]
+    winfo manager .pw.f1
+} -result "panedwindow"
+
+test paned-1.3 "Steal pane" -body {
+    pack .pw.f1 -side bottom
+    winfo manager .pw.f1
+} -result "pack"
+
+test paned-1.4 "Make sure empty panedwindow still doesn't crash" -body {
+    update
+}
+
+test paned-1.5 "Remanage pane" -body {
+    #XXX .pw insert 0 .pw.f1 
+    .pw add .pw.f1
+    winfo manager .pw.f1
+} -result "panedwindow"
+
+test paned-1.6 "Forget pane" -body {
+    .pw forget .pw.f1
+    winfo manager .pw.f1
+} -result ""
+
+test paned-1.7 "Make sure empty panedwindow still still doesn't crash" -body {
+    update
+}
+
+test paned-1.8 "Re-forget pane" -body {
+    .pw forget .pw.f1
+} -returnCodes 1 -result ".pw.f1 is not managed by .pw"
+
+test paned-1.end "Cleanup" -body {
+    destroy .pw
+}
+
+# Resize behavior:
+#
+test paned-2.1 "..." -body {
+    ttk::panedwindow .pw -orient horizontal
+
+    .pw add [listbox .pw.l1]
+    .pw add [listbox .pw.l2]
+    .pw add [listbox .pw.l3]
+    .pw add [listbox .pw.l4]
+
+    pack .pw -expand true -fill both
+    update
+    set w1 [winfo width .]
+
+    # This should make the window shrink:
+    destroy .pw.l2
+
+    update
+    set w2 [winfo width .]
+
+    expr {$w2 < $w1} 
+} -result 1
+
+test paned-2.2 "..., cont'd" -body {
+
+    # This should keep the window from shrinking:
+    wm geometry . [wm geometry .]
+
+    set rw2 [winfo reqwidth .pw]
+
+    destroy .pw.l1
+    update
+
+    set w3 [winfo width .]
+    set rw3 [winfo reqwidth .pw]
+
+    expr {$w3 == $w2 && $rw3 < $rw2}
+    # problem: [winfo reqwidth] shrinks, but sashes haven't moved
+    # since we haven't gotten a ConfigureNotify.
+    # How to (a) check for this, and (b) fix it?
+} -result 1
+
+test paned-2.3 "..., cont'd" -body {
+
+    .pw add [listbox .pw.l5]
+    update
+    set rw4 [winfo reqwidth .pw]
+
+    expr {$rw4 > $rw3}
+} -result 1
+
+test paned-2.end "Cleanup" -body { destroy .pw }
+
+#
+# ...
+#
+test paned-3.0 "configure pane" -body {
+    ttk::panedwindow .pw
+    .pw add [listbox .pw.lb1] 
+    .pw add [listbox .pw.lb2] 
+    .pw pane 1 -weight 2
+    .pw pane 1 -weight
+} -result 2
+
+test paned-3.1 "configure pane -- errors" -body {
+    .pw pane 1 -weight -4
+} -returnCodes 1 -match glob -result "-weight must be nonnegative"
+
+test paned-3.2 "add pane -- errors" -body {
+    .pw add [ttk::label .pw.l] -weight -1
+} -returnCodes 1 -match glob -result "-weight must be nonnegative"
+
+
+test paned-3.end "cleanup" -body { destroy .pw }
+
+
+test paned-4.1 "forget" -body {
+    pack [ttk::panedwindow .pw -orient vertical] -expand true -fill both
+    .pw add [label .pw.l1 -text "L1"]
+    .pw add [label .pw.l2 -text "L2"]
+    .pw add [label .pw.l3 -text "L3"]
+    .pw add [label .pw.l4 -text "L4"]
+
+    update
+
+    .pw forget .pw.l1
+    .pw forget .pw.l2
+    .pw forget .pw.l3
+    .pw forget .pw.l4
+    update
+}
+
+test paned-4.2 "forget forgotten" -body {
+    .pw forget .pw.l1
+} -returnCodes 1 -result ".pw.l1 is not managed by .pw"
+
+# checkorder $winlist --
+#	Ensure that Y coordinates windows in $winlist are strictly increasing.
+#
+proc checkorder {winlist} {
+    set pos -1
+    set positions [list]
+    foreach win $winlist {
+    	lappend positions [set nextpos [winfo y $win]]
+	if {$nextpos <= $pos} {
+	    error "window $win out of order ($positions)"
+	}
+	set pos $nextpos
+    }
+}
+
+test paned-4.3 "insert command" -body {
+    .pw insert end .pw.l1
+    .pw insert end .pw.l3
+    .pw insert 1 .pw.l2
+    .pw insert end .pw.l4
+
+    update;
+    checkorder {.pw.l1 .pw.l2 .pw.l3 .pw.l4}
+}
+
+test paned-4.END "cleanup" -body {
+    destroy .pw
+}
+
+# See #1292219
+
+test paned-5.1 "Propagate Map/Unmap state to children" -body {
+    set result [list]
+    pack [ttk::panedwindow .pw]
+    .pw add [ttk::button .pw.b]
+    update
+
+    lappend result [winfo ismapped .pw] [winfo ismapped .pw.b]
+     
+    pack forget .pw
+    update
+    lappend result [winfo ismapped .pw] [winfo ismapped .pw.b]
+
+    set result
+} -result [list 1 1 0 0] -cleanup {
+    destroy .pw
+}
+
+### sashpos tests.
+#
+proc sashpositions {pw} {
+    set positions [list]
+    set npanes [llength [winfo children $pw]]
+    for {set i 0} {$i < $npanes - 1} {incr i} {
+    	lappend positions [$pw sashpos $i]
+    }
+    return $positions
+}
+
+test paned-sashpos-setup "Setup for sash position test" -body {
+    ttk::style theme use default
+    ttk::style configure -sashthickness 5
+
+    ttk::panedwindow .pw
+    .pw add [frame .pw.f1 -width 20 -height 20]
+    .pw add [frame .pw.f2 -width 20 -height 20]
+    .pw add [frame .pw.f3 -width 20 -height 20]
+    .pw add [frame .pw.f4 -width 20 -height 20]
+
+    propagate-geometry
+    list [winfo reqwidth .pw] [winfo reqheight .pw]
+} -result [list 20 [expr {20*4 + 5*3}]]
+
+test paned-sashpos-attempt-restore "Attempt to set sash positions" -body {
+    # This is not expected to succeed, since .pw isn't large enough yet.
+    #
+    .pw sashpos 0 30
+    .pw sashpos 1 60
+    .pw sashpos 2 90
+
+    list [winfo reqwidth .pw] [winfo reqheight .pw] [sashpositions .pw]
+} -result [list 20 95 [list 0 5 10]]
+
+test paned-sashpos-restore "Set height then sash positions" -body {
+    # Setting sash positions after setting -height _should_ succeed.
+    #
+    .pw configure -height 120
+    .pw sashpos 0 30
+    .pw sashpos 1 60
+    .pw sashpos 2 90
+    list [winfo reqwidth .pw] [winfo reqheight .pw] [sashpositions .pw]
+} -result [list 20 120 [list 30 60 90]]
+
+test paned-sashpos-cleanup "Clean up" -body { destroy .pw }
+
+test paned-propagation-setup "Setup." -body {
+    ttk::style theme use default
+    ttk::style configure -sashthickness 5
+    wm geometry . {}
+    ttk::panedwindow .pw -orient vertical
+
+    frame .pw.f1 -width 100 -height 50
+    frame .pw.f2 -width 100 -height 50
+
+    list [winfo reqwidth .pw.f1] [winfo reqheight .pw.f1]
+} -result [list 100 50] 
+
+test paned-propagation-1 "Initial request size" -body {
+    .pw add .pw.f1
+    .pw add .pw.f2
+    propagate-geometry
+    list [winfo reqwidth .pw] [winfo reqheight .pw]
+} -result [list 100 105]
+
+test paned-propagation-2 "Slave change before map" -body {
+    .pw.f1 configure -width 200 -height 100
+    propagate-geometry
+    list [winfo reqwidth .pw] [winfo reqheight .pw]
+} -result [list 200 155]
+
+test paned-propagation-3 "Map window" -body {
+    pack .pw -expand true -fill both
+    update
+    list [winfo width .pw] [winfo height .pw] [.pw sashpos 0]
+} -result [list 200 155 100]
+
+test paned-propagation-4 "Slave change after map, off-axis" -body {
+    .pw.f1 configure -width 100 ;# should be granted
+    propagate-geometry
+    list [winfo reqwidth .pw] [winfo reqheight .pw] [.pw sashpos 0]
+} -result [list 100 155 100]
+
+test paned-propagation-5 "Slave change after map, on-axis" -body {
+    .pw.f1 configure -height 50 ;# should be denied
+    propagate-geometry
+    list [winfo reqwidth .pw] [winfo reqheight .pw] [.pw sashpos 0]
+} -result [list 100 155 100]
+
+test paned-propagation-cleanup "Clean up." -body { destroy .pw }
+
+tcltest::cleanupTests

data/pkgs/tile-0.8.2/tests/progress.test

@@ -0,0 +1,92 @@
+#
+# progress.test,v 1.4 2005/09/12 03:17:48 jenglish Exp
+#
+
+package require Tk
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+lappend auto_path .
+package require tile
+
+
+test progress-1.1 "Setup" -body {
+    ttk::progressbar .pb
+} -result .pb
+
+test progress-1.2 "Linked variable" -body {
+    set PB 50
+    .pb configure -variable PB
+    .pb cget -value
+} -result 50
+
+test progress-1.3 "Change linked variable" -body {
+    set PB 80
+    .pb cget -value
+} -result 80
+
+test progress-1.4 "Set linked variable to bad value" -body {
+    set PB "bogus"
+    .pb instate invalid
+} -result 1 
+
+test progress-1.4.1 "Set linked variable back to a good value" -body {
+    set PB 80
+    .pb instate invalid
+} -result 0
+
+test progress-1.5 "Set -variable to illegal variable" -body {
+    set BAD "bogus"
+    .pb configure -variable BAD
+    .pb instate invalid
+} -result 1
+
+test progress-1.6 "Unset -variable" -body {
+    unset -nocomplain UNSET
+    .pb configure -variable UNSET
+    .pb instate disabled
+} -result 1
+
+test progress-2.0 "step command" -body {
+    .pb configure -variable {}		;# @@@
+    .pb configure -value 5 -maximum 10 -mode determinate
+    .pb step
+    .pb cget -value
+} -result 6.0
+
+test progress-2.1 "step command, with stepamount" -body {
+    .pb step 3
+    .pb cget -value
+} -result 9.0
+
+test progress-2.2 "step wraps at -maximum in determinate mode" -body { 
+    .pb step
+    .pb cget -value
+} -result 0.0
+
+test progress-2.3 "step doesn't wrap in indeterminate mode" -body {
+    .pb configure -value 8 -maximum 10 -mode indeterminate
+    .pb step
+    .pb step
+    .pb step
+    .pb cget -value
+} -result 11.0
+
+test progress-2.4 "step with linked variable" -body {
+    .pb configure -variable PB		;# @@@
+    set PB 5
+    .pb step
+    set PB
+} -result 6.0
+
+test progress-2.5 "error in write trace" -body {
+    trace variable PB w { error "YIPES!" ;# }
+    .pb step
+    set PB		;# NOTREACHED
+} -cleanup { unset PB } -returnCodes 1 -match glob -result "*YIPES!"
+
+test progress-end "Cleanup" -body {
+    destroy .pb
+}
+
+tcltest::cleanupTests

data/pkgs/tile-0.8.2/tests/pwtest.tcl

@@ -0,0 +1,90 @@
+# [20 Mar 2005] - interactive test for Tile panedwindow widget
+
+package require tile
+
+option add *Text.height 10
+option add *Listbox.height 5
+option add *Listbox.width 20
+option add *Panedwindow.opaqueResize 1
+option add *Panedwindow.OpaqueResize 1
+
+bind PWTestListbox <ButtonPress-1> 	{focus %W}
+bind PWTestListbox <KeyPress-t> 	{ %W configure -height 10 }
+bind PWTestListbox <KeyPress-s> 	{ %W configure -height 5 }
+bind PWTestListbox <KeyPress-n> 	{ %W configure -width 20 }
+bind PWTestListbox <KeyPress-w> 	{ %W configure -width 40 }
+
+proc pwtest.listbox {w args} {
+    eval [linsert $args 0 listbox $w]
+    bindtags $w [list $w PWTestListbox [winfo class $w] [winfo toplevel $w] all]
+    return $w
+}
+
+ttk::panedwindow .pw -orient vertical
+#panedwindow .pw -opaqueresize true -orient vertical
+
+#frame .pw
+#proc .pw-add {win} { pack $win -side top -expand false -fill x }
+
+.pw add [ttk::frame .pw.f1] -weight 1;#$ -stretch always
+.pw add [ttk::frame .pw.f2] -weight 1;#$ -stretch always
+.pw add [set w3 [pwtest.listbox .pw.f3]] -weight 1;#$ -stretch always
+.pw add [ttk::frame .pw.f4] -weight 1;#$ -stretch always
+
+pack [set w1 [pwtest.listbox .pw.f1.l]] -expand true -fill both
+pack [set w2 [pwtest.listbox .pw.f2.l]] -expand true -fill both
+#X pack [set w3 [pwtest.listbox .pw.f3.l]] -expand true -fill both
+pack [set w4 [pwtest.listbox .pw.f4.l]] -expand true -fill both
+
+pack [label .l -textvariable ::element] -side bottom -expand false -fill x
+pack .pw -expand true -fill both -side top
+
+bind .pw <Motion> { set ::element "[%W identify %x %y] - %x,%y" }
+
+bind . <KeyPress-Escape> [list destroy .]
+#- bind . <KeyPress-h>	[list .pw configure -orient horizontal]
+#- bind . <KeyPress-v>	[list .pw configure -orient vertical]
+
+bind PWTestListbox <KeyPress-f> [list pwtest.forget .pw %W]
+bind PWTestListbox <KeyPress-r> [list pwtest.remember .pw]
+
+proc pwtest.forget {pw slave} {
+    global $pw
+    $pw forget $slave
+    lappend $pw $slave
+}
+proc pwtest.remember {pw} {
+    global $pw
+    foreach slave [set $pw] {
+	$pw add $slave
+    }
+    set $pw [list]
+}
+
+foreach w [list $w1 $w2 $w3] {
+    foreach string {abc def ghi jkl mno pqr stu vwx yz} {
+    	$w insert end $string
+    }
+}
+
+proc pwtest.save-config {pw} {
+    update idletasks;
+    lappend config [winfo width $pw] [winfo height $pw]
+    set i -1;
+    foreach _ [lrange [$pw panes] 1 end] {
+	lappend config [$pw sashpos [incr i]]
+    }
+    return $config
+}
+
+proc pwtest.restore-config {pw config} {
+    $pw configure -width [lindex $config 0] -height [lindex $config 1]
+    set i -1
+    foreach sashpos [lrange $config 2 end] {
+	$pw sashpos [incr i] $sashpos
+    }
+}
+
+bind all <Control-KeyPress-s> { set ::A [pwtest.save-config .pw] }
+bind all <Control-KeyPress-r> { pwtest.restore-config .pw $::A }
+