home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 14 / hacker14.iso / programacao / pythonwin / python.exe / LISTBOX.TCL < prev    next >
Encoding:
Text File  |  2002-08-30  |  13.3 KB  |  506 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 2002/08/31 06:12:28 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. bind Listbox <MouseWheel> {
  183.     %W yview scroll [expr {- (%D / 120) * 4}] units
  184. }
  185.  
  186. if {[string equal "x11" [tk windowingsystem]]} {
  187.     # Support for mousewheels on Linux/Unix commonly comes through mapping
  188.     # the wheel to the extended buttons.  If you have a mousewheel, find
  189.     # Linux configuration info at:
  190.     #    http://www.inria.fr/koala/colas/mouse-wheel-scroll/
  191.     bind Listbox <4> {
  192.     if {!$tk_strictMotif} {
  193.         %W yview scroll -5 units
  194.     }
  195.     }
  196.     bind Listbox <5> {
  197.     if {!$tk_strictMotif} {
  198.         %W yview scroll 5 units
  199.     }
  200.     }
  201. }
  202.  
  203. # ::tk::ListboxBeginSelect --
  204. #
  205. # This procedure is typically invoked on button-1 presses.  It begins
  206. # the process of making a selection in the listbox.  Its exact behavior
  207. # depends on the selection mode currently in effect for the listbox;
  208. # see the Motif documentation for details.
  209. #
  210. # Arguments:
  211. # w -        The listbox widget.
  212. # el -        The element for the selection operation (typically the
  213. #        one under the pointer).  Must be in numerical form.
  214.  
  215. proc ::tk::ListboxBeginSelect {w el} {
  216.     variable ::tk::Priv
  217.     if {[string equal [$w cget -selectmode] "multiple"]} {
  218.     if {[$w selection includes $el]} {
  219.         $w selection clear $el
  220.     } else {
  221.         $w selection set $el
  222.     }
  223.     } else {
  224.     $w selection clear 0 end
  225.     $w selection set $el
  226.     $w selection anchor $el
  227.     set Priv(listboxSelection) {}
  228.     set Priv(listboxPrev) $el
  229.     }
  230.     event generate $w <<ListboxSelect>>
  231. }
  232.  
  233. # ::tk::ListboxMotion --
  234. #
  235. # This procedure is called to process mouse motion events while
  236. # button 1 is down.  It may move or extend the selection, depending
  237. # on the listbox's selection mode.
  238. #
  239. # Arguments:
  240. # w -        The listbox widget.
  241. # el -        The element under the pointer (must be a number).
  242.  
  243. proc ::tk::ListboxMotion {w el} {
  244.     variable ::tk::Priv
  245.     if {$el == $Priv(listboxPrev)} {
  246.     return
  247.     }
  248.     set anchor [$w index anchor]
  249.     switch [$w cget -selectmode] {
  250.     browse {
  251.         $w selection clear 0 end
  252.         $w selection set $el
  253.         set Priv(listboxPrev) $el
  254.         event generate $w <<ListboxSelect>>
  255.     }
  256.     extended {
  257.         set i $Priv(listboxPrev)
  258.         if {[string equal {} $i]} {
  259.         set i $el
  260.         $w selection set $el
  261.         }
  262.         if {[$w selection includes anchor]} {
  263.         $w selection clear $i $el
  264.         $w selection set anchor $el
  265.         } else {
  266.         $w selection clear $i $el
  267.         $w selection clear anchor $el
  268.         }
  269.         if {![info exists Priv(listboxSelection)]} {
  270.         set Priv(listboxSelection) [$w curselection]
  271.         }
  272.         while {($i < $el) && ($i < $anchor)} {
  273.         if {[lsearch $Priv(listboxSelection) $i] >= 0} {
  274.             $w selection set $i
  275.         }
  276.         incr i
  277.         }
  278.         while {($i > $el) && ($i > $anchor)} {
  279.         if {[lsearch $Priv(listboxSelection) $i] >= 0} {
  280.             $w selection set $i
  281.         }
  282.         incr i -1
  283.         }
  284.         set Priv(listboxPrev) $el
  285.         event generate $w <<ListboxSelect>>
  286.     }
  287.     }
  288. }
  289.  
  290. # ::tk::ListboxBeginExtend --
  291. #
  292. # This procedure is typically invoked on shift-button-1 presses.  It
  293. # begins the process of extending a selection in the listbox.  Its
  294. # exact behavior depends on the selection mode currently in effect
  295. # for the listbox;  see the Motif documentation for details.
  296. #
  297. # Arguments:
  298. # w -        The listbox widget.
  299. # el -        The element for the selection operation (typically the
  300. #        one under the pointer).  Must be in numerical form.
  301.  
  302. proc ::tk::ListboxBeginExtend {w el} {
  303.     if {[string equal [$w cget -selectmode] "extended"]} {
  304.     if {[$w selection includes anchor]} {
  305.         ListboxMotion $w $el
  306.     } else {
  307.         # No selection yet; simulate the begin-select operation.
  308.         ListboxBeginSelect $w $el
  309.     }
  310.     }
  311. }
  312.  
  313. # ::tk::ListboxBeginToggle --
  314. #
  315. # This procedure is typically invoked on control-button-1 presses.  It
  316. # begins the process of toggling a selection in the listbox.  Its
  317. # exact behavior depends on the selection mode currently in effect
  318. # for the listbox;  see the Motif documentation for details.
  319. #
  320. # Arguments:
  321. # w -        The listbox widget.
  322. # el -        The element for the selection operation (typically the
  323. #        one under the pointer).  Must be in numerical form.
  324.  
  325. proc ::tk::ListboxBeginToggle {w el} {
  326.     variable ::tk::Priv
  327.     if {[string equal [$w cget -selectmode] "extended"]} {
  328.     set Priv(listboxSelection) [$w curselection]
  329.     set Priv(listboxPrev) $el
  330.     $w selection anchor $el
  331.     if {[$w selection includes $el]} {
  332.         $w selection clear $el
  333.     } else {
  334.         $w selection set $el
  335.     }
  336.     event generate $w <<ListboxSelect>>
  337.     }
  338. }
  339.  
  340. # ::tk::ListboxAutoScan --
  341. # This procedure is invoked when the mouse leaves an entry window
  342. # with button 1 down.  It scrolls the window up, down, left, or
  343. # right, depending on where the mouse left the window, and reschedules
  344. # itself as an "after" command so that the window continues to scroll until
  345. # the mouse moves back into the window or the mouse button is released.
  346. #
  347. # Arguments:
  348. # w -        The entry window.
  349.  
  350. proc ::tk::ListboxAutoScan {w} {
  351.     variable ::tk::Priv
  352.     if {![winfo exists $w]} return
  353.     set x $Priv(x)
  354.     set y $Priv(y)
  355.     if {$y >= [winfo height $w]} {
  356.     $w yview scroll 1 units
  357.     } elseif {$y < 0} {
  358.     $w yview scroll -1 units
  359.     } elseif {$x >= [winfo width $w]} {
  360.     $w xview scroll 2 units
  361.     } elseif {$x < 0} {
  362.     $w xview scroll -2 units
  363.     } else {
  364.     return
  365.     }
  366.     ListboxMotion $w [$w index @$x,$y]
  367.     set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]]
  368. }
  369.  
  370. # ::tk::ListboxUpDown --
  371. #
  372. # Moves the location cursor (active element) up or down by one element,
  373. # and changes the selection if we're in browse or extended selection
  374. # mode.
  375. #
  376. # Arguments:
  377. # w -        The listbox widget.
  378. # amount -    +1 to move down one item, -1 to move back one item.
  379.  
  380. proc ::tk::ListboxUpDown {w amount} {
  381.     variable ::tk::Priv
  382.     $w activate [expr {[$w index active] + $amount}]
  383.     $w see active
  384.     switch [$w cget -selectmode] {
  385.     browse {
  386.         $w selection clear 0 end
  387.         $w selection set active
  388.         event generate $w <<ListboxSelect>>
  389.     }
  390.     extended {
  391.         $w selection clear 0 end
  392.         $w selection set active
  393.         $w selection anchor active
  394.         set Priv(listboxPrev) [$w index active]
  395.         set Priv(listboxSelection) {}
  396.         event generate $w <<ListboxSelect>>
  397.     }
  398.     }
  399. }
  400.  
  401. # ::tk::ListboxExtendUpDown --
  402. #
  403. # Does nothing unless we're in extended selection mode;  in this
  404. # case it moves the location cursor (active element) up or down by
  405. # one element, and extends the selection to that point.
  406. #
  407. # Arguments:
  408. # w -        The listbox widget.
  409. # amount -    +1 to move down one item, -1 to move back one item.
  410.  
  411. proc ::tk::ListboxExtendUpDown {w amount} {
  412.     variable ::tk::Priv
  413.     if {[string compare [$w cget -selectmode] "extended"]} {
  414.     return
  415.     }
  416.     set active [$w index active]
  417.     if {![info exists Priv(listboxSelection)]} {
  418.     $w selection set $active
  419.     set Priv(listboxSelection) [$w curselection]
  420.     }
  421.     $w activate [expr {$active + $amount}]
  422.     $w see active
  423.     ListboxMotion $w [$w index active]
  424. }
  425.  
  426. # ::tk::ListboxDataExtend
  427. #
  428. # This procedure is called for key-presses such as Shift-KEndData.
  429. # If the selection mode isn't multiple or extend then it does nothing.
  430. # Otherwise it moves the active element to el and, if we're in
  431. # extended mode, extends the selection to that point.
  432. #
  433. # Arguments:
  434. # w -        The listbox widget.
  435. # el -        An integer element number.
  436.  
  437. proc ::tk::ListboxDataExtend {w el} {
  438.     set mode [$w cget -selectmode]
  439.     if {[string equal $mode "extended"]} {
  440.     $w activate $el
  441.     $w see $el
  442.         if {[$w selection includes anchor]} {
  443.         ListboxMotion $w $el
  444.     }
  445.     } elseif {[string equal $mode "multiple"]} {
  446.     $w activate $el
  447.     $w see $el
  448.     }
  449. }
  450.  
  451. # ::tk::ListboxCancel
  452. #
  453. # This procedure is invoked to cancel an extended selection in
  454. # progress.  If there is an extended selection in progress, it
  455. # restores all of the items between the active one and the anchor
  456. # to their previous selection state.
  457. #
  458. # Arguments:
  459. # w -        The listbox widget.
  460.  
  461. proc ::tk::ListboxCancel w {
  462.     variable ::tk::Priv
  463.     if {[string compare [$w cget -selectmode] "extended"]} {
  464.     return
  465.     }
  466.     set first [$w index anchor]
  467.     set last $Priv(listboxPrev)
  468.     if { [string equal $last ""] } {
  469.     # Not actually doing any selection right now
  470.     return
  471.     }
  472.     if {$first > $last} {
  473.     set tmp $first
  474.     set first $last
  475.     set last $tmp
  476.     }
  477.     $w selection clear $first $last
  478.     while {$first <= $last} {
  479.     if {[lsearch $Priv(listboxSelection) $first] >= 0} {
  480.         $w selection set $first
  481.     }
  482.     incr first
  483.     }
  484.     event generate $w <<ListboxSelect>>
  485. }
  486.  
  487. # ::tk::ListboxSelectAll
  488. #
  489. # This procedure is invoked to handle the "select all" operation.
  490. # For single and browse mode, it just selects the active element.
  491. # Otherwise it selects everything in the widget.
  492. #
  493. # Arguments:
  494. # w -        The listbox widget.
  495.  
  496. proc ::tk::ListboxSelectAll w {
  497.     set mode [$w cget -selectmode]
  498.     if {[string equal $mode "single"] || [string equal $mode "browse"]} {
  499.     $w selection clear 0 end
  500.     $w selection set active
  501.     } else {
  502.     $w selection set 0 end
  503.     }
  504.     event generate $w <<ListboxSelect>>
  505. }
  506.