home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tk8.4 / listbox.tcl < prev    next >
Text File  |  2004-02-16  |  14KB  |  522 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.13.2.2 2004/02/17 07:17:17 das 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. # tk::Priv 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.     tk::ListboxBeginSelect %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 tk::Priv(x) %x
  52.     set tk::Priv(y) %y
  53.     tk::ListboxMotion %W [%W index @%x,%y]
  54. }
  55. bind Listbox <ButtonRelease-1> {
  56.     tk::CancelRepeat
  57.     %W activate @%x,%y
  58. }
  59. bind Listbox <Shift-1> {
  60.     tk::ListboxBeginExtend %W [%W index @%x,%y]
  61. }
  62. bind Listbox <Control-1> {
  63.     tk::ListboxBeginToggle %W [%W index @%x,%y]
  64. }
  65. bind Listbox <B1-Leave> {
  66.     set tk::Priv(x) %x
  67.     set tk::Priv(y) %y
  68.     tk::ListboxAutoScan %W
  69. }
  70. bind Listbox <B1-Enter> {
  71.     tk::CancelRepeat
  72. }
  73.  
  74. bind Listbox <Up> {
  75.     tk::ListboxUpDown %W -1
  76. }
  77. bind Listbox <Shift-Up> {
  78.     tk::ListboxExtendUpDown %W -1
  79. }
  80. bind Listbox <Down> {
  81.     tk::ListboxUpDown %W 1
  82. }
  83. bind Listbox <Shift-Down> {
  84.     tk::ListboxExtendUpDown %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.     event generate %W <<ListboxSelect>>
  124. }
  125. bind Listbox <Shift-Control-Home> {
  126.     tk::ListboxDataExtend %W 0
  127. }
  128. bind Listbox <Control-End> {
  129.     %W activate end
  130.     %W see end
  131.     %W selection clear 0 end
  132.     %W selection set end
  133.     event generate %W <<ListboxSelect>>
  134. }
  135. bind Listbox <Shift-Control-End> {
  136.     tk::ListboxDataExtend %W [%W index end]
  137. }
  138. bind Listbox <<Copy>> {
  139.     if {[string equal [selection own -displayof %W] "%W"]} {
  140.     clipboard clear -displayof %W
  141.     clipboard append -displayof %W [selection get -displayof %W]
  142.     }
  143. }
  144. bind Listbox <space> {
  145.     tk::ListboxBeginSelect %W [%W index active]
  146. }
  147. bind Listbox <Select> {
  148.     tk::ListboxBeginSelect %W [%W index active]
  149. }
  150. bind Listbox <Control-Shift-space> {
  151.     tk::ListboxBeginExtend %W [%W index active]
  152. }
  153. bind Listbox <Shift-Select> {
  154.     tk::ListboxBeginExtend %W [%W index active]
  155. }
  156. bind Listbox <Escape> {
  157.     tk::ListboxCancel %W
  158. }
  159. bind Listbox <Control-slash> {
  160.     tk::ListboxSelectAll %W
  161. }
  162. bind Listbox <Control-backslash> {
  163.     if {[string compare [%W cget -selectmode] "browse"]} {
  164.     %W selection clear 0 end
  165.     event generate %W <<ListboxSelect>>
  166.     }
  167. }
  168.  
  169. # Additional Tk bindings that aren't part of the Motif look and feel:
  170.  
  171. bind Listbox <2> {
  172.     %W scan mark %x %y
  173. }
  174. bind Listbox <B2-Motion> {
  175.     %W scan dragto %x %y
  176. }
  177.  
  178. # The MouseWheel will typically only fire on Windows.  However,
  179. # someone could use the "event generate" command to produce one
  180. # on other platforms.
  181.  
  182. if {[string equal [tk windowingsystem] "classic"]
  183.     || [string equal [tk windowingsystem] "aqua"]} {
  184.     bind Listbox <MouseWheel> {
  185.         %W yview scroll [expr {- (%D)}] units
  186.     }
  187.     bind Listbox <Option-MouseWheel> {
  188.         %W yview scroll [expr {-10 * (%D)}] units
  189.     }
  190.     bind Listbox <Shift-MouseWheel> {
  191.         %W xview scroll [expr {- (%D)}] units
  192.     }
  193.     bind Listbox <Shift-Option-MouseWheel> {
  194.         %W xview scroll [expr {-10 * (%D)}] units
  195.     }
  196. } else {
  197.     bind Listbox <MouseWheel> {
  198.         %W yview scroll [expr {- (%D / 120) * 4}] units
  199.     }
  200. }
  201.  
  202. if {[string equal "x11" [tk windowingsystem]]} {
  203.     # Support for mousewheels on Linux/Unix commonly comes through mapping
  204.     # the wheel to the extended buttons.  If you have a mousewheel, find
  205.     # Linux configuration info at:
  206.     #    http://www.inria.fr/koala/colas/mouse-wheel-scroll/
  207.     bind Listbox <4> {
  208.     if {!$tk_strictMotif} {
  209.         %W yview scroll -5 units
  210.     }
  211.     }
  212.     bind Listbox <5> {
  213.     if {!$tk_strictMotif} {
  214.         %W yview scroll 5 units
  215.     }
  216.     }
  217. }
  218.  
  219. # ::tk::ListboxBeginSelect --
  220. #
  221. # This procedure is typically invoked on button-1 presses.  It begins
  222. # the process of making a selection in the listbox.  Its exact behavior
  223. # depends on the selection mode currently in effect for the listbox;
  224. # see the Motif documentation for details.
  225. #
  226. # Arguments:
  227. # w -        The listbox widget.
  228. # el -        The element for the selection operation (typically the
  229. #        one under the pointer).  Must be in numerical form.
  230.  
  231. proc ::tk::ListboxBeginSelect {w el} {
  232.     variable ::tk::Priv
  233.     if {[string equal [$w cget -selectmode] "multiple"]} {
  234.     if {[$w selection includes $el]} {
  235.         $w selection clear $el
  236.     } else {
  237.         $w selection set $el
  238.     }
  239.     } else {
  240.     $w selection clear 0 end
  241.     $w selection set $el
  242.     $w selection anchor $el
  243.     set Priv(listboxSelection) {}
  244.     set Priv(listboxPrev) $el
  245.     }
  246.     event generate $w <<ListboxSelect>>
  247. }
  248.  
  249. # ::tk::ListboxMotion --
  250. #
  251. # This procedure is called to process mouse motion events while
  252. # button 1 is down.  It may move or extend the selection, depending
  253. # on the listbox's selection mode.
  254. #
  255. # Arguments:
  256. # w -        The listbox widget.
  257. # el -        The element under the pointer (must be a number).
  258.  
  259. proc ::tk::ListboxMotion {w el} {
  260.     variable ::tk::Priv
  261.     if {$el == $Priv(listboxPrev)} {
  262.     return
  263.     }
  264.     set anchor [$w index anchor]
  265.     switch [$w cget -selectmode] {
  266.     browse {
  267.         $w selection clear 0 end
  268.         $w selection set $el
  269.         set Priv(listboxPrev) $el
  270.         event generate $w <<ListboxSelect>>
  271.     }
  272.     extended {
  273.         set i $Priv(listboxPrev)
  274.         if {[string equal {} $i]} {
  275.         set i $el
  276.         $w selection set $el
  277.         }
  278.         if {[$w selection includes anchor]} {
  279.         $w selection clear $i $el
  280.         $w selection set anchor $el
  281.         } else {
  282.         $w selection clear $i $el
  283.         $w selection clear anchor $el
  284.         }
  285.         if {![info exists Priv(listboxSelection)]} {
  286.         set Priv(listboxSelection) [$w curselection]
  287.         }
  288.         while {($i < $el) && ($i < $anchor)} {
  289.         if {[lsearch $Priv(listboxSelection) $i] >= 0} {
  290.             $w selection set $i
  291.         }
  292.         incr i
  293.         }
  294.         while {($i > $el) && ($i > $anchor)} {
  295.         if {[lsearch $Priv(listboxSelection) $i] >= 0} {
  296.             $w selection set $i
  297.         }
  298.         incr i -1
  299.         }
  300.         set Priv(listboxPrev) $el
  301.         event generate $w <<ListboxSelect>>
  302.     }
  303.     }
  304. }
  305.  
  306. # ::tk::ListboxBeginExtend --
  307. #
  308. # This procedure is typically invoked on shift-button-1 presses.  It
  309. # begins the process of extending a selection in the listbox.  Its
  310. # exact behavior depends on the selection mode currently in effect
  311. # for the listbox;  see the Motif documentation for details.
  312. #
  313. # Arguments:
  314. # w -        The listbox widget.
  315. # el -        The element for the selection operation (typically the
  316. #        one under the pointer).  Must be in numerical form.
  317.  
  318. proc ::tk::ListboxBeginExtend {w el} {
  319.     if {[string equal [$w cget -selectmode] "extended"]} {
  320.     if {[$w selection includes anchor]} {
  321.         ListboxMotion $w $el
  322.     } else {
  323.         # No selection yet; simulate the begin-select operation.
  324.         ListboxBeginSelect $w $el
  325.     }
  326.     }
  327. }
  328.  
  329. # ::tk::ListboxBeginToggle --
  330. #
  331. # This procedure is typically invoked on control-button-1 presses.  It
  332. # begins the process of toggling a selection in the listbox.  Its
  333. # exact behavior depends on the selection mode currently in effect
  334. # for the listbox;  see the Motif documentation for details.
  335. #
  336. # Arguments:
  337. # w -        The listbox widget.
  338. # el -        The element for the selection operation (typically the
  339. #        one under the pointer).  Must be in numerical form.
  340.  
  341. proc ::tk::ListboxBeginToggle {w el} {
  342.     variable ::tk::Priv
  343.     if {[string equal [$w cget -selectmode] "extended"]} {
  344.     set Priv(listboxSelection) [$w curselection]
  345.     set Priv(listboxPrev) $el
  346.     $w selection anchor $el
  347.     if {[$w selection includes $el]} {
  348.         $w selection clear $el
  349.     } else {
  350.         $w selection set $el
  351.     }
  352.     event generate $w <<ListboxSelect>>
  353.     }
  354. }
  355.  
  356. # ::tk::ListboxAutoScan --
  357. # This procedure is invoked when the mouse leaves an entry window
  358. # with button 1 down.  It scrolls the window up, down, left, or
  359. # right, depending on where the mouse left the window, and reschedules
  360. # itself as an "after" command so that the window continues to scroll until
  361. # the mouse moves back into the window or the mouse button is released.
  362. #
  363. # Arguments:
  364. # w -        The entry window.
  365.  
  366. proc ::tk::ListboxAutoScan {w} {
  367.     variable ::tk::Priv
  368.     if {![winfo exists $w]} return
  369.     set x $Priv(x)
  370.     set y $Priv(y)
  371.     if {$y >= [winfo height $w]} {
  372.     $w yview scroll 1 units
  373.     } elseif {$y < 0} {
  374.     $w yview scroll -1 units
  375.     } elseif {$x >= [winfo width $w]} {
  376.     $w xview scroll 2 units
  377.     } elseif {$x < 0} {
  378.     $w xview scroll -2 units
  379.     } else {
  380.     return
  381.     }
  382.     ListboxMotion $w [$w index @$x,$y]
  383.     set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]]
  384. }
  385.  
  386. # ::tk::ListboxUpDown --
  387. #
  388. # Moves the location cursor (active element) up or down by one element,
  389. # and changes the selection if we're in browse or extended selection
  390. # mode.
  391. #
  392. # Arguments:
  393. # w -        The listbox widget.
  394. # amount -    +1 to move down one item, -1 to move back one item.
  395.  
  396. proc ::tk::ListboxUpDown {w amount} {
  397.     variable ::tk::Priv
  398.     $w activate [expr {[$w index active] + $amount}]
  399.     $w see active
  400.     switch [$w cget -selectmode] {
  401.     browse {
  402.         $w selection clear 0 end
  403.         $w selection set active
  404.         event generate $w <<ListboxSelect>>
  405.     }
  406.     extended {
  407.         $w selection clear 0 end
  408.         $w selection set active
  409.         $w selection anchor active
  410.         set Priv(listboxPrev) [$w index active]
  411.         set Priv(listboxSelection) {}
  412.         event generate $w <<ListboxSelect>>
  413.     }
  414.     }
  415. }
  416.  
  417. # ::tk::ListboxExtendUpDown --
  418. #
  419. # Does nothing unless we're in extended selection mode;  in this
  420. # case it moves the location cursor (active element) up or down by
  421. # one element, and extends the selection to that point.
  422. #
  423. # Arguments:
  424. # w -        The listbox widget.
  425. # amount -    +1 to move down one item, -1 to move back one item.
  426.  
  427. proc ::tk::ListboxExtendUpDown {w amount} {
  428.     variable ::tk::Priv
  429.     if {[string compare [$w cget -selectmode] "extended"]} {
  430.     return
  431.     }
  432.     set active [$w index active]
  433.     if {![info exists Priv(listboxSelection)]} {
  434.     $w selection set $active
  435.     set Priv(listboxSelection) [$w curselection]
  436.     }
  437.     $w activate [expr {$active + $amount}]
  438.     $w see active
  439.     ListboxMotion $w [$w index active]
  440. }
  441.  
  442. # ::tk::ListboxDataExtend
  443. #
  444. # This procedure is called for key-presses such as Shift-KEndData.
  445. # If the selection mode isn't multiple or extend then it does nothing.
  446. # Otherwise it moves the active element to el and, if we're in
  447. # extended mode, extends the selection to that point.
  448. #
  449. # Arguments:
  450. # w -        The listbox widget.
  451. # el -        An integer element number.
  452.  
  453. proc ::tk::ListboxDataExtend {w el} {
  454.     set mode [$w cget -selectmode]
  455.     if {[string equal $mode "extended"]} {
  456.     $w activate $el
  457.     $w see $el
  458.         if {[$w selection includes anchor]} {
  459.         ListboxMotion $w $el
  460.     }
  461.     } elseif {[string equal $mode "multiple"]} {
  462.     $w activate $el
  463.     $w see $el
  464.     }
  465. }
  466.  
  467. # ::tk::ListboxCancel
  468. #
  469. # This procedure is invoked to cancel an extended selection in
  470. # progress.  If there is an extended selection in progress, it
  471. # restores all of the items between the active one and the anchor
  472. # to their previous selection state.
  473. #
  474. # Arguments:
  475. # w -        The listbox widget.
  476.  
  477. proc ::tk::ListboxCancel w {
  478.     variable ::tk::Priv
  479.     if {[string compare [$w cget -selectmode] "extended"]} {
  480.     return
  481.     }
  482.     set first [$w index anchor]
  483.     set last $Priv(listboxPrev)
  484.     if { [string equal $last ""] } {
  485.     # Not actually doing any selection right now
  486.     return
  487.     }
  488.     if {$first > $last} {
  489.     set tmp $first
  490.     set first $last
  491.     set last $tmp
  492.     }
  493.     $w selection clear $first $last
  494.     while {$first <= $last} {
  495.     if {[lsearch $Priv(listboxSelection) $first] >= 0} {
  496.         $w selection set $first
  497.     }
  498.     incr first
  499.     }
  500.     event generate $w <<ListboxSelect>>
  501. }
  502.  
  503. # ::tk::ListboxSelectAll
  504. #
  505. # This procedure is invoked to handle the "select all" operation.
  506. # For single and browse mode, it just selects the active element.
  507. # Otherwise it selects everything in the widget.
  508. #
  509. # Arguments:
  510. # w -        The listbox widget.
  511.  
  512. proc ::tk::ListboxSelectAll w {
  513.     set mode [$w cget -selectmode]
  514.     if {[string equal $mode "single"] || [string equal $mode "browse"]} {
  515.     $w selection clear 0 end
  516.     $w selection set active
  517.     } else {
  518.     $w selection set 0 end
  519.     }
  520.     event generate $w <<ListboxSelect>>
  521. }
  522.