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

Last change on this file since 1 was 1, checked in by mmc, 16 years ago

initial import

File size: 9.8 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  Purdue Research Foundation, West Lafayette, IN
10# ======================================================================
11package require Itk
12package require BLT
13
14option add *Pager.width 0 widgetDefault
15option add *Pager.height 0 widgetDefault
16option add *Pager.arrangement "tabs/top" widgetDefault
17option add *Pager.tearoff 0 widgetDefault
18
19itcl::class Rappture::Pager {
20    inherit itk::Widget
21
22    itk_option define -arrangement arrangement Arrangement ""
23    itk_option define -width width Width 0
24    itk_option define -height height Height 0
25
26    constructor {args} { # defined below }
27
28    public method insert {pos args}
29    public method delete {first {last ""}}
30    public method index {name}
31    public method get {{name ""}}
32
33    protected method _layout {}
34
35    private variable _dispatcher ""  ;# dispatcher for !events
36    private variable _pages ""       ;# list of known pages
37    private variable _page2frame     ;# maps page name => frame
38    private variable _counter 0      ;# counter for frame names
39    private variable _arrangement "" ;# last value of -arrangment
40}
41                                                                               
42itk::usual Pager {
43}
44
45# ----------------------------------------------------------------------
46# CONSTRUCTOR
47# ----------------------------------------------------------------------
48itcl::body Rappture::Pager::constructor {args} {
49    Rappture::dispatcher _dispatcher
50    $_dispatcher register !layout
51    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
52
53    itk_component add tabs {
54        blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
55            -side bottom -selectcommand [itcl::code $this _layout]
56    } {
57        keep -activebackground -activeforeground
58        keep -background -cursor -font
59        rename -highlightbackground -background background Background
60        keep -highlightcolor -highlightthickness
61        keep -selectbackground -selectforeground
62        keep -tabbackground -tabforeground
63        keep -tearoff
64    }
65    pack $itk_component(tabs) -expand yes -fill both
66
67    itk_component add inside {
68        frame $itk_component(tabs).inside
69    }
70    $_dispatcher event -idle !layout
71
72    eval itk_initialize $args
73}
74
75# ----------------------------------------------------------------------
76# USAGE: insert <pos> <name> ?<name>...?
77#
78# Clients use this to insert one or more new pages into this pager.
79# The pages are inserted into the list at position <pos>, which can
80# be an integer starting from 0 or the keyword "end".  Each <name>
81# is the name used to identify the page.  Returns the name of a frame
82# for each page created.
83# ----------------------------------------------------------------------
84itcl::body Rappture::Pager::insert {pos args} {
85    if {"end" == $pos} {
86        set pos [llength $_pages]
87    } elseif {![string is integer $pos]} {
88        error "bad index \"$pos\": should be integer or \"end\""
89    }
90
91    set rlist ""
92    foreach name $args {
93        if {[info exists _page2frame($name)]} {
94            error "page \"$name\" already exists"
95        }
96        set win $itk_component(inside).page[incr _counter]
97        frame $win
98        set _page2frame($name) $win
99        set _pages [linsert $_pages $pos $name]
100        lappend rlist $win
101
102        if {[string match tabs/* $_arrangement]} {
103            $itk_component(tabs) insert $pos $name
104        }
105    }
106    $_dispatcher event -idle !layout
107
108    return $rlist
109}
110
111# ----------------------------------------------------------------------
112# USAGE: delete <first> ?<last>?
113#
114# Clients use this to delete one or more pages from this widget.
115# The <first> and <last> represent the integer index of the desired
116# page.  You can use the "index" method to convert a page name to
117# its integer index.  If only <first> is specified, then that one
118# page is deleted.  If <last> is specified, then all pages in the
119# range <first> to <last> are deleted.
120# ----------------------------------------------------------------------
121itcl::body Rappture::Pager::delete {first {last ""}} {
122    if {$last == ""} {
123        set last $first
124    }
125    if {![regexp {^[0-9]+|end$} $first]} {
126        error "bad index \"$first\": should be integer or \"end\""
127    }
128    if {![regexp {^[0-9]+|end$} $last]} {
129        error "bad index \"$last\": should be integer or \"end\""
130    }
131
132    foreach name [lrange $_pages $first $last] {
133        if {[info exists _page2frame($name)]} {
134            destroy $_page2frame($name)
135            unset _page2frame($name)
136        }
137    }
138    set _pages [lreplace $_pages $first $last]
139
140    if {[string match tabs/* $_arrangement]} {
141        $itk_component(tabs) delete $first $last
142    }
143    $_dispatcher event -idle !layout
144}
145
146# ----------------------------------------------------------------------
147# USAGE: index <name>
148#
149# Clients use this to convert a page <name> into its corresponding
150# integer index.  Returns -1 if the <name> is not recognized.
151# ----------------------------------------------------------------------
152itcl::body Rappture::Pager::index {name} {
153    return [lsearch -exact $_pages $name]
154}
155
156# ----------------------------------------------------------------------
157# USAGE: get ?<name>?
158#
159# Clients use this to get information about pages.  With no args, it
160# returns a list of all page names.  Otherwise, it returns the frame
161# associated with a page name.
162# ----------------------------------------------------------------------
163itcl::body Rappture::Pager::get {{name ""}} {
164    if {$name == ""} {
165        return $_pages
166    }
167    if {[info exists _page2frame($name)]} {
168        return $_page2frame($name)
169    }
170    return ""
171}
172
173# ----------------------------------------------------------------------
174# USAGE: _layout
175#
176# Used internally to fix the current page management whenever pages
177# are added or deleted, or when the page arrangement changes.
178# ----------------------------------------------------------------------
179itcl::body Rappture::Pager::_layout {} {
180    #
181    # If the new arrangement doesn't match the last one, then
182    # clear the effects of the old arrangement.
183    #
184    regexp {(.*)/?} $_arrangement match oldatype
185    regexp {(.*)/?} $itk_option(-arrangement) match newatype
186
187    if {$newatype != $oldatype} {
188        switch -glob -- $_arrangement {
189            tabs/* {
190                foreach name $_pages {
191                    pack forget $_page2frame($name)
192                }
193                pack forget $itk_component(inside)
194                catch {$itk_component(tabs) delete 0 end}
195            }
196            stack {
197                foreach name $_pages {
198                    pack forget $_page2frame($name)
199                }
200            }
201        }
202        switch -glob -- $itk_option(-arrangement) {
203            tabs/* {
204                foreach name $_pages {
205                    $itk_component(tabs) insert end $name
206                }
207                if {[llength $_pages] > 0} {
208                    $itk_component(tabs) select 0
209                }
210            }
211        }
212    }
213    set _arrangement $itk_option(-arrangement)
214
215    #
216    # Apply the new arrangement.
217    #
218    switch -glob -- $itk_option(-arrangement) {
219        tabs/* {
220            set side [lindex [split $itk_option(-arrangement) /] 1]
221            if {$side == ""} { set side "top" }
222            $itk_component(tabs) configure -side $side
223
224            if {[llength $_pages] <= 1} {
225                pack $itk_component(inside) -expand yes -fill both
226                set first [lindex $_pages 0]
227                if {$first != ""} {
228                    pack $_page2frame($first) -expand yes -fill both
229                }
230            } else {
231                pack forget $itk_component(inside)
232                set i [$itk_component(tabs) index select]
233                if {$i != ""} {
234                    set name [$itk_component(tabs) get $i]
235                    $itk_component(tabs) tab configure $name \
236                        -window $itk_component(inside) -fill both
237                }
238
239                foreach name $_pages {
240                    pack forget $_page2frame($name)
241                }
242                if {$i != ""} {
243                    set name [lindex $_pages $i]
244                    if {$name != ""} {
245                        pack $_page2frame($name) -expand yes -fill both
246                    }
247                }
248            }
249        }
250        stack {
251            foreach name $_pages {
252                pack forget $_page2frame($name)
253            }
254            foreach name $_pages {
255                pack $_page2frame($name) -expand yes -fill both
256            }
257            pack $itk_component(inside) -expand yes -fill both
258        }
259    }
260}
261
262# ----------------------------------------------------------------------
263# CONFIGURATION OPTION: -arrangement
264# ----------------------------------------------------------------------
265itcl::configbody Rappture::Pager::arrangement {
266    set legal {tabs/top tabs/bottom tabs/left tabs/right stack}
267    if {[lsearch -exact $legal $itk_option(-arrangement)] < 0} {
268        error "bad option \"$itk_option(-arrangement)\": should be one of [join [lsort $legal] {, }]"
269    }
270    $_dispatcher event -idle !layout
271}
272
273source dispatcher.tcl
274
275Rappture::Pager .p
276pack .p -expand yes -fill both
277
278set f [.p component inside]
279label $f.top -text "top"
280pack $f.top -fill x
281
282set f [.p insert end "Electrical"]
283label $f.l -text "Electrical" -background black -foreground white
284pack $f.l -expand yes -fill both
285
286set f [.p insert end "Doping"]
287label $f.l -text "Doping" -background black -foreground white
288pack $f.l -expand yes -fill both
Note: See TracBrowser for help on using the repository browser.