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