combobox.tcl (12493B)
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 widgetDefault 92 option add *TCombobox*Listbox.relief flat widgetDefault 93 option add *TCombobox*Listbox.highlightThickness 0 widgetDefault 94 95 ## Platform-specific settings. 96 # 97 switch -- [tk windowingsystem] { 98 x11 { 99 option add *TCombobox*Listbox.background white widgetDefault 100 } 101 aqua { 102 option add *TCombobox*Listbox.borderWidth 0 widgetDefault 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 116 $w instate disabled { return } 117 118 set State(entryPress) [expr { 119 [$w instate !readonly] 120 && [string match *textarea [$w identify element $x $y]] 121 }] 122 123 focus $w 124 if {$State(entryPress)} { 125 switch -- $mode { 126 s { ttk::entry::Shift-Press $w $x ; # Shift } 127 2 { ttk::entry::Select $w $x word ; # Double click} 128 3 { ttk::entry::Select $w $x line ; # Triple click } 129 "" - 130 default { ttk::entry::Press $w $x } 131 } 132 } else { 133 Post $w 134 } 135 } 136 137 ## Drag -- B1-Motion binding for comboboxes. 138 # If the initial ButtonPress event was handled by Entry binding, 139 # perform Entry widget drag binding; otherwise nothing. 140 # 141 proc ttk::combobox::Drag {w x} { 142 variable State 143 if {$State(entryPress)} { 144 ttk::entry::Drag $w $x 145 } 146 } 147 148 ## Motion -- 149 # Set cursor. 150 # 151 proc ttk::combobox::Motion {w x y} { 152 if { [$w identify $x $y] eq "textarea" 153 && [$w instate {!readonly !disabled}] 154 } { 155 ttk::setCursor $w text 156 } else { 157 ttk::setCursor $w "" 158 } 159 } 160 161 ## TraverseIn -- receive focus due to keyboard navigation 162 # For editable comboboxes, set the selection and insert cursor. 163 # 164 proc ttk::combobox::TraverseIn {w} { 165 $w instate {!readonly !disabled} { 166 $w selection range 0 end 167 $w icursor end 168 } 169 } 170 171 ## SelectEntry $cb $index -- 172 # Set the combobox selection in response to a user action. 173 # 174 proc ttk::combobox::SelectEntry {cb index} { 175 $cb current $index 176 $cb selection range 0 end 177 $cb icursor end 178 event generate $cb <<ComboboxSelected>> -when mark 179 } 180 181 ## Scroll -- Mousewheel binding 182 # 183 proc ttk::combobox::Scroll {cb dir} { 184 $cb instate disabled { return } 185 set max [llength [$cb cget -values]] 186 set current [$cb current] 187 incr current $dir 188 if {$max != 0 && $current == $current % $max} { 189 SelectEntry $cb $current 190 } 191 } 192 193 ## LBSelected $lb -- Activation binding for listbox 194 # Set the combobox value to the currently-selected listbox value 195 # and unpost the listbox. 196 # 197 proc ttk::combobox::LBSelected {lb} { 198 set cb [LBMaster $lb] 199 LBSelect $lb 200 Unpost $cb 201 focus $cb 202 } 203 204 ## LBCancel -- 205 # Unpost the listbox. 206 # 207 proc ttk::combobox::LBCancel {lb} { 208 Unpost [LBMaster $lb] 209 } 210 211 ## LBTab -- Tab key binding for combobox listbox. 212 # Set the selection, and navigate to next/prev widget. 213 # 214 proc ttk::combobox::LBTab {lb dir} { 215 set cb [LBMaster $lb] 216 switch -- $dir { 217 next { set newFocus [tk_focusNext $cb] } 218 prev { set newFocus [tk_focusPrev $cb] } 219 } 220 221 if {$newFocus ne ""} { 222 LBSelect $lb 223 Unpost $cb 224 # The [grab release] call in [Unpost] queues events that later 225 # re-set the focus (@@@ NOTE: this might not be true anymore). 226 # Set new focus later: 227 after 0 [list ttk::traverseTo $newFocus] 228 } 229 } 230 231 ## LBHover -- <Motion> binding for combobox listbox. 232 # Follow selection on mouseover. 233 # 234 proc ttk::combobox::LBHover {w x y} { 235 $w selection clear 0 end 236 $w activate @$x,$y 237 $w selection set @$x,$y 238 } 239 240 ## MapPopdown -- <Map> binding for ComboboxPopdown 241 # 242 proc ttk::combobox::MapPopdown {w} { 243 [winfo parent $w] state pressed 244 ttk::globalGrab $w 245 } 246 247 ## UnmapPopdown -- <Unmap> binding for ComboboxPopdown 248 # 249 proc ttk::combobox::UnmapPopdown {w} { 250 [winfo parent $w] state !pressed 251 ttk::releaseGrab $w 252 } 253 254 ### 255 # 256 257 namespace eval ::ttk::combobox { 258 # @@@ Until we have a proper native scrollbar on Aqua, use 259 # @@@ the regular Tk one. Use ttk::scrollbar on other platforms. 260 variable scrollbar ttk::scrollbar 261 if {[tk windowingsystem] eq "aqua"} { 262 set scrollbar ::scrollbar 263 } 264 } 265 266 ## PopdownWindow -- 267 # Returns the popdown widget associated with a combobox, 268 # creating it if necessary. 269 # 270 proc ttk::combobox::PopdownWindow {cb} { 271 variable scrollbar 272 273 if {![winfo exists $cb.popdown]} { 274 set poplevel [PopdownToplevel $cb.popdown] 275 set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame] 276 277 $scrollbar $popdown.sb \ 278 -orient vertical -command [list $popdown.l yview] 279 listbox $popdown.l \ 280 -listvariable ttk::combobox::Values($cb) \ 281 -yscrollcommand [list $popdown.sb set] \ 282 -exportselection false \ 283 -selectmode browse \ 284 -activestyle none \ 285 ; 286 287 bindtags $popdown.l \ 288 [list $popdown.l ComboboxListbox Listbox $popdown all] 289 290 grid $popdown.l -row 0 -column 0 -padx {1 0} -pady 1 -sticky nsew 291 grid $popdown.sb -row 0 -column 1 -padx {0 1} -pady 1 -sticky ns 292 grid columnconfigure $popdown 0 -weight 1 293 grid rowconfigure $popdown 0 -weight 1 294 295 grid $popdown -sticky news -padx 0 -pady 0 296 grid rowconfigure $poplevel 0 -weight 1 297 grid columnconfigure $poplevel 0 -weight 1 298 } 299 return $cb.popdown 300 } 301 302 ## PopdownToplevel -- Create toplevel window for the combobox popdown 303 # 304 # See also <<NOTE-WM-TRANSIENT>> 305 # 306 proc ttk::combobox::PopdownToplevel {w} { 307 toplevel $w -class ComboboxPopdown 308 wm withdraw $w 309 switch -- [tk windowingsystem] { 310 default - 311 x11 { 312 $w configure -relief flat -borderwidth 0 313 wm attributes $w -type combo 314 wm overrideredirect $w true 315 } 316 win32 { 317 $w configure -relief flat -borderwidth 0 318 wm overrideredirect $w true 319 wm attributes $w -topmost 1 320 } 321 aqua { 322 $w configure -relief solid -borderwidth 0 323 tk::unsupported::MacWindowStyle style $w \ 324 help {noActivates hideOnSuspend} 325 wm resizable $w 0 0 326 } 327 } 328 return $w 329 } 330 331 ## ConfigureListbox -- 332 # Set listbox values, selection, height, and scrollbar visibility 333 # from current combobox values. 334 # 335 proc ttk::combobox::ConfigureListbox {cb} { 336 variable Values 337 338 set popdown [PopdownWindow $cb].f 339 set values [$cb cget -values] 340 set current [$cb current] 341 if {$current < 0} { 342 set current 0 ;# no current entry, highlight first one 343 } 344 set Values($cb) $values 345 $popdown.l selection clear 0 end 346 $popdown.l selection set $current 347 $popdown.l activate $current 348 $popdown.l see $current 349 set height [llength $values] 350 if {$height > [$cb cget -height]} { 351 set height [$cb cget -height] 352 grid $popdown.sb 353 grid configure $popdown.l -padx {1 0} 354 } else { 355 grid remove $popdown.sb 356 grid configure $popdown.l -padx 1 357 } 358 $popdown.l configure -height $height 359 } 360 361 ## PlacePopdown -- 362 # Set popdown window geometry. 363 # 364 # @@@TODO: factor with menubutton::PostPosition 365 # 366 proc ttk::combobox::PlacePopdown {cb popdown} { 367 set x [winfo rootx $cb] 368 set y [winfo rooty $cb] 369 set w [winfo width $cb] 370 set h [winfo height $cb] 371 set style [$cb cget -style] 372 set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}] 373 foreach var {x y w h} delta $postoffset { 374 incr $var $delta 375 } 376 377 set H [winfo reqheight $popdown] 378 if {$y + $h + $H > [winfo screenheight $popdown]} { 379 set Y [expr {$y - $H}] 380 } else { 381 set Y [expr {$y + $h}] 382 } 383 wm geometry $popdown ${w}x${H}+${x}+${Y} 384 } 385 386 ## Post $cb -- 387 # Pop down the associated listbox. 388 # 389 proc ttk::combobox::Post {cb} { 390 # Don't do anything if disabled: 391 # 392 $cb instate disabled { return } 393 394 # ASSERT: ![$cb instate pressed] 395 396 # Run -postcommand callback: 397 # 398 uplevel #0 [$cb cget -postcommand] 399 400 set popdown [PopdownWindow $cb] 401 ConfigureListbox $cb 402 update idletasks ;# needed for geometry propagation. 403 PlacePopdown $cb $popdown 404 # See <<NOTE-WM-TRANSIENT>> 405 switch -- [tk windowingsystem] { 406 x11 - win32 { wm transient $popdown [winfo toplevel $cb] } 407 } 408 409 # Post the listbox: 410 # 411 wm attribute $popdown -topmost 1 412 wm deiconify $popdown 413 raise $popdown 414 } 415 416 ## Unpost $cb -- 417 # Unpost the listbox. 418 # 419 proc ttk::combobox::Unpost {cb} { 420 if {[winfo exists $cb.popdown]} { 421 wm withdraw $cb.popdown 422 } 423 grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190] 424 } 425 426 ## LBMaster $lb -- 427 # Return the combobox main widget that owns the listbox. 428 # 429 proc ttk::combobox::LBMaster {lb} { 430 winfo parent [winfo parent [winfo parent $lb]] 431 } 432 433 ## LBSelect $lb -- 434 # Transfer listbox selection to combobox value. 435 # 436 proc ttk::combobox::LBSelect {lb} { 437 set cb [LBMaster $lb] 438 set selection [$lb curselection] 439 if {[llength $selection] == 1} { 440 SelectEntry $cb [lindex $selection 0] 441 } 442 } 443 444 ## LBCleanup $lb -- 445 # <Destroy> binding for combobox listboxes. 446 # Cleans up by unsetting the linked textvariable. 447 # 448 # Note: we can't just use { unset [%W cget -listvariable] } 449 # because the widget command is already gone when this binding fires). 450 # [winfo parent] still works, fortunately. 451 # 452 proc ttk::combobox::LBCleanup {lb} { 453 variable Values 454 unset Values([LBMaster $lb]) 455 } 456 457 #*EOF*