util/X86LINUX64/lib/blt2.5/tabnotebook.tcl

   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     blttable $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 }