Check-in [52c179f31b]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Switched to the (undocumented) megawidget framework that comes with Tk. To reflect the notebook tab subcommand, the accordion pane subcommand has been changed to return a single string or a dict, rather than a list (of lists). Bumped the version to 1.1
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | trunk
Files: files | file ages | folders
SHA1:52c179f31bd407e26c4908cebe3043e29b8914b6
User & Date: schelte 2014-07-13 12:47:28
Context
2014-07-13
12:47
Switched to the (undocumented) megawidget framework that comes with Tk. To reflect the notebook tab subcommand, the accordion pane subcommand has been changed to return a single string or a dict, rather than a list (of lists). Bumped the version to 1.1 Leaf check-in: 52c179f31b user: schelte tags: trunk
2014-07-12
21:52
Implement a few features that were already described in the man page: - The "current" pane identifier. - The insert method moves a pane if it was already managed by the accordion. Bugfix: inserting a pane before the active pane resulted in wrong display. check-in: 421fab7984 user: schelte tags: trunk
Changes

Deleted accordion-1.0.tm.

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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
# Accordion widget

namespace eval tk::accordion {

    # Switch-like command that will look for a partial match and produce an 
    # appropriate error when there is not exactly one match
    #
    proc cfgopt {what opt body} {
	# Check for an exact match first
	if {![dict exists $body $opt]} {
	    # Find all prefix matches -- assume no glob chars in the option
	    set list [lsearch -all -inline [dict keys $body] $opt*]
	    if {[llength $list] == 1} {
		# Exactly one prefix match
		set opt [lindex $list 0]
	    } else {
		# No unambiguous match found -- produce an error message
		set list [lsort -dictionary [dict keys $body]]
		if {[llength $list] > 1} {
		    lset list end "or [lindex $list end]"
		}
		set msg [format {unknown or ambiguous %s "%s": must be %s} \
		  $what $opt [join $list {, }]]
		set code [list TCL LOOKUP INDEX $what $opt]
		return -level 3 -code error -errorcode $code $msg
	    }
	}
	uplevel 1 [list switch -- $opt $body]
    }

