Posted to tcl by Stu at Sat Jan 29 11:35:44 GMT 2022view raw

  1. bind TCombobox <Key> [list comboKey %W %A]
  2.  
  3. proc comboKey {combo key} {
  4. if {$key eq ""} { return }
  5. if {[set curIdx [$combo current]] == {}} { return }
  6. if {[set newIdx [getNextOrPrevMatch [$combo cget -values] $key $curIdx [string is upper $key]]] == -1} { return }
  7. comboGo $combo $newIdx
  8. }
  9.  
  10. proc comboGo {combo where} {
  11. if {[set curIdx [$combo current]] == {}} { return }
  12. set nitems [llength [$combo cget -values]]
  13. incr nitems -1
  14. set idx $curIdx
  15. switch -exact -- $where {
  16. home { set idx 0 }
  17. end { set idx $nitems }
  18. next { incr idx }
  19. prior { incr idx -1 }
  20. default { set idx $where }
  21. }; # hctiws
  22. if {$idx < 0 || $idx > $nitems || $idx == $curIdx} { return }
  23. $combo current $idx
  24. event generate $combo <<SelectAll>>
  25. event generate $combo <<ComboboxSelected>>
  26. }
  27.  
  28. proc getNextOrPrevMatch {aList aString {curIdx 0} {backwards no}} {
  29. set idxs [lsearch -all -nocase $aList $aString*]
  30. if {[llength $idxs] == 0} { return -1 }
  31. if {[llength $idxs] == 1 && [lindex $idxs 0] == $curIdx} { return -1 }
  32. set p -1
  33. foreach idx $idxs {
  34. if {$idx < $curIdx} { set p $idx }
  35. if {$idx > $curIdx} { break }
  36. }
  37. if {$backwards} {
  38. if {$p == -1} {
  39. set newIdx [lindex $idxs end]
  40. } else {
  41. set newIdx $p
  42. }
  43. } else {
  44. if {$idx == $curIdx} {
  45. set newIdx [lindex $idxs 0]
  46. } else {
  47. set newIdx $idx
  48. }
  49. }
  50. return $newIdx
  51. }