| 1 | #
|
|---|
| 2 | # tabnotebook.tcl
|
|---|
| 3 | #
|
|---|
| 4 | # ----------------------------------------------------------------------
|
|---|
| 5 | # Bindings for the BLT tabnotebook widget
|
|---|
| 6 | # ----------------------------------------------------------------------
|
|---|
| 7 | # AUTHOR: George Howlett
|
|---|
| 8 | # Bell Labs Innovations for Lucent Technologies
|
|---|
| 9 | # gah@bell-labs.com
|
|---|
| 10 | # http://www.tcltk.com/blt
|
|---|
| 11 | # ----------------------------------------------------------------------
|
|---|
| 12 | # Copyright (c) 1998 Lucent Technologies, Inc.
|
|---|
| 13 | # ======================================================================
|
|---|
| 14 | #
|
|---|
| 15 | # Permission to use, copy, modify, and distribute this software and its
|
|---|
| 16 | # documentation for any purpose and without fee is hereby granted,
|
|---|
| 17 | # provided that the above copyright notice appear in all copies and that
|
|---|
| 18 | # both that the copyright notice and warranty disclaimer appear in
|
|---|
| 19 | # supporting documentation, and that the names of Lucent Technologies
|
|---|
| 20 | # any of their entities not be used in advertising or publicity
|
|---|
| 21 | # pertaining to distribution of the software without specific, written
|
|---|
| 22 | # prior permission.
|
|---|
| 23 | #
|
|---|
| 24 | # Lucent Technologies disclaims all warranties with regard to this
|
|---|
| 25 | # software, including all implied warranties of merchantability and
|
|---|
| 26 | # fitness. In no event shall Lucent be liable for any special, indirect
|
|---|
| 27 | # or consequential damages or any damages whatsoever resulting from loss
|
|---|
| 28 | # of use, data or profits, whether in an action of contract, negligence
|
|---|
| 29 | # or other tortuous action, arising out of or in connection with the use
|
|---|
| 30 | # or performance of this software.
|
|---|
| 31 | #
|
|---|
| 32 | # ======================================================================
|
|---|
| 33 |
|
|---|
| 34 | #
|
|---|
| 35 | # Indicates whether to activate (highlight) tabs when the mouse passes
|
|---|
| 36 | # over them. This is turned off during scan operations.
|
|---|
| 37 | #
|
|---|
| 38 | set bltTabnotebook(activate) yes
|
|---|
| 39 |
|
|---|
| 40 | # ----------------------------------------------------------------------
|
|---|
| 41 | #
|
|---|
| 42 | # ButtonPress assignments
|
|---|
| 43 | #
|
|---|
| 44 | # <ButtonPress-2> Starts scan mechanism (pushes the tabs)
|
|---|
| 45 | # <B2-Motion> Adjust scan
|
|---|
| 46 | # <ButtonRelease-2> Stops scan
|
|---|
| 47 | #
|
|---|
| 48 | # ----------------------------------------------------------------------
|
|---|
| 49 | bind Tabnotebook <B2-Motion> {
|
|---|
| 50 | %W scan dragto %x %y
|
|---|
| 51 | }
|
|---|
| 52 |
|
|---|
| 53 | bind Tabnotebook <ButtonPress-2> {
|
|---|
| 54 | set bltTabnotebook(cursor) [%W cget -cursor]
|
|---|
| 55 | set bltTabnotebook(activate) no
|
|---|
| 56 | %W configure -cursor hand1
|
|---|
| 57 | %W scan mark %x %y
|
|---|
| 58 | }
|
|---|
| 59 |
|
|---|
| 60 | bind Tabnotebook <ButtonRelease-2> {
|
|---|
| 61 | %W configure -cursor $bltTabnotebook(cursor)
|
|---|
| 62 | set bltTabnotebook(activate) yes
|
|---|
| 63 | %W activate @%x,%y
|
|---|
| 64 | }
|
|---|
| 65 |
|
|---|
| 66 | # ----------------------------------------------------------------------
|
|---|
| 67 | #
|
|---|
| 68 | # KeyPress assignments
|
|---|
| 69 | #
|
|---|
| 70 | # <KeyPress-Up> Moves focus to the tab immediately above the
|
|---|
| 71 | # current.
|
|---|
| 72 | # <KeyPress-Down> Moves focus to the tab immediately below the
|
|---|
| 73 | # current.
|
|---|
| 74 | # <KeyPress-Left> Moves focus to the tab immediately left of the
|
|---|
| 75 | # currently focused tab.
|
|---|
| 76 | # <KeyPress-Right> Moves focus to the tab immediately right of the
|
|---|
| 77 | # currently focused tab.
|
|---|
| 78 | # <KeyPress-space> Invokes the commands associated with the current
|
|---|
| 79 | # tab.
|
|---|
| 80 | # <KeyPress-Return> Same as above.
|
|---|
| 81 | # <KeyPress> Go to next tab starting with the ASCII character.
|
|---|
| 82 | #
|
|---|
| 83 | # ----------------------------------------------------------------------
|
|---|
| 84 | bind Tabnotebook <KeyPress-Up> { blt::SelectTab %W "up" }
|
|---|
| 85 | bind Tabnotebook <KeyPress-Down> { blt::SelectTab %W "down" }
|
|---|
| 86 | bind Tabnotebook <KeyPress-Right> { blt::SelectTab %W "right" }
|
|---|
| 87 | bind Tabnotebook <KeyPress-Left> { blt::SelectTab %W "left" }
|
|---|
| 88 | bind Tabnotebook <KeyPress-space> { %W invoke focus }
|
|---|
| 89 | bind Tabnotebook <KeyPress-Return> { %W invoke focus }
|
|---|
| 90 |
|
|---|
| 91 | bind Tabnotebook <KeyPress> {
|
|---|
| 92 | if { [string match {[A-Za-z0-9]*} "%A"] } {
|
|---|
| 93 | blt::FindMatchingTab %W %A
|
|---|
| 94 | }
|
|---|
| 95 | }
|
|---|
| 96 |
|
|---|
| 97 | # ----------------------------------------------------------------------
|
|---|
| 98 | #
|
|---|
| 99 | # FirstMatchingTab --
|
|---|
| 100 | #
|
|---|
| 101 | # Find the first tab (from the tab that currently has focus)
|
|---|
| 102 | # starting with the same first letter as the tab. It searches
|
|---|
| 103 | # in order of the tab positions and wraps around. If no tab
|
|---|
| 104 | # matches, it stops back at the current tab.
|
|---|
| 105 | #
|
|---|
| 106 | # Arguments:
|
|---|
| 107 | # widget Tabnotebook widget.
|
|---|
| 108 | # key ASCII character of key pressed
|
|---|
| 109 | #
|
|---|
| 110 | # ----------------------------------------------------------------------
|
|---|
| 111 | proc blt::FindMatchingTab { widget key } {
|
|---|
| 112 | set key [string tolower $key]
|
|---|
| 113 | set itab [$widget index focus]
|
|---|
| 114 | set numTabs [$widget size]
|
|---|
| 115 | for { set i 0 } { $i < $numTabs } { incr i } {
|
|---|
| 116 | if { [incr itab] >= $numTabs } {
|
|---|
| 117 | set itab 0
|
|---|
| 118 | }
|
|---|
| 119 | set label [string tolower [$widget tab cget $itab -text]]
|
|---|
| 120 | if { [string index $label 0] == $key } {
|
|---|
| 121 | break
|
|---|
| 122 | }
|
|---|
| 123 | }
|
|---|
| 124 | $widget focus $itab
|
|---|
| 125 | $widget see focus
|
|---|
| 126 | }
|
|---|
| 127 |
|
|---|
| 128 | # ----------------------------------------------------------------------
|
|---|
| 129 | #
|
|---|
| 130 | # SelectTab --
|
|---|
| 131 | #
|
|---|
| 132 | # Invokes the command for the tab. If the widget associated tab
|
|---|
| 133 | # is currently torn off, the tearoff is raised.
|
|---|
| 134 | #
|
|---|
| 135 | # Arguments:
|
|---|
| 136 | # widget Tabnotebook widget.
|
|---|
| 137 | # x y Unused.
|
|---|
| 138 | #
|
|---|
| 139 | # ----------------------------------------------------------------------
|
|---|
| 140 | proc blt::SelectTab { widget tab } {
|
|---|
| 141 | set index [$widget index $tab]
|
|---|
| 142 | if { $index != "" } {
|
|---|
| 143 | $widget select $index
|
|---|
| 144 | $widget focus $index
|
|---|
| 145 | $widget see $index
|
|---|
| 146 | set w [$widget tab tearoff $index]
|
|---|
| 147 | if { ($w != "") && ($w != "$widget") } {
|
|---|
| 148 | raise [winfo toplevel $w]
|
|---|
| 149 | }
|
|---|
| 150 | $widget invoke $index
|
|---|
| 151 | }
|
|---|
| 152 | }
|
|---|
| 153 |
|
|---|
| 154 | # ----------------------------------------------------------------------
|
|---|
| 155 | #
|
|---|
| 156 | # DestroyTearoff --
|
|---|
| 157 | #
|
|---|
| 158 | # Destroys the toplevel window and the container tearoff
|
|---|
| 159 | # window holding the embedded widget. The widget is placed
|
|---|
| 160 | # back inside the tab.
|
|---|
| 161 | #
|
|---|
| 162 | # Arguments:
|
|---|
| 163 | # widget Tabnotebook widget.
|
|---|
| 164 | # tab Tab selected.
|
|---|
| 165 | #
|
|---|
| 166 | # ----------------------------------------------------------------------
|
|---|
| 167 | proc blt::DestroyTearoff { widget tab } {
|
|---|
| 168 | set id [$widget id $tab]
|
|---|
| 169 | set top "$widget.toplevel-$id"
|
|---|
| 170 | if { [winfo exists $top] } {
|
|---|
| 171 | wm withdraw $top
|
|---|
| 172 | update
|
|---|
| 173 | $widget tab tearoff $tab $widget
|
|---|
| 174 | destroy $top
|
|---|
| 175 | }
|
|---|
| 176 | }
|
|---|
| 177 |
|
|---|
| 178 | # ----------------------------------------------------------------------
|
|---|
| 179 | #
|
|---|
| 180 | # CreateTearoff --
|
|---|
| 181 | #
|
|---|
| 182 | # Creates a new toplevel window and moves the embedded widget
|
|---|
| 183 | # into it. The toplevel is placed just below the tab. The
|
|---|
| 184 | # DELETE WINDOW property is set so that if the toplevel window
|
|---|
| 185 | # is requested to be deleted by the window manager, the embedded
|
|---|
| 186 | # widget is placed back inside of the tab. Note also that
|
|---|
| 187 | # if the tabnotebook container is ever destroyed, the toplevel is
|
|---|
| 188 | # also destroyed.
|
|---|
| 189 | #
|
|---|
| 190 | # Arguments:
|
|---|
| 191 | # widget Tabnotebook widget.
|
|---|
| 192 | # tab Tab selected.
|
|---|
| 193 | # x y The coordinates of the mouse pointer.
|
|---|
| 194 | #
|
|---|
| 195 | # ----------------------------------------------------------------------
|
|---|
| 196 | proc blt::CreateTearoff { widget tab rootX rootY } {
|
|---|
| 197 |
|
|---|
| 198 | # ------------------------------------------------------------------
|
|---|
| 199 | # When reparenting the window contained in the tab, check if the
|
|---|
| 200 | # window or any window in its hierarchy currently has focus.
|
|---|
| 201 | # Since we're reparenting windows behind its back, Tk can
|
|---|
| 202 | # mistakenly activate the keyboard focus when the mouse enters the
|
|---|
| 203 | # old toplevel. The simplest way to deal with this problem is to
|
|---|
| 204 | # take the focus off the window and set it to the tabnotebook widget
|
|---|
| 205 | # itself.
|
|---|
| 206 | # ------------------------------------------------------------------
|
|---|
| 207 |
|
|---|
| 208 | set focus [focus]
|
|---|
| 209 | set window [$widget tab cget $tab -window]
|
|---|
| 210 | set index [$widget index $tab]
|
|---|
| 211 | if { ($focus == $window) || ([string match $window.* $focus]) } {
|
|---|
| 212 | focus -force $widget
|
|---|
| 213 | }
|
|---|
| 214 | set id [$widget id $index]
|
|---|
| 215 | set top "$widget.toplevel-$id"
|
|---|
| 216 | toplevel $top
|
|---|
| 217 | $widget tab tearoff $tab $top.container
|
|---|
| 218 | table $top $top.container -fill both
|
|---|
| 219 |
|
|---|
| 220 | incr rootX 10 ; incr rootY 10
|
|---|
| 221 | wm geometry $top +$rootX+$rootY
|
|---|
| 222 |
|
|---|
| 223 | set parent [winfo toplevel $widget]
|
|---|
| 224 | wm title $top "[wm title $parent]: [$widget tab cget $index -text]"
|
|---|
| 225 | wm transient $top $parent
|
|---|
| 226 |
|
|---|
| 227 | # If the user tries to delete the toplevel, put the window back
|
|---|
| 228 | # into the tab folder.
|
|---|
| 229 |
|
|---|
| 230 | wm protocol $top WM_DELETE_WINDOW [list blt::DestroyTearoff $widget $tab]
|
|---|
| 231 |
|
|---|
| 232 | # If the container is ever destroyed, automatically destroy the
|
|---|
| 233 | # toplevel too.
|
|---|
| 234 |
|
|---|
| 235 | bind $top.container <Destroy> [list destroy $top]
|
|---|
| 236 | }
|
|---|
| 237 |
|
|---|
| 238 | # ----------------------------------------------------------------------
|
|---|
| 239 | #
|
|---|
| 240 | # ToggleTearoff --
|
|---|
| 241 | #
|
|---|
| 242 | # Toggles the tab tearoff. If the tab contains a embedded widget,
|
|---|
| 243 | # it is placed inside of a toplevel window. If the widget has
|
|---|
| 244 | # already been torn off, the widget is replaced back in the tab.
|
|---|
| 245 | #
|
|---|
| 246 | # Arguments:
|
|---|
| 247 | # widget tabnotebook widget.
|
|---|
| 248 | # x y The coordinates of the mouse pointer.
|
|---|
| 249 | #
|
|---|
| 250 | # ----------------------------------------------------------------------
|
|---|
| 251 | proc blt::ToggleTearoff { widget x y index } {
|
|---|
| 252 | set tab [$widget index $index]
|
|---|
| 253 | if { $tab == "" } {
|
|---|
| 254 | return
|
|---|
| 255 | }
|
|---|
| 256 | $widget invoke $tab
|
|---|
| 257 |
|
|---|
| 258 | set container [$widget tab tearoff $index]
|
|---|
| 259 | if { $container == "$widget" } {
|
|---|
| 260 | blt::CreateTearoff $widget $tab $x $y
|
|---|
| 261 | } elseif { $container != "" } {
|
|---|
| 262 | blt::DestroyTearoff $widget $tab
|
|---|
| 263 | }
|
|---|
| 264 | }
|
|---|
| 265 |
|
|---|
| 266 | # ----------------------------------------------------------------------
|
|---|
| 267 | #
|
|---|
| 268 | # TabnotebookInit
|
|---|
| 269 | #
|
|---|
| 270 | # Invoked from C whenever a new tabnotebook widget is created.
|
|---|
| 271 | # Sets up the default bindings for the all tab entries.
|
|---|
| 272 | # These bindings are local to the widget, so they can't be
|
|---|
| 273 | # set through the usual widget class bind tags mechanism.
|
|---|
| 274 | #
|
|---|
| 275 | # <Enter> Activates the tab.
|
|---|
| 276 | # <Leave> Deactivates all tabs.
|
|---|
| 277 | # <ButtonPress-1> Selects the tab and invokes its command.
|
|---|
| 278 | # <Control-ButtonPress-1>
|
|---|
| 279 | # Toggles the tab tearoff. If the tab contains
|
|---|
| 280 | # a embedded widget, it is placed inside of a
|
|---|
| 281 | # toplevel window. If the widget has already
|
|---|
| 282 | # been torn off, the widget is replaced back
|
|---|
| 283 | # in the tab.
|
|---|
| 284 | #
|
|---|
| 285 | # Arguments:
|
|---|
| 286 | # widget tabnotebook widget
|
|---|
| 287 | #
|
|---|
| 288 | # ----------------------------------------------------------------------
|
|---|
| 289 | proc blt::TabnotebookInit { widget } {
|
|---|
| 290 | $widget bind all <Enter> {
|
|---|
| 291 | if { $bltTabnotebook(activate) } {
|
|---|
| 292 | %W activate current
|
|---|
| 293 | }
|
|---|
| 294 | }
|
|---|
| 295 | $widget bind all <Leave> {
|
|---|
| 296 | %W activate ""
|
|---|
| 297 | }
|
|---|
| 298 | $widget bind all <ButtonPress-1> {
|
|---|
| 299 | blt::SelectTab %W "current"
|
|---|
| 300 | }
|
|---|
| 301 | $widget bind all <Control-ButtonPress-1> {
|
|---|
| 302 | blt::ToggleTearoff %W %X %Y active
|
|---|
| 303 | }
|
|---|
| 304 | $widget configure -perforationcommand {
|
|---|
| 305 | blt::ToggleTearoff %W $bltTabnotebook(x) $bltTabnotebook(y) select
|
|---|
| 306 | }
|
|---|
| 307 | $widget bind Perforation <Enter> {
|
|---|
| 308 | %W perforation activate on
|
|---|
| 309 | }
|
|---|
| 310 | $widget bind Perforation <Leave> {
|
|---|
| 311 | %W perforation activate off
|
|---|
| 312 | }
|
|---|
| 313 | $widget bind Perforation <ButtonPress-1> {
|
|---|
| 314 | set bltTabnotebook(x) %X
|
|---|
| 315 | set bltTabnotebook(y) %Y
|
|---|
| 316 | %W perforation invoke
|
|---|
| 317 | }
|
|---|
| 318 | }
|
|---|
