| 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 | # ====================================================================== |
|---|
| 11 | package require Itk |
|---|
| 12 | package require BLT |
|---|
| 13 | |
|---|
| 14 | option add *Pager.width 0 widgetDefault |
|---|
| 15 | option add *Pager.height 0 widgetDefault |
|---|
| 16 | option add *Pager.arrangement "tabs/top" widgetDefault |
|---|
| 17 | option add *Pager.tearoff 0 widgetDefault |
|---|
| 18 | |
|---|
| 19 | itcl::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 | |
|---|
| 42 | itk::usual Pager { |
|---|
| 43 | } |
|---|
| 44 | |
|---|
| 45 | # ---------------------------------------------------------------------- |
|---|
| 46 | # CONSTRUCTOR |
|---|
| 47 | # ---------------------------------------------------------------------- |
|---|
| 48 | itcl::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 | # ---------------------------------------------------------------------- |
|---|
| 84 | itcl::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 | # ---------------------------------------------------------------------- |
|---|
| 121 | itcl::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 | # ---------------------------------------------------------------------- |
|---|
| 152 | itcl::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 | # ---------------------------------------------------------------------- |
|---|
| 163 | itcl::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 | # ---------------------------------------------------------------------- |
|---|
| 179 | itcl::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 | # ---------------------------------------------------------------------- |
|---|
| 265 | itcl::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 | |
|---|
| 273 | source dispatcher.tcl |
|---|
| 274 | |
|---|
| 275 | Rappture::Pager .p |
|---|
| 276 | pack .p -expand yes -fill both |
|---|
| 277 | |
|---|
| 278 | set f [.p component inside] |
|---|
| 279 | label $f.top -text "top" |
|---|
| 280 | pack $f.top -fill x |
|---|
| 281 | |
|---|
| 282 | set f [.p insert end "Electrical"] |
|---|
| 283 | label $f.l -text "Electrical" -background black -foreground white |
|---|
| 284 | pack $f.l -expand yes -fill both |
|---|
| 285 | |
|---|
| 286 | set f [.p insert end "Doping"] |
|---|
| 287 | label $f.l -text "Doping" -background black -foreground white |
|---|
| 288 | pack $f.l -expand yes -fill both |
|---|
