git.zerfleddert.de Git - micropolis/blob - res/listbox.tcl

   1 # listbox.tcl --
   2 #
   3 # This file contains Tcl procedures used to manage Tk listboxes.
   4 #
   5 # $Header: /user6/ouster/wish/scripts/RCS/listbox.tcl,v 1.2 92/06/03 15:21:28 ouster Exp $ SPRITE (Berkeley)
   6 #
   7 # Copyright 1992 Regents of the University of California
   8 # Permission to use, copy, modify, and distribute this
   9 # software and its documentation for any purpose and without
  10 # fee is hereby granted, provided that this copyright
  11 # notice appears in all copies.  The University of California
  12 # makes no representations about the suitability of this
  13 # software for any purpose.  It is provided "as is" without
  14 # express or implied warranty.
  15 #
  16
  17 # The procedure below may be invoked to change the behavior of
  18 # listboxes so that only a single item may be selected at once.
  19 # The arguments give one or more windows whose behavior should
  20 # be changed;  if one of the arguments is "Listbox" then the default
  21 # behavior is changed for all listboxes.
  22
  23 proc tk_listboxSingleSelect args {
  24     foreach w $args {
  25         bind $w <B1-Motion> {%W select from [%W nearest %y]}
  26         bind $w <Shift-1> {%W select from [%W nearest %y]}
  27         bind $w <Shift-B1-Motion> {%W select from [%W nearest %y]}
  28     }
  29 }