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

   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 #
  38 namespace 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 # ----------------------------------------------------------------------
  53 bind Tabset <B2-Motion> {
  54     %W scan dragto %x %y
  55 }
  56
  57 bind 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
  64 bind 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 # ----------------------------------------------------------------------
  88 bind Tabset <KeyPress-Up> { blt::TabsetSelect %W "up" }
  89 bind Tabset <KeyPress-Down> { blt::TabsetSelect %W "down" }
  90 bind Tabset <KeyPress-Right> { blt::TabsetSelect %W "right" }
  91 bind Tabset <KeyPress-Left> { blt::TabsetSelect %W "left" }
  92 bind Tabset <KeyPress-Next> { blt::TabsetSelect %W "next" }
  93 bind Tabset <KeyPress-Prior> { blt::TabsetSelect %W "prev" }
  94 bind Tabset <KeyPress-Home> { blt::TabsetSelect %W "begin" }
  95 bind Tabset <KeyPress-End> { blt::TabsetSelect %W "end" }
  96 bind Tabset <KeyPress-space> { %W invoke focus }
  97 bind Tabset <KeyPress-Return> { blt::TabsetSelect %W focus }
  98
  99 bind 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 # ----------------------------------------------------------------------
 115 proc 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
 134 proc 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 # ----------------------------------------------------------------------
 152 proc 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
 182 proc 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
 189 proc 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 # ----------------------------------------------------------------------
 234 proc 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
 250 proc 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 # ----------------------------------------------------------------------
 289 proc 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
 323 proc 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