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

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