1# 2# tabset.tcl 3# 4# ---------------------------------------------------------------------- 5# Bindings for the BLT tabset 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# 38namespace eval ::blt { 39 variable bltTabset 40 set bltTabset(activate) yes 41 set bltTabset(insel) 0 42} 43 44# ---------------------------------------------------------------------- 45# 46# ButtonPress assignments 47# 48# <ButtonPress-2> Starts scan mechanism (pushes the tabs) 49# <B2-Motion> Adjust scan 50# <ButtonRelease-2> Stops scan 51# 52# ---------------------------------------------------------------------- 53bind Tabset <B2-Motion> { 54 %W scan dragto %x %y 55} 56 57bind Tabset <ButtonPress-2> { 58 set ::blt::bltTabset(cursor) [%W cget -cursor] 59 set ::blt::bltTabset(activate) no 60 %W configure -cursor hand1 61 %W scan mark %x %y 62} 63 64bind Tabset <ButtonRelease-2> { 65 %W configure -cursor $::blt::bltTabset(cursor) 66 set ::blt::bltTabset(activate) yes 67 catch { %W activate @%x,%y } 68} 69 70# ---------------------------------------------------------------------- 71# 72# KeyPress assignments 73# 74# <KeyPress-Up> Moves focus to the tab immediately above the 75# current. 76# <KeyPress-Down> Moves focus to the tab immediately below the 77# current. 78# <KeyPress-Left> Moves focus to the tab immediately left of the 79# currently focused tab. 80# <KeyPress-Right> Moves focus to the tab immediately right of the 81# currently focused tab. 82# <KeyPress-space> Invokes the commands associated with the current 83# tab. 84# <KeyPress-Return> Same as above. 85# <KeyPress> Go to next tab starting with the ASCII character. 86# 87# ---------------------------------------------------------------------- 88bind Tabset <KeyPress-Up> { blt::TabsetSelect %W "up" } 89bind Tabset <KeyPress-Down> { blt::TabsetSelect %W "down" } 90bind Tabset <KeyPress-Right> { blt::TabsetSelect %W "right" } 91bind Tabset <KeyPress-Left> { blt::TabsetSelect %W "left" } 92bind Tabset <KeyPress-Next> { blt::TabsetSelect %W "next" } 93bind Tabset <KeyPress-Prior> { blt::TabsetSelect %W "prev" } 94bind Tabset <KeyPress-Home> { blt::TabsetSelect %W "begin" } 95bind Tabset <KeyPress-End> { blt::TabsetSelect %W "end" } 96bind Tabset <KeyPress-space> { %W invoke focus } 97bind Tabset <KeyPress-Return> { blt::TabsetSelect %W focus } 98 99bind Tabset <KeyPress> { blt::TabsetAccel %W %A } 100 101# ---------------------------------------------------------------------- 102# 103# TabsetAccel -- 104# 105# Find the first tab (from the tab that currently has focus) 106# starting with the same first letter as the tab. It searches 107# in order of the tab positions and wraps around. If no tab 108# matches, it stops back at the current tab. 109# 110# Arguments: 111# widget Tabset widget. 112# key ASCII character of key pressed 113# 114# ---------------------------------------------------------------------- 115proc blt::TabsetAccel { widget key } { 116 if {$key == "" || ![string is print $key]} return 117 set key [string tolower $key] 118 set itab [$widget index focus] 119 set numTabs [$widget size] 120 for { set i 0 } { $i < $numTabs } { incr i } { 121 if { [incr itab] >= $numTabs } { 122 set itab 0 123 } 124 set ul [$widget tab cget $itab -underline] 125 set name [$widget get $itab] 126 set label [string tolower [$widget tab cget $name -text]] 127 if { [string index $label $ul] == $key } { 128 break 129 } 130 } 131 TabsetSelect $widget $itab 132} 133 134proc blt::TabsetRaise { widget } { 135 wm withdraw $widget 136 wm deiconify $widget 137 raise $widget 138} 139 140# ---------------------------------------------------------------------- 141# 142# TabsetSelect -- 143# 144# Invokes the command for the tab. If the widget associated tab 145# is currently torn off, the tearoff is raised. 146# 147# Arguments: 148# widget Tabset widget. 149# x y Unused. 150# 151# ---------------------------------------------------------------------- 152proc blt::TabsetSelect { widget tab } { 153 variable bltTabset 154 if {$bltTabset(insel)} return 155 set rc [catch { 156 set bltTabset(insel) 1 157 158 set index [$widget index -both $tab] 159 if { $index != "" } { 160 if {[$widget index select] == $index} { 161 $widget see $index 162 } else { 163 focus $widget 164 $widget activate $index 165 $widget select $index 166 $widget focus $index 167 $widget see $index 168 set torn [$widget tab cget $index -tornwindow] 169 if {$torn != {}} { 170 raise $torn 171 } 172 $widget invoke $index 173 event generate $widget <<TabsetSelect>> 174 } 175 } 176 set rv "" 177 } rv] 178 set bltTabset(insel) 0 179 return -code $rc $rv 180} 181 182proc blt::DestroyTearoff { widget tab window} { 183 wm forget $window 184 $widget tab conf $tab -tornwindow {} 185 event generate $widget <<TabsetUntearoff>> -x [$widget tab number $tab] 186 $widget tab conf $tab -window $window 187} 188 189proc blt::CreateTearoff { widget tab args } { 190 191 # ------------------------------------------------------------------ 192 # When reparenting the window contained in the tab, check if the 193 # window or any window in its hierarchy currently has focus. 194 # Since we're reparenting windows behind its back, Tk can 195 # mistakenly activate the keyboard focus when the mouse enters the 196 # old toplevel. The simplest way to deal with this problem is to 197 # take the focus off the window and set it to the tabset widget 198 # itself. 199 # ------------------------------------------------------------------ 200 201 set tab [$widget index $tab] 202 set focus [focus] 203 set name [$widget get $tab] 204 set window [$widget tab cget $name -window] 205 if { ($focus == $window) || ([string match $window.* $focus]) } { 206 focus -force $widget 207 } 208 if {$window == {}} return 209 wm manage $window 210 wm title $window "[$widget tab cget $name -text]" 211 if {[winfo width $widget]>10} { 212 wm geometry $window [winfo width $widget]x[winfo height $widget] 213 } 214 $widget tab conf $tab -tornwindow $window 215 # If the user tries to delete the toplevel, put the window back 216 # into the tab folder. 217 wm protocol $window WM_DELETE_WINDOW [list blt::DestroyTearoff $widget $tab $window] 218 event generate $widget <<TabsetTearoff>> -x [$widget tab number $tab] 219} 220 221# ---------------------------------------------------------------------- 222# 223# Tearoff -- 224# 225# Toggles the tab tearoff. If the tab contains a embedded widget, 226# it is placed inside of a toplevel window. If the widget has 227# already been torn off, the widget is replaced back in the tab. 228# 229# Arguments: 230# widget tabset widget. 231# x y The coordinates of the mouse pointer. 232# 233# ---------------------------------------------------------------------- 234proc blt::Tearoff { widget x y index } { 235 set tab [$widget index -index $index] 236 if { $tab == "" } { 237 return 238 } 239 $widget invoke $tab 240 241 set torn [$widget tab tearoff $index] 242 if { $torn == $widget } { 243 blt::CreateTearoff $widget $tab $x $y 244 } else { 245 set window [$widget tab cget $tab -window] 246 blt::DestroyTearoff $widget $tab $window 247 } 248} 249 250proc blt::TabsetTearoff { widget {index focus} } { 251 set tab [$widget index -both $index] 252 if { $tab == "" } { 253 return 254 } 255 $widget invoke $tab 256 257 set window [$widget tab cget $tab -window] 258 if { $window != {}} { 259 blt::CreateTearoff $widget $tab 260 } else { 261 set window [$widget tab cget $tab -tornwindow] 262 blt::DestroyTearoff $widget $tab $window 263 } 264} 265 266# ---------------------------------------------------------------------- 267# 268# TabsetInit 269# 270# Invoked from C whenever a new tabset 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 tabset widget 287# 288# ---------------------------------------------------------------------- 289proc blt::TabsetInit { widget } { 290 $widget bind all <Enter> { 291 if { $::blt::bltTabset(activate) } { 292 %W activate current 293 } 294 } 295 $widget bind all <Leave> { 296 %W activate "" 297 } 298 $widget bind all <ButtonPress-1> { 299 blt::TabsetSelect %W "current" 300 } 301 $widget bind all <Control-ButtonPress-1> { 302 if { [%W cget -tearoff] } { 303 blt::Tearoff %W %X %Y active 304 } 305 } 306 $widget configure -perforationcommand { 307 blt::Tearoff %W $::blt::bltTabset(x) $::blt::bltTabset(y) select 308 } 309 $widget bind Perforation <Enter> { 310 %W perforation activate on 311 } 312 $widget bind Perforation <Leave> { 313 %W perforation activate off 314 } 315 $widget bind Perforation <ButtonRelease-1> { 316 set ::blt::bltTabset(x) %X 317 set ::blt::bltTabset(y) %Y 318 %W perforation invoke 319 } 320} 321 322# Insert a table 323proc blt::InsertTable {widget list args} { 324 array set p { -colprefix F -colnames {} -conf {} } 325 array set p $args 326 set w $widget 327 foreach cn $p(-colnames) { 328 $w column insert end $cn -justify left -bd 1 -relief raised 329 } 330 set clst [$w column names] 331 eval $w conf $p(-conf) 332 $w column conf 0 -hide 1 333 foreach i $list { 334 while {[llength $clst] <= [llength $i]} { 335 set cn $p(-colprefix)[llength $clst] 336 $w column insert end $cn -justify left -bd 1 -relief raised 337 set clst [$w column names] 338 } 339 set n 0 340 set d {} 341 foreach j $i { 342 incr n 343 lappend d [lindex $clst $n] $j 344 } 345 $w insert end #auto -data $d 346 } 347} 348 349 350