combobox.tcl 12 KB

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