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

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