home *** CD-ROM | disk | FTP | other *** search
/ PC World 2001 April / PCWorld_2001-04_cd.bin / Software / TemaCD / webclean / !!!python!!! / BeOpen-Python-2.0.exe / LISTBOX.TCL < prev    next >
Encoding:
Text File  |  2000-03-24  |  13.2 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.11 2000/03/24 19:38:57 ericm 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.     event generate %W <<ListboxSelect>>
  124. }
  125. bind Listbox <Shift-Control-Home> {
  126.     tkListboxDataExtend %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.     tkListboxDataExtend %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.     tkListboxBeginSelect %W [%W index active]
  146. }
  147. bind Listbox <Select> {
  148.     tkListboxBeginSelect %W [%W index active]
  149. }
  150. bind Listbox <Control-Shift-space> {
  151.     tkListboxBeginExtend %W [%W index active]
  152. }
  153. bind Listbox <Shift-Select> {
  154.     tkListboxBeginExtend %W [%W index active]
  155. }
  156. bind Listbox <Escape> {
  157.     tkListboxCancel %W
  158. }
  159. bind Listbox <Control-slash> {
  160.     tkListboxSelectAll %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 "unix" $tcl_platform(platform)]} {
  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. # tkListboxBeginSelect --
  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 tkListboxBeginSelect {w el} {
  216.     global tkPriv
  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 tkPriv(listboxSelection) {}
  228.     set tkPriv(listboxPrev) $el
  229.     }
  230.     event generate $w <<ListboxSelect>>
  231. }
  232.  
  233. # tkListboxMotion --
  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 tkListboxMotion {w el} {
  244.     global tkPriv
  245.     if {$el == $tkPriv(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 tkPriv(listboxPrev) $el
  254.         event generate $w <<ListboxSelect>>
  255.     }
  256.     extended {
  257.         set i $tkPriv(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 tkPriv(listboxSelection)]} {
  270.         set tkPriv(listboxSelection) [$w curselection]
  271.         }
  272.         while {($i < $el) && ($i < $anchor)} {
  273.         if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
  274.             $w selection set $i
  275.         }
  276.         incr i
  277.         }
  278.         while {($i > $el) && ($i > $anchor)} {
  279.         if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
  280.             $w selection set $i
  281.         }
  282.         incr i -1
  283.         }
  284.         set tkPriv(listboxPrev) $el
  285.         event generate $w <<ListboxSelect>>
  286.     }
  287.     }
  288. }
  289.  
  290. # tkListboxBeginExtend --
  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 tkListboxBeginExtend {w el} {
  303.     if {[string equal [$w cget -selectmode] "extended"]} {
  304.     if {[$w selection includes anchor]} {
  305.         tkListboxMotion $w $el
  306.     } else {
  307.         # No selection yet; simulate the begin-select operation.
  308.         tkListboxBeginSelect $w $el
  309.     }
  310.     }
  311. }
  312.  
  313. # tkListboxBeginToggle --
  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 tkListboxBeginToggle {w el} {
  326.     global tkPriv
  327.     if {[string equal [$w cget -selectmode] "extended"]} {
  328.     set tkPriv(listboxSelection) [$w curselection]
  329.     set tkPriv(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. # tkListboxAutoScan --
  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 tkListboxAutoScan {w} {
  351.     global tkPriv
  352.     if {![winfo exists $w]} return
  353.     set x $tkPriv(x)
  354.     set y $tkPriv(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.     tkListboxMotion $w [$w index @$x,$y]
  367.     set tkPriv(afterId) [after 50 [list tkListboxAutoScan $w]]
  368. }
  369.  
  370. # tkListboxUpDown --
  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 tkListboxUpDown {w amount} {
  381.     global tkPriv
  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 tkPriv(listboxPrev) [$w index active]
  395.         set tkPriv(listboxSelection) {}
  396.         event generate $w <<ListboxSelect>>
  397.     }
  398.     }
  399. }
  400.  
  401. # tkListboxExtendUpDown --
  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 tkListboxExtendUpDown {w amount} {
  412.     if {[string compare [$w cget -selectmode] "extended"]} {
  413.     return
  414.     }
  415.     set active [$w index active]
  416.     if {![info exists tkPriv(listboxSelection)]} {
  417.     global tkPriv
  418.     $w selection set $active
  419.     set tkPriv(listboxSelection) [$w curselection]
  420.     }
  421.     $w activate [expr {$active + $amount}]
  422.     $w see active
  423.     tkListboxMotion $w [$w index active]
  424. }
  425.  
  426. # tkListboxDataExtend
  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 tkListboxDataExtend {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.         tkListboxMotion $w $el
  444.     }
  445.     } elseif {[string equal $mode "multiple"]} {
  446.     $w activate $el
  447.     $w see $el
  448.     }
  449. }
  450.  
  451. # tkListboxCancel
  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 tkListboxCancel w {
  462.     global tkPriv
  463.     if {[string compare [$w cget -selectmode] "extended"]} {
  464.     return
  465.     }
  466.     set first [$w index anchor]
  467.     set last $tkPriv(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 $tkPriv(listboxSelection) $first] >= 0} {
  480.         $w selection set $first
  481.     }
  482.     incr first
  483.     }
  484.     event generate $w <<ListboxSelect>>
  485. }
  486.  
  487. # tkListboxSelectAll
  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 tkListboxSelectAll 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.