[micropolis] / src / tk / library / listbox.tcl

# listbox.tcl --
#
# This file contains Tcl procedures used to manage Tk listboxes.
#
# $Header: /user6/ouster/wish/scripts/RCS/listbox.tcl,v 1.2 92/06/03 15:21:28 ouster Exp $ SPRITE (Berkeley)
#
# Copyright 1992 Regents of the University of California
# Permission to use, copy, modify, and distribute this
# software and its documentation for any purpose and without
# fee is hereby granted, provided that this copyright
# notice appears in all copies.  The University of California
# makes no representations about the suitability of this
# software for any purpose.  It is provided "as is" without
# express or implied warranty.
#

# The procedure below may be invoked to change the behavior of
# listboxes so that only a single item may be selected at once.
# The arguments give one or more windows whose behavior should
# be changed;  if one of the arguments is "Listbox" then the default
# behavior is changed for all listboxes.

proc tk_listboxSingleSelect args {
    foreach w $args {
	bind $w <B1-Motion> {%W select from [%W nearest %y]} 
	bind $w <Shift-1> {%W select from [%W nearest %y]}
	bind $w <Shift-B1-Motion> {%W select from [%W nearest %y]}
    }
}
Commit	Line	Data
6a5fa4e0 MG	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	}