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
 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 postoffset [ttk::style lookup TCombobox -postoffset {} {0 0 0 0}]
 372     foreach var {x y w h} delta $postoffset {
 373         incr $var $delta
 374     }
 375
 376     set H [winfo reqheight $popdown]
 377     if {$y + $h + $H > [winfo screenheight $popdown]} {
 378         set Y [expr {$y - $H}]
 379     } else {
 380         set Y [expr {$y + $h}]
 381     }
 382     wm geometry $popdown ${w}x${H}+${x}+${Y}
 383 }
 384
 385 ## Post $cb --
 386 #       Pop down the associated listbox.
 387 #
 388 proc ttk::combobox::Post {cb} {
 389     # Don't do anything if disabled:
 390     #
 391     $cb instate disabled { return }
 392
 393     # ASSERT: ![$cb instate pressed]
 394
 395     # Run -postcommand callback:
 396     #
 397     uplevel #0 [$cb cget -postcommand]
 398
 399     set popdown [PopdownWindow $cb]
 400     ConfigureListbox $cb
 401     update idletasks    ;# needed for geometry propagation.
 402     PlacePopdown $cb $popdown
 403     # See <<NOTE-WM-TRANSIENT>>
 404     switch -- [tk windowingsystem] {
 405         x11 - win32 { wm transient $popdown [winfo toplevel $cb] }
 406     }
 407
 408     # Post the listbox:
 409     #
 410     wm attribute $popdown -topmost 1
 411     wm deiconify $popdown
 412     raise $popdown
 413 }
 414
 415 ## Unpost $cb --
 416 #       Unpost the listbox.
 417 #
 418 proc ttk::combobox::Unpost {cb} {
 419     if {[winfo exists $cb.popdown]} {
 420         wm withdraw $cb.popdown
 421     }
 422     grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190]
 423 }
 424
 425 ## LBMaster $lb --
 426 #       Return the combobox main widget that owns the listbox.
 427 #
 428 proc ttk::combobox::LBMaster {lb} {
 429     winfo parent [winfo parent [winfo parent $lb]]
 430 }
 431
 432 ## LBSelect $lb --
 433 #       Transfer listbox selection to combobox value.
 434 #
 435 proc ttk::combobox::LBSelect {lb} {
 436     set cb [LBMaster $lb]
 437     set selection [$lb curselection]
 438     if {[llength $selection] == 1} {
 439         SelectEntry $cb [lindex $selection 0]
 440     }
 441 }
 442
 443 ## LBCleanup $lb --
 444 #       <Destroy> binding for combobox listboxes.
 445 #       Cleans up by unsetting the linked textvariable.
 446 #
 447 #       Note: we can't just use { unset [%W cget -listvariable] }
 448 #       because the widget command is already gone when this binding fires).
 449 #       [winfo parent] still works, fortunately.
 450 #
 451 proc ttk::combobox::LBCleanup {lb} {
 452     variable Values
 453     unset Values([LBMaster $lb])
 454 }
 455
 456 #*EOF*