    # Create an oo class for the widget implementation to easily keep track
    # of multiple widgets
    #
    oo::class create widget {
	constructor {opts} {
	    namespace path [linsert [namespace path] end ::tk::accordion]
	    # Extract the widget name from the object name
	    variable name [namespace tail [self object]]
	    # Initialize some other variables
	    variable row 0 panes {} speed 10 coroid "" coro ""
	    # Pass the initial options on to the cset method
	    my cset {*}$opts
	    # The widget should not resize based on its content
	    grid propagate $name 0
	    # All panes fill the available horizontal space
	    grid columnconfigure $name 0 -weight 1
	    # The first pane is initially open, once it will be created
	    grid rowconfigure $name 0 -weight 1000
	}

	method frame {num} {
	    my variable name
	    return $name.__$num
	}

	method configure {args} {
	    my variable name
	    set argc [llength $args]
	    if {$argc == 0} {
		# Return all configuration settings
		set args {-height -speed -width}
	    } elseif {$argc > 1} {
		# Set configuration
		tailcall my cset {*}$args
	    }
	    foreach opt $args {
		cfgopt option $opt {
		    -width - -height {
			lappend rc [$name configure $opt]
		    }
		    -speed {
			my variable speed
			lappend rc [list -speed speed Speed 10 $speed]
		    }
		}
	    }
	    # When a specific setting was requested, don't return it as a list
	    if {$argc == 1} {
		return [lindex $rc 0]
	    } else {
		return $rc
	    }
	}

	method cset {args} {
	    my variable name
	    # Need an even number of arguments
	    if {[llength $args] % 2 == 1} {
		set msg [format {value for "%s" missing} [lindex $args end]]
		return -code error -errorcode {TK VALUE_MISSING} $msg
	    }
	    # Set the options
	    foreach {opt val} $args {
		cfgopt option $opt {
		    -width - -height {
			$name configure $opt $val
		    }
		    -speed {
			variable speed $val
		    }
		}
	    }
	}

	method cget {option} {
	    return [lindex [my configure $option] 4]
	}

	method index {paneid} {
	    my variable panes row
	    # Integer paneid's are straight-forward
	    if {[string is integer -strict $paneid]} {
		# No conversion needed
		set pos $paneid
	    } elseif {$paneid in {end last}} {
		set pos [llength $panes]
	    } elseif {$paneid eq "current"} {
		set pos $row
	    } else {
		# Position of the named pane
		set pos [lsearch -exact $panes $paneid]
	    }
	    if {$pos < 0 || $pos > [llength $panes]} {
		return -code error -errorcode {TK BAD_VALUE} \
		  [format {invalid pane "%s"} $paneid]
	    }
	    return $pos
	}

	method add {w args} {
	    # Add is just an alias for inserting a pane at the end
	    tailcall my insert end $w {*}$args
	}

	method insert {pos win args} {
	    my variable name panes row coro
	    # Translate pos to an integer, if necessary
	    if {[catch {my index $pos} pos info]} {
		# Rethrow the error to get a clean stack trace
		return -code error -errorcode [dict get $info -errorcode] $pos
	    }
	    # Check that an even number of args was provided
	    if {[llength $args] % 2 == 1} {
		set msg [format {value for "%s" missing} [lindex $args end]]
		return -code error -errorcode {TK VALUE_MISSING} $msg
	    }

	    # We can't handle adding panes while an animation is playing
	    if {$coro ne ""} {rename $coro ""}

	    # If win is already managed by the accordion, delete the old pane
	    set old [lsearch -exact $panes $win]
	    if {$old >= 0} {
		my forget $old
		if {$old < $pos} {incr pos -1}
	    }

	    # Add a new pane (containing a button and a frame) at the end
	    set num [llength $panes]
	    set f [frame [my frame $num]]
	    set callback [list [namespace which my] select $num]
	    set b [ttk::button $f.button -command $callback]
	    set a [frame $f.frame]
	    grid $b -in $f -sticky ew
	    grid $a -in $f -sticky snew
	    grid columnconfigure $f $b -weight 1
	    grid rowconfigure $f $a -weight 1
	    grid $f -in $name -sticky snew -row $num
	    grid remove $a
	    # Insert the new pane in the list of panes
	    set panes [linsert $panes $pos $win]
	    # Shift existing panes after the new one down
	    for {set i $num} {$i > $pos} {} {
		set w [lindex $panes $i]
		set f1 [my frame $i]
		set f2 [my frame [incr i -1]]
		$f1.button configure -text [$f2.button cget -text]
		raise $w $f1
	    }
	    puts "row=$row, pos=$pos, num=$num"
	    if {$num == 0} {
		# This is the first pane, open it
		grid $a
		place $win -in $a -relwidth 1 -relheight 1
	    } elseif {$row >= $pos} {
	    	# Shift down the opened pane
		my open [expr {$row + 1}]
	    }
	    # Make sure the helper frames don't obscure their contents
	    raise $win [my frame $pos]
	    # Apply any additional configuration settings
	    if {[llength $args] > 0} {
		tailcall my pane $pos {*}$args
	    }
	    return
	}

	method pane {pos args} {
	    if {[catch {my frame [my index $pos]} f info]} {
		# Rethrow the error to get a clean stack trace
		return -code error -errorcode [dict get $info -errorcode] $f
	    }
	    set argc [llength $args]
	    if {$argc == 0} {
		set args {-compound -image -text -textvariable -underline}
	    } elseif {$argc % 2 == 0} {
		foreach {opt val} $args {
		    cfgopt option $opt {
			-compound - -image - -text - -textvariable -
			-underline {
			    $f.button configure $opt $val
			}
		    }
		}
		return
	    } elseif {$argc > 1} {
		set msg [format {value for "%s" missing} [lindex $args end]]
		return -code error -errorcode {TK VALUE_MISSING} $msg
	    }
	    foreach {opt val} $args {
		cfgopt option $opt {
		    -compound - -image - -text - -textvariable - -underline {
			lappend rc [$f.button configure $opt]
		    }
		}
	    }
	    # When a specific setting was requested, don't return it as a list
	    if {$argc == 1} {
		return [lindex $rc 0]
	    } else {
		return $rc
	    }
	}

	method select {{id ""}} {
	    my variable row panes
	    if {$id eq ""} {
		return [lindex $panes $row]
	    }

	    # Use a coroutine for the animation
	    coroutine coro my slide $id
	}

	method slide {id} {
	    my variable row name panes speed

	    # Check if the requested pane isn't already selected
	    set new [my index $id]
	    if {$new == $row} return

	    variable coro [info coroutine]
	    # Always switch to the new row when the coroutine terminates, in
	    # whatever way (run to completion, error, redefined).
	    trace add command $coro delete [list [namespace which my] open $new]

	    # Determine the final height of the new pane (same as the current)
	    set height [winfo height [lindex $panes $row]]

	    # Prepare the new frame
	    set f [my frame $new]
	    set w [lindex $panes $new]
	    grid $f.frame
	    place $w -in $f.frame -relwidth 1 -height $height -relheight 0

	    # Switch the old pane from relative- to absolute height to
	    # prevent continuous resizing during the slide animation
	    set f [my frame $row]
	    set w [lindex $panes $row]
	    place $w -in $f.frame -relwidth 1 -height $height -relheight 0

	    # Calculate a stepsize based on the configured speed setting and
	    # the distance to travel
	    set incr [expr {max($speed * 4000 / $height, 1)}]

	    # Manipulate the weight of the two rows involved to produce the
	    # animation effect
	    while {[incr step $incr] < 1000} {
		grid rowconfigure $name $row -weight [expr {1000 - $step}]
		grid rowconfigure $name $new -weight $step
		variable coroid [after 25 $coro]
		yield
	    }
	    # The command trace will take care of completing the row change
	}

	method forget {id} {
	    my variable panes row coro
	    if {[catch {my index $id} pos info]} {
		# Rethrow the error to get a clean stack trace
		return -code error -errorcode [dict get $info -errorcode] $pos
	    }

	    # We can't handle deleting panes while an animation is playing
	    if {$coro ne ""} {rename $coro ""}

	    # Unmap the contents of the pane that will be deleted
	    place forget [lindex $panes $pos]
	    # Remove the pane from the list of panes
	    set panes [lreplace $panes $pos $pos]
	    # Shift existing panes after the new one up
	    set num [llength $panes]
	    for {set i $pos} {$i < $num} {} {
		set w [lindex $panes $i]
		set f1 [my frame $i]
		set f2 [my frame [incr i]]
		$f1.button configure -text [$f2.button cget -text]
		raise $w $f1
	    }
	    # Delete the last helper frame
	    destroy [my frame $num]
	    # Make sure the correct pane is shown
	    if {$row > $pos || $row == $num && $row != 0} {
		my open [expr {$row - 1}]
	    } else {
		my open $row
	    }
	    return
	}

	method panes {} {
	    my variable panes
	    return $panes
	}

	method open {num args} {
	    my variable row panes name coroid

	    # Kill any pending attempts to resume the coroutine
	    after cancel $coroid
	    variable coro ""

	    if {$num != $row} {
		# Close the currently opened row
		if {$row < [llength $panes]} {
		    set f [my frame $row]
		    grid remove $f.frame
		}
		grid rowconfigure $name $row -weight 0
	    }
	    if {$num < [llength $panes]} {
		# (Re-)Open the new row
		set f [my frame $num]
		grid $f.frame
		set w [lindex $panes $num]
		place $w -in $f.frame -relwidth 1 -relheight 1 -height 0
		# Keep the contents just above their helper frame
		raise $w $f
	    }
	    grid rowconfigure $name $num -weight 1000
	    set row $num
	}

	# Make the internal methods private
	unexport cset destroy frame open slide
    }
}

