1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
# repackanim.tcl ---
#
# An utility to achive sliding toplevel height while swapping two
# notebook pages.
#
# Usage:
# ::repackanim::swap frame1 frame2 ?-command tclProc -text str -widget key?
# -widget typically "ttk::label %s -text Wait..."
#
# Copyright (c) 2007 Mats Bengtsson
#
# This source file is distributed under the BSD license.
#
# $Id: repackanim.tcl,v 1.3 2007-12-22 14:52:22 matben Exp $
package provide repackanim 0.1
namespace eval ::repackanim {
variable options
array set options {
step 4
millis 40
}
}
proc ::repackanim::configure {args} {
variable options
array set options $args
}
proc ::repackanim::swap {wfrom wto args} {
variable options
set w [winfo toplevel $wfrom]
if {$w ne [winfo toplevel $wto]} {
puts stderr "Both widgets must belong to the same toplevel"
}
variable $w
upvar 0 $w state
array set opts {
-command {}
-text "Loading page..."
-widget ""
}
array set opts $args
set state(opts) [array get opts]
set state(w) $w
set state(wfrom) $wfrom
set state(wto) $wto
# Do this in order to get correct sizes.
update idletasks
set h1 [winfo reqheight $wfrom]
set h2 [winfo reqheight $wto]
set delta [expr {$h2 - $h1}]
puts "::repackanim::repack h1=$h1, h2=$h2"
wm positionfrom $w user
set tmp ${wfrom}_tmp
ttk::frame $tmp
if {[string length $opts(-widget)]} {
eval [format $opts(-widget) $tmp.label]
} else {
ttk::label $tmp.label -text $opts(-text)
}
place $tmp.label -x [expr {[winfo width $wfrom]/2}] -y [expr {$h1/2}] -anchor c
pack forget $wfrom
pack $tmp -fill both -expand 1
set state(height) [expr {[winfo height $w] + $delta}]
Animate $w
}
proc ::repackanim::Animate {w} {
variable options
variable $w
upvar 0 $w state
if {![winfo exists $w]} {
unset -nocomplain state
}
set height $state(height)
set geom [split [wm geometry $w] x+-]
set h [lindex $geom 1]
set sign [expr {$h < $height ? "+" : "-"}]
if {$h == $height} {
Final $w
return
}
set step $options(step)
#pack propagate $w 0
if {$sign eq "+"} {
set new [expr {$h + $step}]
if {$new > $height} {
set h $height
} else {
incr h $sign$step
}
} else {
set new [expr {$h - $step}]
if {$new < $height} {
set h $height
} else {
incr h $sign$step
}
}
wm geometry $w [lindex $geom 0]x$h
after $options(millis) [namespace code [list Animate $w]]
}
proc ::repackanim::Final {w} {
variable $w
upvar 0 $w state
puts "::repack::Final"
if {![winfo exists $w]} {
unset -nocomplain state
}
#pack propagate $w 1
destroy $state(wfrom)_tmp
pack $state(wto)
array set opts $state(opts)
if {[llength $opts(-command)]} {
uplevel #0 $opts(-command)
}
unset -nocomplain state
}
# Test code.
if {0} {
proc content {w n} {
ttk::frame $w -padding 20
for {set i 0} {$i < $n} {incr i} {
ttk::label $w.$i -text "Some junk number $i"
grid $w.$i -sticky w
}
return $w
}
set w .top
toplevel $w
set f1 [content $w.f1 10]
set f2 [content $w.f2 20]
pack $f1
after 4000 [list ::repackanim::swap $f1 $f2]
}
|
