Context Navigation

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

Last change on this file since 2744 was 2744, checked in by gah, 12 years ago

File size: 23.5 KB

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

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

Download in other formats: