home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / library / listbox.tcl < prev    next >
Encoding:
Text File  |  1995-06-08  |  10.7 KB  |  428 lines
  1. # listbox.tcl --
  2. #
  3. # This file defines the default bindings for Tk listbox widgets
  4. # and provides procedures that help in implementing those bindings.
  5. #
  6. # @(#) listbox.tcl 1.11 95/06/04 17:30:09
  7. #
  8. # Copyright (c) 1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  
  14. #--------------------------------------------------------------------------
  15. # tkPriv elements used in this file:
  16. #
  17. # afterId -        Token returned by "after" for autoscanning.
  18. # listboxPrev -        The last element to be selected or deselected
  19. #            during a selection operation.
  20. # listboxSelection -    All of the items that were selected before the
  21. #            current selection operation (such as a mouse
  22. #            drag) started;  used to cancel an operation.
  23. #--------------------------------------------------------------------------
  24.  
  25. #-------------------------------------------------------------------------
  26. # The code below creates the default class bindings for listboxes.
  27. #-------------------------------------------------------------------------
  28.  
  29. bind Listbox <1> {
  30.     tkListboxBeginSelect %W [%W index @%x,%y]
  31. }
  32. bind Listbox <B1-Motion> {
  33.     set tkPriv(x) %x
  34.     set tkPriv(y) %y
  35.     tkListboxMotion %W [%W index @%x,%y]
  36. }
  37. bind Listbox <ButtonRelease-1> {
  38.     tkCancelRepeat
  39.     %W activate @%x,%y
  40. }
  41. bind Listbox <Shift-1> {
  42.     tkListboxBeginExtend %W [%W index @%x,%y]
  43. }
  44. bind Listbox <Control-1> {
  45.     tkListboxBeginToggle %W [%W index @%x,%y]
  46. }
  47. bind Listbox <B1-Leave> {
  48.     set tkPriv(x) %x
  49.     set tkPriv(y) %y
  50.     tkListboxAutoScan %W
  51. }
  52. bind Listbox <B1-Enter> {
  53.     tkCancelRepeat
  54. }
  55.  
  56. bind Listbox <Up> {
  57.     tkListboxUpDown %W -1
  58. }
  59. bind Listbox <Shift-Up> {
  60.     tkListboxExtendUpDown %W -1
  61. }
  62. bind Listbox <Down> {
  63.     tkListboxUpDown %W 1
  64. }
  65. bind Listbox <Shift-Down> {
  66.     tkListboxExtendUpDown %W 1
  67. }
  68. bind Listbox <Left> {
  69.     %W xview scroll -1 units
  70. }
  71. bind Listbox <Control-Left> {
  72.     %W xview scroll -1 pages
  73. }
  74. bind Listbox <Right> {
  75.     %W xview scroll 1 units
  76. }
  77. bind Listbox <Control-Right> {
  78.     %W xview scroll 1 pages
  79. }
  80. bind Listbox <Prior> {
  81.     %W yview scroll -1 pages
  82. }
  83. bind Listbox <Next> {
  84.     %W yview scroll 1 pages
  85. }
  86. bind Listbox <Control-Prior> {
  87.     %W xview scroll -1 pages
  88. }
  89. bind Listbox <Control-Next> {
  90.     %W xview scroll 1 pages
  91. }
  92. bind Listbox <Home> {
  93.     %W xview moveto 0
  94. }
  95. bind Listbox <End> {
  96.     %W xview moveto 1
  97. }
  98. bind Listbox <Control-Home> {
  99.     %W activate 0
  100.     %W see 0
  101.     %W selection clear 0 end
  102.     %W selection set 0
  103. }
  104. bind Listbox <Shift-Control-Home> {
  105.     tkListboxDataExtend %W 0
  106. }
  107. bind Listbox <Control-End> {
  108.     %W activate end
  109.     %W see end
  110.     %W selection clear 0 end
  111.     %W selection set end
  112. }
  113. bind Listbox <Shift-Control-End> {
  114.     tkListboxDataExtend %W end
  115. }
  116. bind Listbox <F16> {
  117.     if {[selection own -displayof %W] == "%W"} {
  118.     clipboard clear -displayof %W
  119.     clipboard append -displayof %W [selection get -displayof %W]
  120.     }
  121. }
  122. bind Listbox <space> {
  123.     tkListboxBeginSelect %W [%W index active]
  124. }
  125. bind Listbox <Select> {
  126.     tkListboxBeginSelect %W [%W index active]
  127. }
  128. bind Listbox <Control-Shift-space> {
  129.     tkListboxBeginExtend %W [%W index active]
  130. }
  131. bind Listbox <Shift-Select> {
  132.     tkListboxBeginExtend %W [%W index active]
  133. }
  134. bind Listbox <Escape> {
  135.     tkListboxCancel %W
  136. }
  137. bind Listbox <Control-slash> {
  138.     tkListboxSelectAll %W
  139. }
  140. bind Listbox <Control-backslash> {
  141.     if {[%W cget -selectmode] != "browse"} {
  142.     %W selection clear 0 end
  143.     }
  144. }
  145.  
  146. # Additional Tk bindings that aren't part of the Motif look and feel:
  147.  
  148. bind Listbox <2> {
  149.     %W scan mark %x %y
  150. }
  151. bind Listbox <B2-Motion> {
  152.     %W scan dragto %x %y
  153. }
  154.  
  155. # tkListboxBeginSelect --
  156. #
  157. # This procedure is typically invoked on button-1 presses.  It begins
  158. # the process of making a selection in the listbox.  Its exact behavior
  159. # depends on the selection mode currently in effect for the listbox;
  160. # see the Motif documentation for details.
  161. #
  162. # Arguments:
  163. # w -        The listbox widget.
  164. # el -        The element for the selection operation (typically the
  165. #        one under the pointer).  Must be in numerical form.
  166.  
  167. proc tkListboxBeginSelect {w el} {
  168.     global tkPriv
  169.     if {[$w cget -selectmode]  == "multiple"} {
  170.     if [$w selection includes $el] {
  171.         $w selection clear $el
  172.     } else {
  173.         $w selection set $el
  174.     }
  175.     } else {
  176.     $w selection clear 0 end
  177.     $w selection set $el
  178.     $w selection anchor $el
  179.     set tkPriv(listboxSelection) {}
  180.     set tkPriv(listboxPrev) $el
  181.     }
  182. }
  183.  
  184. # tkListboxMotion --
  185. #
  186. # This procedure is called to process mouse motion events while
  187. # button 1 is down.  It may move or extend the selection, depending
  188. # on the listbox's selection mode.
  189. #
  190. # Arguments:
  191. # w -        The listbox widget.
  192. # el -        The element under the pointer (must be a number).
  193.  
  194. proc tkListboxMotion {w el} {
  195.     global tkPriv
  196.     if {$el == $tkPriv(listboxPrev)} {
  197.     return
  198.     }
  199.     set anchor [$w index anchor]
  200.     switch [$w cget -selectmode] {
  201.     browse {
  202.         $w selection clear 0 end
  203.         $w selection set $el
  204.         set tkPriv(listboxPrev) $el
  205.     }
  206.     extended {
  207.         set i $tkPriv(listboxPrev)
  208.         if [$w selection includes anchor] {
  209.         $w selection clear $i $el
  210.         $w selection set anchor $el
  211.         } else {
  212.         $w selection clear $i $el
  213.         $w selection clear anchor $el
  214.         }
  215.         while {($i < $el) && ($i < $anchor)} {
  216.         if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
  217.             $w selection set $i
  218.         }
  219.         incr i
  220.         }
  221.         while {($i > $el) && ($i > $anchor)} {
  222.         if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
  223.             $w selection set $i
  224.         }
  225.         incr i -1
  226.         }
  227.         set tkPriv(listboxPrev) $el
  228.     }
  229.     }
  230. }
  231.  
  232. # tkListboxBeginExtend --
  233. #
  234. # This procedure is typically invoked on shift-button-1 presses.  It
  235. # begins the process of extending a selection in the listbox.  Its
  236. # exact behavior depends on the selection mode currently in effect
  237. # for the listbox;  see the Motif documentation for details.
  238. #
  239. # Arguments:
  240. # w -        The listbox widget.
  241. # el -        The element for the selection operation (typically the
  242. #        one under the pointer).  Must be in numerical form.
  243.  
  244. proc tkListboxBeginExtend {w el} {
  245.     if {([$w cget -selectmode] == "extended")
  246.         && [$w selection includes anchor]} {
  247.     tkListboxMotion $w $el
  248.     }
  249. }
  250.  
  251. # tkListboxBeginToggle --
  252. #
  253. # This procedure is typically invoked on control-button-1 presses.  It
  254. # begins the process of toggling a selection in the listbox.  Its
  255. # exact behavior depends on the selection mode currently in effect
  256. # for the listbox;  see the Motif documentation for details.
  257. #
  258. # Arguments:
  259. # w -        The listbox widget.
  260. # el -        The element for the selection operation (typically the
  261. #        one under the pointer).  Must be in numerical form.
  262.  
  263. proc tkListboxBeginToggle {w el} {
  264.     global tkPriv
  265.     if {[$w cget -selectmode] == "extended"} {
  266.     set tkPriv(listboxSelection) [$w curselection]
  267.     set tkPriv(listboxPrev) $el
  268.     $w selection anchor $el
  269.     if [$w selection includes $el] {
  270.         $w selection clear $el
  271.     } else {
  272.         $w selection set $el
  273.     }
  274.     }
  275. }
  276.  
  277. # tkListboxAutoScan --
  278. # This procedure is invoked when the mouse leaves an entry window
  279. # with button 1 down.  It scrolls the window up, down, left, or
  280. # right, depending on where the mouse left the window, and reschedules
  281. # itself as an "after" command so that the window continues to scroll until
  282. # the mouse moves back into the window or the mouse button is released.
  283. #
  284. # Arguments:
  285. # w -        The entry window.
  286.  
  287. proc tkListboxAutoScan {w} {
  288.     global tkPriv
  289.     set x $tkPriv(x)
  290.     set y $tkPriv(y)
  291.     if {$y >= [winfo height $w]} {
  292.     $w yview scroll 1 units
  293.     } elseif {$y < 0} {
  294.     $w yview scroll -1 units
  295.     } elseif {$x >= [winfo width $w]} {
  296.     $w xview scroll 2 units
  297.     } elseif {$x < 0} {
  298.     $w xview scroll -2 units
  299.     } else {
  300.     return
  301.     }
  302.     tkListboxMotion $w [$w index @$x,$y]
  303.     set tkPriv(afterId) [after 50 tkListboxAutoScan $w]
  304. }
  305.  
  306. # tkListboxUpDown --
  307. #
  308. # Moves the location cursor (active element) up or down by one element,
  309. # and changes the selection if we're in browse or extended selection
  310. # mode.
  311. #
  312. # Arguments:
  313. # w -        The listbox widget.
  314. # amount -    +1 to move down one item, -1 to move back one item.
  315.  
  316. proc tkListboxUpDown {w amount} {
  317.     global tkPriv
  318.     $w activate [expr [$w index active] + $amount]
  319.     $w see active
  320.     switch [$w cget -selectmode] {
  321.     browse {
  322.         $w selection clear 0 end
  323.         $w selection set active
  324.     }
  325.     extended {
  326.         $w selection clear 0 end
  327.         $w selection set active
  328.         $w selection anchor active
  329.         set tkPriv(listboxPrev) [$w index active]
  330.         set tkPriv(listboxSelection) {}
  331.     }
  332.     }
  333. }
  334.  
  335. # tkListboxExtendUpDown --
  336. #
  337. # Does nothing unless we're in extended selection mode;  in this
  338. # case it moves the location cursor (active element) up or down by
  339. # one element, and extends the selection to that point.
  340. #
  341. # Arguments:
  342. # w -        The listbox widget.
  343. # amount -    +1 to move down one item, -1 to move back one item.
  344.  
  345. proc tkListboxExtendUpDown {w amount} {
  346.     if {[$w cget -selectmode] != "extended"} {
  347.     return
  348.     }
  349.     $w activate [expr [$w index active] + $amount]
  350.     $w see active
  351.     tkListboxMotion $w [$w index active]
  352. }
  353.  
  354. # tkListboxDataExtend
  355. #
  356. # This procedure is called for key-presses such as Shift-KEndData.
  357. # If the selection mode isn't multiple or extend then it does nothing.
  358. # Otherwise it moves the active element to el and, if we're in
  359. # extended mode, extends the selection to that point.
  360. #
  361. # Arguments:
  362. # w -        The listbox widget.
  363. # el -        An integer element number.
  364.  
  365. proc tkListboxDataExtend {w el} {
  366.     set mode [$w cget -selectmode]
  367.     if {$mode == "extended"} {
  368.     $w activate $el
  369.     $w see $el
  370.         if [$w selection includes anchor] {
  371.         tkListboxMotion $w $el
  372.     }
  373.     } elseif {$mode == "multiple"} {
  374.     $w activate $el
  375.     $w see $el
  376.     }
  377. }
  378.  
  379. # tkListboxCancel
  380. #
  381. # This procedure is invoked to cancel an extended selection in
  382. # progress.  If there is an extended selection in progress, it
  383. # restores all of the items between the active one and the anchor
  384. # to their previous selection state.
  385. #
  386. # Arguments:
  387. # w -        The listbox widget.
  388.  
  389. proc tkListboxCancel w {
  390.     global tkPriv
  391.     if {[$w cget -selectmode] != "extended"} {
  392.     return
  393.     }
  394.     set first [$w index anchor]
  395.     set last $tkPriv(listboxPrev)
  396.     if {$first > $last} {
  397.     set tmp $first
  398.     set first $last
  399.     set last $tmp
  400.     }
  401.     $w selection clear $first $last
  402.     while {$first <= $last} {
  403.     if {[lsearch $tkPriv(listboxSelection) $first] >= 0} {
  404.         $w selection set $first
  405.     }
  406.     incr first
  407.     }
  408. }
  409.  
  410. # tkListboxSelectAll
  411. #
  412. # This procedure is invoked to handle the "select all" operation.
  413. # For single and browse mode, it just selects the active element.
  414. # Otherwise it selects everything in the widget.
  415. #
  416. # Arguments:
  417. # w -        The listbox widget.
  418.  
  419. proc tkListboxSelectAll w {
  420.     set mode [$w cget -selectmode]
  421.     if {($mode == "single") || ($mode == "browse")} {
  422.     $w selection clear 0 end
  423.     $w selection set active
  424.     } else {
  425.     $w selection set 0 end
  426.     }
  427. }
  428.