Context Navigation

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

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

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

Download in other formats: