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

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