Context Navigation

source: branches/1.6/gui/scripts/pager.tcl @ 6363

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

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

Download in other formats: