Context Navigation

pager.tcl @ 4691

Last change on this file since 4691 was 3642, checked in by mmc, 11 years ago

Fixes for nanoHUB ticket #258058 and #258045 -- note within a group tab
doesn't fill out the area properly. Should work better now. Also fixed
tabs to contain the window, instead of floating above the cotents as they
have for a long time.

Fixed boolean controls to have a more obvious on/off switch instead of a
checkbox. Fixed integers and spinners to use larger +/- buttons that are
easier to press on an iPad. Fixed numbers and other gauges to have the
same relief style as entries and other widgets.

Added new layout styles to groups: horizontal, vertical, tabs, and sentence.
You can now explicitly make a layout vertical instead of tabs by setting
the layout to "vertical" instead of throwing in a separator. Updated the
zoo/groups example to show off new horizontal and sentence types.

Fixed the "drawing" example in the zoo to gray out the trapezoid top when
it is disabled.

File size: 23.5 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: pager - notebook for displaying pages of widgets
4	#
5	# This widget is something like a tabbed notebook, but with a little
6	# more flexibility. Pages can be inserted and deleted, and then shown
7	# in various arrangements.
8	# ======================================================================
9	# AUTHOR: Michael McLennan, Purdue University
10	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
11	#
12	# See the file "license.terms" for information on usage and
13	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14	# ======================================================================
15	package require Itk
16	package require BLT
17
18	option add *Pager.arrangement "pages" widgetDefault
19	option add *Pager.width 0 widgetDefault
20	option add *Pager.height 0 widgetDefault
21	option add *Pager.padding 8 widgetDefault
22	option add *Pager.crumbColor black widgetDefault
23	option add *Pager.crumbNumberColor white widgetDefault
24	option add *Pager.dimCrumbColor gray70 widgetDefault
25	option add *Pager.activeCrumbColor blue widgetDefault
26	option add *Pager.crumbFont \
27	--helvetica-bold-r-normal--12-* widgetDefault
28
29	blt::bitmap define Pager-arrow {
30	#define arrow_width 9
31	#define arrow_height 9
32	static unsigned char arrow_bits[] = {
33	0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xff, 0x00, 0xff, 0x01, 0xff, 0x00,
34	0x70, 0x00, 0x30, 0x00, 0x10, 0x00};
35	}
36
37	itcl::class Rappture::Pager {
38	inherit itk::Widget
39
40	itk_option define -width width Width 0
41	itk_option define -height height Height 0
42	itk_option define -padding padding Padding 0
43	itk_option define -crumbcolor crumbColor Foreground ""
44	itk_option define -crumbnumbercolor crumbNumberColor Foreground ""
45	itk_option define -crumbfont crumbFont Font ""
46	itk_option define -dimcrumbcolor dimCrumbColor DimForeground ""
47	itk_option define -activecrumbcolor activeCrumbColor ActiveForeground ""
48	itk_option define -arrangement arrangement Arrangement ""
49
50	constructor {args} { # defined below }
51
52	public method insert {pos args}
53	public method delete {first {last ""}}
54	public method index {name}
55	public method page {args}
56	public method current {args}
57
58	public method busy { bool }
59
60	protected method _layout {}
61	protected method _fixSize {}
62	protected method _drawCrumbs {how}
63
64	private variable _counter 0 ;# counter for page names
65	private variable _dispatcher "" ;# dispatcher for !events
66	private variable _pages "" ;# list of known pages
67	private variable _page2info ;# maps page name => -frame,-title,-command
68	private variable _current "" ;# page currently shown
69	}
70
71	itk::usual Pager {
72	}
73
74	# ----------------------------------------------------------------------
75	# CONSTRUCTOR
76	# ----------------------------------------------------------------------
77	itcl::body Rappture::Pager::constructor {args} {
78	Rappture::dispatcher _dispatcher
79	$_dispatcher register !layout
80	$_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
81	$_dispatcher register !fixsize
82	$_dispatcher dispatch $this !fixsize "[itcl::code $this _fixSize]; list"
83
84	itk_component add controls {
85	frame $itk_interior.cntls
86	}
87
88	itk_component add next {
89	button $itk_component(controls).next -text "Next >" \
90	-command [itcl::code $this current next>]
91	}
92	pack $itk_component(next) -side right
93
94	itk_component add back {
95	button $itk_component(controls).back -text "< Back" \
96	-command [itcl::code $this current <back]
97	}
98	pack $itk_component(back) -side left
99
100	set font [$itk_component(next) cget -font]
101	set ht [font metrics $font -linespace]
102	itk_component add breadcrumbarea {
103	frame $itk_interior.bcarea
104	}
105	itk_component add breadcrumbs {
106	canvas $itk_component(breadcrumbarea).breadcrumbs \
107	-width 10 -height [expr {$ht+2}]
108	}
109	pack $itk_component(breadcrumbs) -side left -expand yes -fill both \
110	-padx 8 -pady 8
111
112	itk_component add line {
113	frame $itk_interior.line -height 2 -borderwidth 1 -relief sunken
114	}
115
116
117	itk_component add inside {
118	frame $itk_interior.inside
119	}
120	pack $itk_component(inside) -expand yes -fill both
121	pack propagate $itk_component(inside) no
122
123	eval itk_initialize $args
124	$_dispatcher event -idle !layout
125	}
126
127	# ----------------------------------------------------------------------
128	# USAGE: insert <pos> ?-name <name>? ?-title <label>? ?-command <str>?
129	#
130	# Clients use this to insert a new page into this pager. The page is
131	# inserted into the list at position <pos>, which can be an integer
132	# starting from 0 or the keyword "end". The optional <name> can be
133	# used to identify the page. If it is not supplied, a name is created
134	# for the page. The -title and -command are other values associated
135	# with the page.
136	#
137	# Returns the name used to identify the page.
138	# ----------------------------------------------------------------------
139	itcl::body Rappture::Pager::insert {pos args} {
140	if {"end" == $pos} {
141	set pos [llength $_pages]
142	} elseif {![string is integer $pos]} {
143	error "bad index \"$pos\": should be integer or \"end\""
144	}
145
146	Rappture::getopts args params {
147	value -name page#auto
148	value -title "Page #auto"
149	value -command ""
150	}
151	if {[llength $args] > 0} {
152	error "wrong # args: should be \"insert pos ?-name n? ?-title t? ?-command c?\""
153	}
154
155	incr _counter
156	if {$_counter > 1} {
157	set subst "#$_counter"
158	} else {
159	set subst ""
160	}
161	if {[regexp {#auto} $params(-name)]} {
162	regsub -all {#auto} $params(-name) $subst params(-name)
163	}
164	if {[regexp {#auto} $params(-title)]} {
165	regsub -all {#auto} $params(-title) $subst params(-title)
166	}
167
168	# allocate the page
169	if {[info exists _page2info($params(-name)-frame)]} {
170	error "page \"$params(-name)\" already exists"
171	}
172	set win $itk_component(inside).page$_counter
173	frame $win
174	set _page2info($params(-name)-frame) $win
175	set _page2info($params(-name)-title) $params(-title)
176	set _page2info($params(-name)-command) $params(-command)
177	set _pages [linsert $_pages $pos $params(-name)]
178
179	bind $win <Configure> \
180	[itcl::code $_dispatcher event -idle !fixsize]
181
182	# the number of pages affects the arrangment -- force an update
183	configure -arrangement $itk_option(-arrangement)
184
185	$_dispatcher event -idle !layout
186
187	return $params(-name)
188	}
189
190	# ----------------------------------------------------------------------
191	# USAGE: delete <first> ?<last>?
192	#
193	# Clients use this to delete one or more pages from this widget.
194	# The <first> and <last> represent the integer index of the desired
195	# page. You can use the "index" method to convert a page name to
196	# its integer index. If only <first> is specified, then that one
197	# page is deleted. If <last> is specified, then all pages in the
198	# range <first> to <last> are deleted.
199	# ----------------------------------------------------------------------
200	itcl::body Rappture::Pager::delete {first {last ""}} {
201	if {$last == ""} {
202	set last $first
203	}
204	if {![regexp {^[0-9]+\|end$} $first]} {
205	error "bad index \"$first\": should be integer or \"end\""
206	}
207	if {![regexp {^[0-9]+\|end$} $last]} {
208	error "bad index \"$last\": should be integer or \"end\""
209	}
210
211	foreach name [lrange $_pages $first $last] {
212	if {[info exists _page2info($name-frame)]} {
213	destroy $_page2info($name-frame)
214	unset _page2info($name-frame)
215	unset _page2info($name-title)
216	unset _page2info($name-command)
217	}
218	}
219	set _pages [lreplace $_pages $first $last]
220
221	# the number of pages affects the arrangment -- force an update
222	configure -arrangement $itk_option(-arrangement)
223
224	$_dispatcher event -idle !layout
225	}
226
227	# ----------------------------------------------------------------------
228	# USAGE: index <name>\|@n
229	#
230	# Clients use this to convert a page <name> into its corresponding
231	# integer index. Returns an error if the <name> is not recognized.
232	# ----------------------------------------------------------------------
233	itcl::body Rappture::Pager::index {name} {
234	set i [lsearch $_pages $name]
235	if {$i >= 0} {
236	return $i
237	}
238	if {[regexp {^@([0-9]+)$} $name match i]} {
239	return $i
240	}
241	error "bad page name \"$name\": should be @int or one of [join [lsort $_pages] {, }]"
242	}
243
244	# ----------------------------------------------------------------------
245	# USAGE: page
246	# USAGE: page <name>\|@n ?-frame\|-title\|-command? ?<newvalue>?
247	#
248	# Clients use this to get information about pages. With no args, it
249	# returns a list of all page names. Otherwise, it returns the
250	# requested information for a page specified by its <name> or index
251	# @n. By default, it returns the -frame for the page, but it can
252	# also return the -title and -command. The -title and -command
253	# can also be set to a <newvalue>.
254	# ----------------------------------------------------------------------
255	itcl::body Rappture::Pager::page {args} {
256	if {[llength $args] == 0} {
257	return $_pages
258	}
259	set i [index [lindex $args 0]]
260	set name [lindex $_pages $i]
261
262	set args [lrange $args 1 end]
263	Rappture::getopts args params {
264	flag what -frame default
265	flag what -title
266	flag what -command
267	}
268
269	if {[llength $args] == 0} {
270	set opt $params(what)
271	return $_page2info($name$opt)
272	} elseif {[llength $args] == 1} {
273	set val [lindex $args 0]
274	if {$params(-title)} {
275	set _page2info($name-title) $val
276	} elseif {$params(-command)} {
277	set _page2info($name-command) $val
278	}
279	} else {
280	error "wrong # args: should be \"page ?which? ?-frame\|-title\|-command? ?newvalue?\""
281	}
282	}
283
284	# ----------------------------------------------------------------------
285	# USAGE: current ?<name>\|next>\|<back?
286	#
287	# Used to query/set the current page in the notebook. With no args,
288	# it returns the name of the current page. Otherwise, it sets the
289	# current page. The special token "next>" is used to set the pager
290	# to the next logical page, and "<back" sets to the previous.
291	# ----------------------------------------------------------------------
292	itcl::body Rappture::Pager::current {args} {
293	switch -- [llength $args] {
294	0 {
295	return $_current
296	}
297	1 {
298	if {$itk_option(-arrangement) != "pages"} {
299	return ""
300	}
301	set name [lindex $args 0]
302	set index 0
303	if {$name == "next>"} {
304	if {$_current == ""} {
305	set index 0
306	} else {
307	set i [lsearch -exact $_pages $_current]
308	set index [expr {$i+1}]
309	if {$index >= [llength $_pages]} {
310	set index [expr {[llength $_pages]-1}]
311	}
312	}
313	set _current [lindex $_pages $index]
314	} elseif {$name == "<back"} {
315	if {$_current == ""} {
316	set index end
317	} else {
318	set i [lsearch -exact $_pages $_current]
319	set index [expr {$i-1}]
320	if {$index < 0} {
321	set index 0
322	}
323	}
324	set _current [lindex $_pages $index]
325	} else {
326	if {$name == ""} {
327	set _current ""
328	set index 0
329	} else {
330	set index [lsearch -exact $_pages $name]
331	if {$index < 0} {
332	error "can't move to page \"$name\""
333	}
334	set _current [lindex $_pages $index]
335	}
336	}
337
338	foreach w [pack slaves $itk_component(inside)] {
339	pack forget $w
340	}
341	if {$_current != ""} {
342	pack $_page2info($_current-frame) -expand yes -fill both \
343	-padx $itk_option(-padding) -pady $itk_option(-padding)
344	}
345
346	if {$index == 0} {
347	pack forget $itk_component(back)
348	} else {
349	set prev [expr {$index-1}]
350	if {$prev >= 0} {
351	set label "< [page @$prev -title]"
352	} else {
353	set label "< Back"
354	}
355	$itk_component(back) configure -text $label
356	pack $itk_component(back) -side left
357	}
358	if {$index == [expr {[llength $_pages]-1}]} {
359	pack forget $itk_component(next)
360	} else {
361	set next [expr {$index+1}]
362	if {$next <= [llength $_pages]} {
363	set label "[page @$next -title] >"
364	} else {
365	set label "Next >"
366	}
367	$itk_component(next) configure -text $label
368	pack $itk_component(next) -side right
369	}
370	_drawCrumbs current
371
372	#
373	# If this new page has a command associated with it, then
374	# invoke it now.
375	#
376	if {"" != $_current
377	&& [string length $_page2info($_current-command)] > 0} {
378	uplevel #0 $_page2info($_current-command)
379	}
380	}
381	default {
382	error "wrong # args: should be \"current name\|next>\|<back\""
383	}
384	}
385	}
386
387	# ----------------------------------------------------------------------
388	# USAGE: _layout
389	#
390	# Used internally to fix the current page management whenever pages
391	# are added or deleted, or when the page arrangement changes.
392	# ----------------------------------------------------------------------
393	itcl::body Rappture::Pager::_layout {} {
394	if {$itk_option(-arrangement) == "pages"} {
395	if {$_current == ""} {
396	set _current [lindex $_pages 0]
397	if {$_current != ""} {
398	current $_current
399	}
400	}
401	_drawCrumbs all
402	}
403	}
404
405	# ----------------------------------------------------------------------
406	# USAGE: _fixSize
407	#
408	# Invoked automatically whenever a page changes size or the -width
409	# or -height options change. When the -width/-height are zero, this
410	# method computes the minimum size needed to accommodate all pages.
411	# Otherwise, it passes the size request onto the hull.
412	# ----------------------------------------------------------------------
413	itcl::body Rappture::Pager::_fixSize {} {
414	set sw [expr {[winfo screenwidth $itk_component(hull)]-200}]
415	set sh [expr {[winfo screenheight $itk_component(hull)]-200}]
416
417	update ;# force layout changes so sizes are correct
418	switch -- $itk_option(-arrangement) {
419	pages {
420	if {$itk_option(-width) <= 0} {
421	set maxw [expr {
422	[winfo reqwidth $itk_component(next)]
423	+ 10
424	+ [winfo reqwidth $itk_component(back)]}]
425
426	foreach name $_pages {
427	set w [winfo reqwidth $_page2info($name-frame)]
428	if {$w > $maxw} { set maxw $w }
429	}
430	set maxw [expr {$maxw + 2*$itk_option(-padding)}]
431	if {$maxw > $sw} { set maxw $sw }
432	$itk_component(inside) configure -width $maxw
433	} else {
434	$itk_component(inside) configure -width $itk_option(-width)
435	}
436
437	if {$itk_option(-height) <= 0} {
438	set maxh 0
439	foreach name $_pages {
440	set h [winfo reqheight $_page2info($name-frame)]
441	if {$h > $maxh} { set maxh $h }
442	}
443	set maxh [expr {$maxh + 2*$itk_option(-padding)}]
444	if {$maxh > $sh} { set maxh $sh }
445	$itk_component(inside) configure -height $maxh
446	} else {
447	$itk_component(inside) configure -height $itk_option(-height)
448	}
449	}
450	side-by-side {
451	if {$itk_option(-width) <= 0} {
452	set maxw [expr {
453	[winfo reqwidth $itk_component(next)]
454	+ 10
455	+ [winfo reqwidth $itk_component(back)]}]
456
457	set wtotal 0
458	foreach name $_pages {
459	set w [winfo reqwidth $_page2info($name-frame)]
460	set wtotal [expr {$wtotal + $w + 2*$itk_option(-padding)}]
461	}
462	if {$wtotal > $maxw} { set maxw $wtotal }
463	if {$maxw > $sw} { set maxw $sw }
464	$itk_component(inside) configure -width $maxw
465	} else {
466	$itk_component(inside) configure -width $itk_option(-width)
467	}
468
469	if {$itk_option(-height) <= 0} {
470	set maxh 0
471	foreach name $_pages {
472	set h [winfo reqheight $_page2info($name-frame)]
473	if {$h > $maxh} { set maxh $h }
474	}
475	set maxh [expr {$maxh + 2*$itk_option(-padding)}]
476	if {$maxh > $sh} { set maxh $sh }
477	$itk_component(inside) configure -height $maxh
478	} else {
479	$itk_component(inside) configure -height $itk_option(-height)
480	}
481	}
482	}
483	}
484
485	# ----------------------------------------------------------------------
486	# OPTION: -arrangement
487	# ----------------------------------------------------------------------
488	itcl::configbody Rappture::Pager::arrangement {
489	switch -- $itk_option(-arrangement) {
490	pages {
491	pack forget $itk_component(inside)
492	pack $itk_component(controls) -side bottom -fill x -padx 60 -pady 8
493	pack $itk_component(breadcrumbarea) -side top -fill x
494	pack $itk_component(line) -side top -fill x
495	pack $itk_component(inside) -expand yes -fill both
496	current [lindex $_pages 0]
497	}
498	side-by-side {
499	pack forget $itk_component(controls)
500	pack forget $itk_component(line)
501	pack forget $itk_component(breadcrumbarea)
502
503	foreach w [pack slaves $itk_component(inside)] {
504	pack forget $w
505	}
506	foreach name $_pages {
507	pack $_page2info($name-frame) -side left \
508	-expand yes -fill both \
509	-padx $itk_option(-padding) -pady $itk_option(-padding)
510	}
511	}
512	default {
513	error "bad value \"$itk_option(-arrangement)\": should be pages or side-by-side"
514	}
515	}
516	$_dispatcher event -now !fixsize
517	}
518
519	# ----------------------------------------------------------------------
520	# OPTION: -width
521	# ----------------------------------------------------------------------
522	itcl::configbody Rappture::Pager::width {
523	$_dispatcher event -idle !fixsize
524	}
525
526	# ----------------------------------------------------------------------
527	# OPTION: -height
528	# ----------------------------------------------------------------------
529	itcl::configbody Rappture::Pager::height {
530	$_dispatcher event -idle !fixsize
531	}
532
533	# ----------------------------------------------------------------------
534	# OPTION: -padding
535	# ----------------------------------------------------------------------
536	itcl::configbody Rappture::Pager::padding {
537	if {$_current != ""} {
538	pack $_page2info($_current-frame) -expand yes -fill both \
539	-padx $itk_option(-padding) -pady $itk_option(-padding)
540	}
541	$_dispatcher event -idle !fixsize
542	}
543
544	# ----------------------------------------------------------------------
545	# USAGE: _drawCrumbs all\|current
546	#
547	# Invoked automatically whenever the pages change. The value "all"
548	# signifies that the number of pages has changed, so all should be
549	# redrawn. The value "current" means that the current page has
550	# changed, so there is just a simple color change.
551	# ----------------------------------------------------------------------
552	itcl::body Rappture::Pager::_drawCrumbs {how} {
553	set c $itk_component(breadcrumbs)
554	set fnt $itk_option(-crumbfont)
555
556	switch -- $how {
557	all {
558	$c delete all
559
560	set x 0
561	set y [expr {[winfo reqheight $c]/2}]
562	set last [lindex $_pages end]
563
564	set num 1
565	foreach name $_pages {
566	set ht [expr {[font metrics $fnt -linespace]+2}]
567	set id [$c create oval $x [expr {$y-$ht/2}] \
568	[expr {$x+$ht}] [expr {$y+$ht/2}] \
569	-outline "" -fill $itk_option(-dimcrumbcolor) \
570	-tags $name]
571	set id [$c create text [expr {$x+$ht/2}] [expr {$y+1}] \
572	-text $num -fill $itk_option(-crumbnumbercolor) \
573	-tags [list $name $name-num]]
574	set x [expr {$x + $ht+2}]
575
576	set id [$c create text $x [expr {$y+1}] -anchor w \
577	-text [page $name -title] -font $fnt -tags $name]
578
579	$c bind $name <Enter> [itcl::code $this _drawCrumbs active]
580	$c bind $name <Leave> [itcl::code $this _drawCrumbs current]
581	$c bind $name <ButtonPress> [itcl::code $this current $name]
582
583	foreach {x0 y0 x1 y1} [$c bbox $id] break
584	set x [expr {$x + ($x1-$x0)+6}]
585
586	if {$name != $last} {
587	set id [$c create bitmap $x $y -anchor w \
588	-bitmap Pager-arrow \
589	-foreground $itk_option(-dimcrumbcolor)]
590	foreach {x0 y0 x1 y1} [$c bbox $id] break
591	set x [expr {$x + ($x1-$x0)+6}]
592	}
593
594	incr num
595	}
596
597	# fix the scrollregion in case we go off screen
598	$c configure -scrollregion [$c bbox all]
599
600	_drawCrumbs current
601	}
602	current {
603	# make all crumbs dim
604	foreach name $_pages {
605	$c itemconfigure $name \
606	-fill $itk_option(-dimcrumbcolor)
607	$c itemconfigure $name-num \
608	-fill $itk_option(-crumbnumbercolor)
609	}
610
611	# make all the current crumb bright
612	if {$_current != ""} {
613	$c itemconfigure $_current \
614	-fill $itk_option(-crumbcolor)
615	$c itemconfigure $_current-num \
616	-fill $itk_option(-crumbnumbercolor)
617
618	# scroll the view to see the crumb
619	if {[$c bbox $_current] != ""} {
620	foreach {x0 y0 x1 y1} [$c bbox $_current] break
621	foreach {xm0 ym0 xm1 ym1} [$c bbox all] break
622	set xm [expr {double($x0)/($xm1-$xm0)}]
623	$c xview moveto $xm
624	}
625	} else {
626	$c xview moveto 0
627	}
628	}
629	active {
630	foreach tag [$c gettags current] {
631	if {[lsearch -exact $_pages $tag] >= 0} {
632	$c itemconfigure $tag -fill $itk_option(-activecrumbcolor)
633	$c itemconfigure $tag-num -fill white
634	}
635	}
636	}
637	}
638	}
639
640	#
641	# busy --
642	#
643	# If true (this indicates a simulation is occurring), the widget
644	# should prevent the user from
645	# 1) clicking an item previous in the breadcrumbs, and
646	# 2) using the "back" button.
647	#
648	itcl::body Rappture::Pager::busy { bool } {
649	if { $bool } {
650	blt::busy hold $itk_component(breadcrumbs)
651	$itk_component(back) configure -state disabled
652	} else {
653	blt::busy release $itk_component(breadcrumbs)
654	$itk_component(back) configure -state normal
655	}
656	}

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/gui/scripts/pager.tcl @ 4691

Download in other formats: