mingw/lib/tk8.5/ttk/combobox.tcl

   1 #
   2 # $Id: combobox.tcl,v 1.12 2008/02/23 18:41:07 jenglish Exp $
   3 #
   4 # Combobox bindings.
   5 #
   6 # Each combobox $cb has a child $cb.popdown, which contains
   7 # a listbox $cb.popdown.l and a scrollbar.  The listbox -listvariable
   8 # is set to a namespace variable, which is used to synchronize the
   9 # combobox values with the listbox values.
  10 #
  11 # <<NOTE-WM-TRANSIENT>>:
  12 #
  13 #       Need to set [wm transient] just before mapping the popdown
  14 #       instead of when it's created, in case a containing frame
  15 #       has been reparented [#1818441].
  16 #
  17 #       On Windows: setting [wm transient] prevents the parent
  18 #       toplevel from becoming inactive when the popdown is posted
  19 #       (Tk 8.4.8+)
  20 #
  21 #       On X11: WM_TRANSIENT_FOR on override-redirect windows
  22 #       may be used by compositing managers and by EWMH-aware
  23 #       window managers (even though the older ICCCM spec says
  24 #       it's meaningless).
  25 #
  26 #       On OSX: [wm transient] does utterly the wrong thing.
  27 #       Instead, we use [MacWindowStyle "help" "noActivates hideOnSuspend"].
  28 #       The "noActivates" attribute prevents the parent toplevel
  29 #       from deactivating when the popdown is posted, and is also
  30 #       necessary for "help" windows to receive mouse events.
  31 #       "hideOnSuspend" makes the popdown disappear (resp. reappear)
  32 #       when the parent toplevel is deactivated (resp. reactivated).
  33 #       (see [#1814778]).  Also set [wm resizable 0 0], to prevent
  34 #       TkAqua from shrinking the scrollbar to make room for a grow box
  35 #       that isn't there.
  36 #
  37 #       In order to work around other platform quirks in TkAqua,
  38 #       [grab] and [focus] are set in <Map> bindings instead of
  39 #       immediately after deiconifying the window.
  40 #
  41
  42 namespace eval ttk::combobox {
  43     variable Values     ;# Values($cb) is -listvariable of listbox widget
  44     variable State
  45     set State(entryPress) 0
  46 }
  47
  48 ### Combobox bindings.
  49 #
  50 # Duplicate the Entry bindings, override if needed:
  51 #
  52
  53 ttk::copyBindings TEntry TCombobox
  54
  55 bind TCombobox <KeyPress-Down>          { ttk::combobox::Post %W }
  56 bind TCombobox <KeyPress-Escape>        { ttk::combobox::Unpost %W }
  57
  58 bind TCombobox <ButtonPress-1>          { ttk::combobox::Press "" %W %x %y }
  59 bind TCombobox <Shift-ButtonPress-1>    { ttk::combobox::Press "s" %W %x %y }
  60 bind TCombobox <Double-ButtonPress-1>   { ttk::combobox::Press "2" %W %x %y }
  61 bind TCombobox <Triple-ButtonPress-1>   { ttk::combobox::Press "3" %W %x %y }
  62 bind TCombobox <B1-Motion>              { ttk::combobox::Drag %W %x }
  63
  64 bind TCombobox <MouseWheel>     { ttk::combobox::Scroll %W [expr {%D/-120}] }
  65 if {[tk windowingsystem] eq "x11"} {
  66     bind TCombobox <ButtonPress-4>      { ttk::combobox::Scroll %W -1 }
  67     bind TCombobox <ButtonPress-5>      { ttk::combobox::Scroll %W  1 }
  68 }
  69
  70 bind TCombobox <<TraverseIn>>           { ttk::combobox::TraverseIn %W }
  71
  72 ### Combobox listbox bindings.
  73 #
  74 bind ComboboxListbox <ButtonRelease-1>  { ttk::combobox::LBSelected %W }
  75 bind ComboboxListbox <KeyPress-Return>  { ttk::combobox::LBSelected %W }
  76 bind ComboboxListbox <KeyPress-Escape>  { ttk::combobox::LBCancel %W }
  77 bind ComboboxListbox <KeyPress-Tab>     { ttk::combobox::LBTab %W next }
  78 bind ComboboxListbox <<PrevWindow>>     { ttk::combobox::LBTab %W prev }
  79 bind ComboboxListbox <Destroy>          { ttk::combobox::LBCleanup %W }
  80 bind ComboboxListbox <Motion>           { ttk::combobox::LBHover %W %x %y }
  81 bind ComboboxListbox <Map>              { focus -force %W }
  82
  83 switch -- [tk windowingsystem] {
  84     win32 {
  85         # Dismiss listbox when user switches to a different application.
  86         # NB: *only* do this on Windows (see #1814778)
  87         bind ComboboxListbox <FocusOut>         { ttk::combobox::LBCancel %W }
  88     }
  89 }
  90
  91 ### Combobox popdown window bindings.
  92 #
  93 bind ComboboxPopdown    <Map>           { ttk::combobox::MapPopdown %W }
  94 bind ComboboxPopdown    <Unmap>         { ttk::combobox::UnmapPopdown %W }
  95 bind ComboboxPopdown    <ButtonPress> \
  96                         { ttk::combobox::Unpost [winfo parent %W] }
  97
  98 ### Option database settings.
  99 #
 100
 101 option add *TCombobox*Listbox.font TkTextFont
 102 option add *TCombobox*Listbox.relief flat
 103 option add *TCombobox*Listbox.highlightThickness 0
 104
 105 ## Platform-specific settings.
 106 #
 107 switch -- [tk windowingsystem] {
 108     x11 {
 109         option add *TCombobox*Listbox.background white
 110     }
 111     aqua {
 112         option add *TCombobox*Listbox.borderWidth 0
 113     }
 114 }
 115
 116 ### Binding procedures.
 117 #
 118
 119 ## Press $mode $x $y -- ButtonPress binding for comboboxes.
 120 #       Either post/unpost the listbox, or perform Entry widget binding,
 121 #       depending on widget state and location of button press.
 122 #
 123 proc ttk::combobox::Press {mode w x y} {
 124     variable State
 125     set State(entryPress) [expr {
 126            [$w instate {!readonly !disabled}]
 127         && [string match *textarea [$w identify $x $y]]
 128     }]
 129
 130     focus $w
 131     if {$State(entryPress)} {
 132         switch -- $mode {
 133             s   { ttk::entry::Shift-Press $w $x         ; # Shift }
 134             2   { ttk::entry::Select $w $x word         ; # Double click}
 135             3   { ttk::entry::Select $w $x line         ; # Triple click }
 136             ""  -
 137             default { ttk::entry::Press $w $x }
 138         }
 139     } else {
 140         Post $w
 141     }
 142 }
 143
 144 ## Drag -- B1-Motion binding for comboboxes.
 145 #       If the initial ButtonPress event was handled by Entry binding,
 146 #       perform Entry widget drag binding; otherwise nothing.
 147 #
 148 proc ttk::combobox::Drag {w x}  {
 149     variable State
 150     if {$State(entryPress)} {
 151         ttk::entry::Drag $w $x
 152     }
 153 }
 154
 155 ## TraverseIn -- receive focus due to keyboard navigation
 156 #       For editable comboboxes, set the selection and insert cursor.
 157 #
 158 proc ttk::combobox::TraverseIn {w} {
 159     $w instate {!readonly !disabled} {
 160         $w selection range 0 end
 161         $w icursor end
 162     }
 163 }
 164
 165 ## SelectEntry $cb $index --
 166 #       Set the combobox selection in response to a user action.
 167 #
 168 proc ttk::combobox::SelectEntry {cb index} {
 169     $cb current $index
 170     $cb selection range 0 end
 171     $cb icursor end
 172     event generate $cb <<ComboboxSelected>> -when mark
 173 }
 174
 175 ## Scroll -- Mousewheel binding
 176 #
 177 proc ttk::combobox::Scroll {cb dir} {
 178     $cb instate disabled { return }
 179     set max [llength [$cb cget -values]]
 180     set current [$cb current]
 181     incr current $dir
 182     if {$max != 0 && $current == $current % $max} {
 183         SelectEntry $cb $current
 184     }
 185 }
 186
 187 ## LBSelected $lb -- Activation binding for listbox
 188 #       Set the combobox value to the currently-selected listbox value
 189 #       and unpost the listbox.
 190 #
 191 proc ttk::combobox::LBSelected {lb} {
 192     set cb [LBMaster $lb]
 193     LBSelect $lb
 194     Unpost $cb
 195     focus $cb
 196 }
 197
 198 ## LBCancel --
 199 #       Unpost the listbox.
 200 #
 201 proc ttk::combobox::LBCancel {lb} {
 202     Unpost [LBMaster $lb]
 203 }
 204
 205 ## LBTab -- Tab key binding for combobox listbox.
 206 #       Set the selection, and navigate to next/prev widget.
 207 #
 208 proc ttk::combobox::LBTab {lb dir} {
 209     set cb [LBMaster $lb]
 210     switch -- $dir {
 211         next    { set newFocus [tk_focusNext $cb] }
 212         prev    { set newFocus [tk_focusPrev $cb] }
 213     }
 214
 215     if {$newFocus ne ""} {
 216         LBSelect $lb
 217         Unpost $cb
 218         # The [grab release] call in [Unpost] queues events that later
 219         # re-set the focus.  [update] to make sure these get processed first:
 220         update
 221         ttk::traverseTo $newFocus
 222     }
 223 }
 224
 225 ## LBHover -- <Motion> binding for combobox listbox.
 226 #       Follow selection on mouseover.
 227 #
 228 proc ttk::combobox::LBHover {w x y} {
 229     $w selection clear 0 end
 230     $w activate @$x,$y
 231     $w selection set @$x,$y
 232 }
 233
 234 ## MapPopdown -- <Map> binding for ComboboxPopdown
 235 #
 236 proc ttk::combobox::MapPopdown {w} {
 237     [winfo parent $w] state pressed
 238     ttk::globalGrab $w
 239 }
 240
 241 ## UnmapPopdown -- <Unmap> binding for ComboboxPopdown
 242 #
 243 proc ttk::combobox::UnmapPopdown {w} {
 244     [winfo parent $w] state !pressed
 245     ttk::releaseGrab $w
 246 }
 247
 248 ###
 249 #
 250
 251 namespace eval ::ttk::combobox {
 252     # @@@ Until we have a proper native scrollbar on Aqua, use
 253     # @@@ the regular Tk one.  Use ttk::scrollbar on other platforms.
 254     variable scrollbar ttk::scrollbar
 255     if {[tk windowingsystem] eq "aqua"} {
 256         set scrollbar ::scrollbar
 257     }
 258 }
 259
 260 ## PopdownWindow --
 261 #       Returns the popdown widget associated with a combobox,
 262 #       creating it if necessary.
 263 #
 264 proc ttk::combobox::PopdownWindow {cb} {
 265     variable scrollbar
 266
 267     if {![winfo exists $cb.popdown]} {
 268         set popdown [PopdownToplevel $cb.popdown]
 269
 270         $scrollbar $popdown.sb \
 271             -orient vertical -command [list $popdown.l yview]
 272         listbox $popdown.l \
 273             -listvariable ttk::combobox::Values($cb) \
 274             -yscrollcommand [list $popdown.sb set] \
 275             -exportselection false \
 276             -selectmode browse \
 277             -activestyle none \
 278             ;
 279
 280         bindtags $popdown.l \
 281             [list $popdown.l ComboboxListbox Listbox $popdown all]
 282
 283         grid $popdown.l $popdown.sb -sticky news
 284         grid columnconfigure $popdown 0 -weight 1
 285         grid rowconfigure $popdown 0 -weight 1
 286     }
 287     return $cb.popdown
 288 }
 289
 290 ## PopdownToplevel -- Create toplevel window for the combobox popdown
 291 #
 292 #       See also <<NOTE-WM-TRANSIENT>>
 293 #
 294 proc ttk::combobox::PopdownToplevel {w} {
 295     toplevel $w -class ComboboxPopdown
 296     wm withdraw $w
 297     switch -- [tk windowingsystem] {
 298         default -
 299         x11 {
 300             $w configure -relief solid -borderwidth 1
 301             wm overrideredirect $w true
 302         }
 303         win32 {
 304             $w configure -relief solid -borderwidth 1
 305             wm overrideredirect $w true
 306         }
 307         aqua {
 308             $w configure -relief solid -borderwidth 0
 309             tk::unsupported::MacWindowStyle style $w \
 310                 help {noActivates hideOnSuspend}
 311             wm resizable $w 0 0
 312         }
 313     }
 314     return $w
 315 }
 316
 317 ## ConfigureListbox --
 318 #       Set listbox values, selection, height, and scrollbar visibility
 319 #       from current combobox values.
 320 #
 321 proc ttk::combobox::ConfigureListbox {cb} {
 322     variable Values
 323
 324     set popdown [PopdownWindow $cb]
 325     set values [$cb cget -values]
 326     set current [$cb current]
 327     if {$current < 0} {
 328         set current 0           ;# no current entry, highlight first one
 329     }
 330     set Values($cb) $values
 331     $popdown.l selection clear 0 end
 332     $popdown.l selection set $current
 333     $popdown.l activate $current
 334     $popdown.l see $current
 335     set height [llength $values]
 336     if {$height > [$cb cget -height]} {
 337         set height [$cb cget -height]
 338         grid $popdown.sb
 339     } else {
 340         grid remove $popdown.sb
 341     }
 342     $popdown.l configure -height $height
 343 }
 344
 345 ## PlacePopdown --
 346 #       Set popdown window geometry.
 347 #
 348 # @@@TODO: factor with menubutton::PostPosition
 349 #
 350 proc ttk::combobox::PlacePopdown {cb popdown} {
 351     set x [winfo rootx $cb]
 352     set y [winfo rooty $cb]
 353     set w [winfo width $cb]
 354     set h [winfo height $cb]
 355     set postoffset [ttk::style lookup TCombobox -postoffset {} {0 0 0 0}]
 356     foreach var {x y w h} delta $postoffset {
 357         incr $var $delta
 358     }
 359
 360     set H [winfo reqheight $popdown]
 361     if {$y + $h + $H > [winfo screenheight $popdown]} {
 362         set Y [expr {$y - $H}]
 363     } else {
 364         set Y [expr {$y + $h}]
 365     }
 366     wm geometry $popdown ${w}x${H}+${x}+${Y}
 367 }
 368
 369 ## Post $cb --
 370 #       Pop down the associated listbox.
 371 #
 372 proc ttk::combobox::Post {cb} {
 373     # Don't do anything if disabled:
 374     #
 375     $cb instate disabled { return }
 376
 377     # ASSERT: ![$cb instate pressed]
 378
 379     # Run -postcommand callback:
 380     #
 381     uplevel #0 [$cb cget -postcommand]
 382
 383     set popdown [PopdownWindow $cb]
 384     ConfigureListbox $cb
 385     update idletasks
 386     PlacePopdown $cb $popdown
 387     # See <<NOTE-WM-TRANSIENT>>
 388     switch -- [tk windowingsystem] {
 389         x11 - win32 { wm transient $popdown [winfo toplevel $cb] }
 390     }
 391
 392     # Post the listbox:
 393     #
 394     wm deiconify $popdown
 395     raise $popdown
 396 }
 397
 398 ## Unpost $cb --
 399 #       Unpost the listbox.
 400 #
 401 proc ttk::combobox::Unpost {cb} {
 402     if {[winfo exists $cb.popdown]} {
 403         wm withdraw $cb.popdown
 404     }
 405     grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190]
 406 }
 407
 408 ## LBMaster $lb --
 409 #       Return the combobox main widget that owns the listbox.
 410 #
 411 proc ttk::combobox::LBMaster {lb} {
 412     winfo parent [winfo parent $lb]
 413 }
 414
 415 ## LBSelect $lb --
 416 #       Transfer listbox selection to combobox value.
 417 #
 418 proc ttk::combobox::LBSelect {lb} {
 419     set cb [LBMaster $lb]
 420     set selection [$lb curselection]
 421     if {[llength $selection] == 1} {
 422         SelectEntry $cb [lindex $selection 0]
 423     }
 424 }
 425
 426 ## LBCleanup $lb --
 427 #       <Destroy> binding for combobox listboxes.
 428 #       Cleans up by unsetting the linked textvariable.
 429 #
 430 #       Note: we can't just use { unset [%W cget -listvariable] }
 431 #       because the widget command is already gone when this binding fires).
 432 #       [winfo parent] still works, fortunately.
 433 #
 434 proc ttk::combobox::LBCleanup {lb} {
 435     variable Values
 436     unset Values([LBMaster $lb])
 437 }
 438
 439 #*EOF*