home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / comp / lang / tcl / 1062 < prev    next >
Encoding:
Text File  |  1992-07-28  |  2.9 KB  |  105 lines
  1. Newsgroups: comp.lang.tcl
  2. Path: sparky!uunet!eco.twg.com!twg.com!news
  3. From: "David Herron" <david@twg.com>
  4. Subject: keyboard-driven listbox widget 
  5. Message-ID: <1992Jul28.215429.19609@twg.com>
  6. Sensitivity: Personal
  7. Encoding:  7 TEXT , 82 TEXT 
  8. Sender: news@twg.com (USENET News System)
  9. Conversion: Prohibited
  10. Organization: The Wollongong Group, Inc., Palo Alto, CA
  11. Conversion-With-Loss: Prohibited
  12. Date: Tue, 28 Jul 1992 21:56:13 GMT
  13. Lines: 90
  14.  
  15. Greetings!
  16.  
  17. The following is code I use for driving listboxes from a keyboard.  This
  18. lets you use UP, DOWN, PgUp and PgDn keys to scroll the listbox.  It requires
  19. that keyboard focus has been pointed at the listbox, one easy way to do
  20. this is with the FOCUS module.
  21.  
  22.  
  23. #!/usr/local/bin/wish -f
  24. #
  25. # $Id: util.tcl,v 1.4 1992/07/23 05:09:46 david Exp $
  26. # util -- Some utility procedures.
  27. #
  28. # $Log: util.tcl,v $
  29. # Revision 1.4  1992/07/23  05:09:46  david
  30. # Add function to bind the listbox properly.
  31. #
  32. # Revision 1.3  1992/07/15  04:17:24  david
  33. # Add code for doing BUSY indicators.
  34. #
  35. # Revision 1.2  1992/06/05  03:56:34  david
  36. # Had problems with foreach{}'s controlled by a [$list curselection]
  37. # derived list.  If we modified the list (added or deleted members) the
  38. # offsets were thrown off.  Meaning the actions acted on the wrong
  39. # list members.  Changed to repeatadly do [$list curselection] ...
  40. #
  41. # Revision 1.1  1992/05/27  06:51:29  david
  42. # Initial revision.
  43. #
  44. #
  45.  
  46.  
  47. # LISTBOX:scroll -- Scroll a listbox by one line in the given direction.
  48. proc LISTBOX:scroll {list scroll direction} {
  49.     set cur   [$scroll get]
  50.     set first [lindex $cur 2]
  51.  
  52.     if { $direction == "down" } {
  53.          set new [expr $first+1]
  54.          $list yview $new
  55.     } else {
  56.          set new [expr $first-1]
  57.          $list yview $new
  58.     }
  59.  
  60.     $list select from $new
  61. }
  62.  
  63. # LISTBOX:scrollPage -- Scroll a listbox by one `page' in the given direction.
  64. #    A page is the current `height' of the listbox.
  65. proc LISTBOX:scrollPage {list scroll direction} {
  66.     set cur   [$scroll get]
  67.     set win   [lindex $cur 1]
  68.     set first [lindex $cur 2]
  69.  
  70.     if { $direction == "down" } {
  71.          set new [expr $first+$win]
  72.          $list yview $new
  73.     } else {
  74.          set new [expr $first-$win]
  75.          $list yview $new
  76.     }
  77.  
  78.     $list select from $new
  79. }
  80.  
  81.  
  82. proc LISTBOX:bind {{list} {scroll}} {
  83.     bind $list <Key-Down>    "LISTBOX:scroll %W $scroll down "
  84.     bind $list <Key-Up>    "LISTBOX:scroll %W $scroll up   "
  85.  
  86.     # On Sun type-4 keyboard these are marked: PgDn & PgUp
  87.     # If this does not work for you, use `xev' to find
  88.     # the values for the keys you prefer to use.
  89.     # <Shift-Up> or <M-Up> are both good possibilities.
  90.     bind $list <Key-F35> "LISTBOX:scrollPage %W $scroll down "
  91.     bind $list <Key-F29> "LISTBOX:scrollPage %W $scroll up   "
  92.  
  93.     # Next & Prior are from the HDS FX-15
  94.     bind $list <Key-Next>  "LISTBOX:scrollPage %W $scroll down "
  95.     bind $list <Key-Prior> "LISTBOX:scrollPage %W $scroll up   "
  96. }
  97.  
  98. # LISTBOX:firstSel -- Return the first selected entry.
  99. proc LISTBOX:firstSel list {
  100.     set l [$list curselection]
  101.     if {$l == ""} { return "" }
  102.     return [lindex $l 0]
  103. }
  104.  
  105.