source: trunk/kitgen/8.x/blt/library/tabnotebook.tcl@ 201

Last change on this file since 201 was 175, checked in by demin, 12 years ago

initial commit

File size: 10.2 KB
Line 
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#
38set 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# ----------------------------------------------------------------------
49bind Tabnotebook <B2-Motion> {
50 %W scan dragto %x %y
51}
52
53bind 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
60bind 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# ----------------------------------------------------------------------
84bind Tabnotebook <KeyPress-Up> { blt::SelectTab %W "up" }
85bind Tabnotebook <KeyPress-Down> { blt::SelectTab %W "down" }
86bind Tabnotebook <KeyPress-Right> { blt::SelectTab %W "right" }
87bind Tabnotebook <KeyPress-Left> { blt::SelectTab %W "left" }
88bind Tabnotebook <KeyPress-space> { %W invoke focus }
89bind Tabnotebook <KeyPress-Return> { %W invoke focus }
90
91bind 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# ----------------------------------------------------------------------
111proc 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# ----------------------------------------------------------------------
140proc 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# ----------------------------------------------------------------------
167proc 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# ----------------------------------------------------------------------
196proc 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# ----------------------------------------------------------------------
251proc 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# ----------------------------------------------------------------------
289proc 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}
Note: See TracBrowser for help on using the repository browser.