proc accordion {w args} {
    # We can't create the outer frame inside the object constructor because
    # the widget's command proc gets the same name as the object, which
    # destroys the object 
    frame $w -class Accordion
    # Move the command proc into a namespace where the oo methods can find it
    rename $w ::tk::accordion::$w
    # Create an object of the accordion::widget class
    if {[catch {::tk::accordion::widget create $w $args} result info]} {
	# Clean up the frame
	destroy $w
	# Rethrow the error to get a clean stack trace
	return -code error -errorcode [dict get $info -errorcode] $result
    }
    # Return the widget name
    return $w
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














































































































































































































































































































































































































































































































































































































































































































































































Added accordion-1.1.tm.









































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
# Accordion widget

::tk::Megawidget create ::tk::accordion {} {
    variable w hull options

    method GetSpecs {} {
	return {
	    {-height height Height 0}
	    {-speed speed Speed 10}
	    {-width width Width 0}
	}
    }

    method CreateHull {} {
	# Create the hull widget
	set hull [::tk::frame $w \
	  -width $options(-width) -height $options(-height)]
    }

    method Create {} {
	# Initialize some variables
	variable row 0 panes {} coroid "" coro ""
	# The widget should not resize based on its content
	grid propagate $w 0
	# All panes fill the available horizontal space
	grid columnconfigure $w 0 -weight 1
	# The first pane is initially open, once it will be created
	grid rowconfigure $w 0 -weight 1000
    }

    method GetConfig {} {
	foreach spec [my GetSpecs] {
	    set opt [lindex $spec 0]
	    lappend rc [lset spec 4 $options($opt)]
	}
	return $rc
    }

    method frame {num} {
	return $w.__$num
    }

    method configure {args} {
	set argc [llength $args]
	if {$argc == 0 && [array size options] > 0} {
	    tailcall my GetConfig
	} elseif {$argc == 1} {
	    set opt [lindex $args 0]
	    set spec [lsearch -inline -index 0 -exact [my GetSpecs] $opt]
	    if {[llength $spec] > 0} {
		return [lset spec 4 $options($opt)]
	    } else {
		return -code error -errorcode [list TK LOOKUP OPTION $opt] \
		  "bad option \"$opt\": must be [tclListValidFlags options]"
	    }
	}
	if {[catch {next {*}$args} ret info]} {
	    # Rethrow the error to get a clean stack trace
	    return -code error -errorcode [dict get $info -errorcode] $ret
	}
	if {[info exists hull]} {
	    set dict [dict filter $args script {key -} {
		expr {$key in {-width -height}}
	    }]
	    if {[dict size $dict] > 0} {
		theFrame configure {*}$dict
	    }
	}
    }

    method index {paneid} {
	my variable panes row
	# Integer paneid's are straight-forward
	if {[string is integer -strict $paneid]} {
	    # No conversion needed
	    set pos $paneid
	} elseif {$paneid in {end last}} {
	    set pos [llength $panes]
	} elseif {$paneid eq "current"} {
	    set pos $row
	} else {
	    # Position of the named pane
	    set pos [lsearch -exact $panes $paneid]
	}
	if {$pos < 0 || $pos > [llength $panes]} {
	    return -code error -errorcode {TK BAD_VALUE} \
	      [format {invalid pane "%s"} $paneid]
	}
	return $pos
    }

    method add {win args} {
	# Add is just an alias for inserting a pane at the end
	tailcall my insert end $win {*}$args
    }

    method insert {pos win args} {
	my variable panes row coro
	# Translate pos to an integer, if necessary
	if {[catch {my index $pos} pos info]} {
	    # Rethrow the error to get a clean stack trace
	    return -code error -errorcode [dict get $info -errorcode] $pos
	}
	# Check that an even number of args was provided
	if {[llength $args] % 2 == 1} {
	    set msg [format {value for "%s" missing} [lindex $args end]]
	    return -code error -errorcode {TK VALUE_MISSING} $msg
	}
	
	# We can't handle adding panes while an animation is playing
	if {$coro ne ""} {rename $coro ""}

	# If win is already managed by the accordion, delete the old pane
	set old [lsearch -exact $panes $win]
	if {$old >= 0} {
	    my forget $old
	    if {$old < $pos} {incr pos -1}
	}

	# Add a new pane (containing a button and a frame) at the end
	set num [llength $panes]
	set f [frame [my frame $num]]
	set callback [list [namespace which my] select $num]
	set b [ttk::button $f.button -command $callback]
	set a [frame $f.frame]
	grid $b -in $f -sticky ew
	grid $a -in $f -sticky snew
	grid columnconfigure $f $b -weight 1
	grid rowconfigure $f $a -weight 1
	grid $f -in $w -sticky snew -row $num
	grid remove $a
	# Insert the new pane in the list of panes
	set panes [linsert $panes $pos $win]
	# Shift existing panes after the new one down
	for {set i $num} {$i > $pos} {} {
	    set p [lindex $panes $i]
	    set f1 [my frame $i]
	    set f2 [my frame [incr i -1]]
	    $f1.button configure -text [$f2.button cget -text]
	    raise $p $f1
	}
	if {$num == 0} {
	    # This is the first pane, open it
	    grid $a
	    place $win -in $a -relwidth 1 -relheight 1
	} elseif {$row >= $pos} {
	    # Shift down the opened pane
	    my open [expr {$row + 1}]
	}
	# Make sure the helper frames don't obscure their contents
	raise $win [my frame $pos]
	# Apply any additional configuration settings
	if {[llength $args] > 0} {
	    tailcall my pane $pos {*}$args
	}
	return
    }

    method pane {pos args} {
	my variable paneopts
	if {[catch {my frame [my index $pos]} f info]} {
	    # Rethrow the error to get a clean stack trace
	    return -code error -errorcode [dict get $info -errorcode] $f
	}
	set paneopts {-compound -image -text -textvariable -underline}
	set argc [llength $args]
	if {$argc == 0} {
	    foreach opt $paneopts {lappend rc $opt [$f.button cget $opt]}
	    return $rc
	} elseif {$argc == 1} {
	    set opt [lindex $args 0]
	    if {$opt in $paneopts} {return [$f.button cget $opt]}
	    # Fall through to error message
	} elseif {$argc % 2 == 1} {
	    set opt [lindex $args end]
	    if {$opt in $paneopts} {
		return -code error -errorcode {TK VALUE_MISSING} \
		  set msg [format {value for "%s" missing} $opt]
	    }
	    # Fall through to error message
	} else {
	    set opt [apply {
		{w valid opts} {
		    foreach {opt val} $opts {
			if {$opt ni $valid} {return $opt}
			$w configure $opt $val
		    }
		}
	    } $f.button $paneopts $args]
	    if {$opt eq ""} return
	    # Fall through to error message
	}

	set valid [lreplace $paneopts end end "or [lindex $paneopts end]"]
	return -code error -errorcode [list TK LOOKUP OPTION $opt] \
	  "bad option \"$opt\": must be [join $valid {, }]"
    }

    method select {{id ""}} {
	my variable row panes
	if {$id eq ""} {
	    return [lindex $panes $row]
	}

	# Use a coroutine for the animation
	coroutine coro my slide $id
    }

    method slide {id} {
	my variable row panes

	# Check if the requested pane isn't already selected
	set new [my index $id]
	if {$new == $row} return

	variable coro [info coroutine]
	# Always switch to the new row when the coroutine terminates, in
	# whatever way (run to completion, error, redefined).
	trace add command $coro delete [list [namespace which my] open $new]

	# Determine the final height of the new pane (same as the current)
	set height [winfo height [lindex $panes $row]]

	# Prepare the new frame
	set f [my frame $new]
	set p [lindex $panes $new]
	grid $f.frame
	place $p -in $f.frame -relwidth 1 -height $height -relheight 0

	# Switch the old pane from relative- to absolute height to
	# prevent continuous resizing during the slide animation
	set f [my frame $row]
	set p [lindex $panes $row]
	place $p -in $f.frame -relwidth 1 -height $height -relheight 0

	# Calculate a stepsize based on the configured speed setting and
	# the distance to travel
	set incr [expr {max($options(-speed) * 4000 / $height, 1)}]

	# Manipulate the weight of the two rows involved to produce the
	# animation effect
	while {[incr step $incr] < 1000} {
	    grid rowconfigure $w $row -weight [expr {1000 - $step}]
	    grid rowconfigure $w $new -weight $step
	    variable coroid [after 25 $coro]
	    yield
	}
	# The command trace will take care of completing the row change
    }

    method forget {id} {
	my variable panes row coro
	if {[catch {my index $id} pos info]} {
	    # Rethrow the error to get a clean stack trace
	    return -code error -errorcode [dict get $info -errorcode] $pos
	}

	# We can't handle deleting panes while an animation is playing
	if {$coro ne ""} {rename $coro ""}

	# Unmap the contents of the pane that will be deleted
	place forget [lindex $panes $pos]
	# Remove the pane from the list of panes
	set panes [lreplace $panes $pos $pos]
	# Shift existing panes after the new one up
	set num [llength $panes]
	for {set i $pos} {$i < $num} {} {
	    set p [lindex $panes $i]
	    set f1 [my frame $i]
	    set f2 [my frame [incr i]]
	    $f1.button configure -text [$f2.button cget -text]
	    raise $p $f1
	}
	# Delete the last helper frame
	destroy [my frame $num]
	# Make sure the correct pane is shown
	if {$row > $pos || $row == $num && $row != 0} {
	    my open [expr {$row - 1}]
	} else {
	    my open $row
	}
	return
    }

    method panes {} {
	my variable panes
	return $panes
    }

    method open {num args} {
	my variable row panes coroid

	# Kill any pending attempts to resume the coroutine
	after cancel $coroid
	variable coro ""

	if {$num != $row} {
	    # Close the currently opened row
	    if {$row < [llength $panes]} {
		set f [my frame $row]
		grid remove $f.frame
	    }
	    grid rowconfigure $w $row -weight 0
	}
	if {$num < [llength $panes]} {
	    # (Re-)Open the new row
	    set f [my frame $num]
	    grid $f.frame
	    set p [lindex $panes $num]
	    place $p -in $f.frame -relwidth 1 -relheight 1 -height 0
	    # Keep the contents just above their helper frame
	    raise $p $f
	}
	grid rowconfigure $w $num -weight 1000
	set row $num
    }

    # Make the internal methods private
    unexport cset destroy frame open slide
}

# Make the accordion command available in the global namespace
namespace eval tk {namespace export accordion}
namespace import tk::accordion