4 # ----------------------------------------------------------------------
5 # Bindings for the BLT tabnotebook widget
6 # ----------------------------------------------------------------------
7 # AUTHOR: George Howlett
8 # Bell Labs Innovations for Lucent Technologies
10 # http://www.tcltk.com/blt
11 # ----------------------------------------------------------------------
12 # Copyright (c) 1998 Lucent Technologies, Inc.
13 # ======================================================================
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
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.
32 # ======================================================================
35 # Indicates whether to activate (highlight) tabs when the mouse passes
36 # over them. This is turned off during scan operations.
38 set bltTabnotebook(activate) yes
40 # ----------------------------------------------------------------------
42 # ButtonPress assignments
44 # <ButtonPress-2> Starts scan mechanism (pushes the tabs)
45 # <B2-Motion> Adjust scan
46 # <ButtonRelease-2> Stops scan
48 # ----------------------------------------------------------------------
49 bind Tabnotebook <B2-Motion> {
53 bind Tabnotebook <ButtonPress-2> {
54 set bltTabnotebook(cursor) [%W cget -cursor]
55 set bltTabnotebook(activate) no
56 %W configure -cursor hand1
60 bind Tabnotebook <ButtonRelease-2> {
61 %W configure -cursor $bltTabnotebook(cursor)
62 set bltTabnotebook(activate) yes
66 # ----------------------------------------------------------------------
68 # KeyPress assignments
70 # <KeyPress-Up> Moves focus to the tab immediately above the
72 # <KeyPress-Down> Moves focus to the tab immediately below the
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
80 # <KeyPress-Return> Same as above.
81 # <KeyPress> Go to next tab starting with the ASCII character.
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 }
91 bind Tabnotebook <KeyPress> {
92 if { [string match {[A-Za-z0-9]*} "%A"] } {
93 blt::FindMatchingTab %W %A
97 # ----------------------------------------------------------------------
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.
107 # widget Tabnotebook widget.
108 # key ASCII character of key pressed
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 } {
119 set label [string tolower [$widget tab cget $itab -text]]
120 if { [string index $label 0] == $key } {
128 # ----------------------------------------------------------------------
132 # Invokes the command for the tab. If the widget associated tab
133 # is currently torn off, the tearoff is raised.
136 # widget Tabnotebook widget.
139 # ----------------------------------------------------------------------
140 proc blt::SelectTab { widget tab } {
141 set index [$widget index $tab]
142 if { $index != "" } {
143 $widget select $index
146 set w [$widget tab tearoff $index]
147 if { ($w != "") && ($w != "$widget") } {
148 raise [winfo toplevel $w]
150 $widget invoke $index
154 # ----------------------------------------------------------------------
158 # Destroys the toplevel window and the container tearoff
159 # window holding the embedded widget. The widget is placed
160 # back inside the tab.
163 # widget Tabnotebook widget.
166 # ----------------------------------------------------------------------
167 proc blt::DestroyTearoff { widget tab } {
168 set id [$widget id $tab]
169 set top "$widget.toplevel-$id"
170 if { [winfo exists $top] } {
173 $widget tab tearoff $tab $widget
178 # ----------------------------------------------------------------------
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
191 # widget Tabnotebook widget.
193 # x y The coordinates of the mouse pointer.
195 # ----------------------------------------------------------------------
196 proc blt::CreateTearoff { widget tab rootX rootY } {
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
206 # ------------------------------------------------------------------
209 set window [$widget tab cget $tab -window]
210 set index [$widget index $tab]
211 if { ($focus == $window) || ([string match $window.* $focus]) } {
214 set id [$widget id $index]
215 set top "$widget.toplevel-$id"
217 $widget tab tearoff $tab $top.container
218 blttable $top $top.container -fill both
220 incr rootX 10 ; incr rootY 10
221 wm geometry $top +$rootX+$rootY
223 set parent [winfo toplevel $widget]
224 wm title $top "[wm title $parent]: [$widget tab cget $index -text]"
225 wm transient $top $parent
227 # If the user tries to delete the toplevel, put the window back
228 # into the tab folder.
230 wm protocol $top WM_DELETE_WINDOW [list blt::DestroyTearoff $widget $tab]
232 # If the container is ever destroyed, automatically destroy the
235 bind $top.container <Destroy> [list destroy $top]
238 # ----------------------------------------------------------------------
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.
247 # widget tabnotebook widget.
248 # x y The coordinates of the mouse pointer.
250 # ----------------------------------------------------------------------
251 proc blt::ToggleTearoff { widget x y index } {
252 set tab [$widget index $index]
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
266 # ----------------------------------------------------------------------
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.
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
286 # widget tabnotebook widget
288 # ----------------------------------------------------------------------
289 proc blt::TabnotebookInit { widget } {
290 $widget bind all <Enter> {
291 if { $bltTabnotebook(activate) } {
295 $widget bind all <Leave> {
298 $widget bind all <ButtonPress-1> {
299 blt::SelectTab %W "current"
301 $widget bind all <Control-ButtonPress-1> {
302 blt::ToggleTearoff %W %X %Y active
304 $widget configure -perforationcommand {
305 blt::ToggleTearoff %W $bltTabnotebook(x) $bltTabnotebook(y) select
307 $widget bind Perforation <Enter> {
308 %W perforation activate on
310 $widget bind Perforation <Leave> {
311 %W perforation activate off
313 $widget bind Perforation <ButtonPress-1> {
314 set bltTabnotebook(x) %X
315 set bltTabnotebook(y) %Y
316 %W perforation invoke