Context Navigation

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

Last change on this file since 3443 was 3330, checked in by gah, 12 years ago
merge (by hand) with Rappture1.2 branch
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 8 -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.

Download in other formats: