# Converted from listbox.tcl --
# This file defines the default bindings for Tk listbox widgets.
# @(#) listbox.tcl 1.7 94/12/17 16:05:18
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
$VERSION = '3.031'; # $Id: //depot/Tk8/Listbox/Listbox.pm#31 $
use Tk qw(Ev $XS_VERSION);
use base qw(Tk::Clipboard Tk::Widget);
Construct Tk
::Widget
'Listbox';
sub Tk_cmd
{ \
&Tk
::listbox
}
Tk
::Methods
('activate','bbox','curselection','delete','get','index',
'insert','nearest','scan','see','selection','size',
use Tk
::Submethods
( 'selection' => [qw(anchor clear includes set)],
'scan' => [qw(mark dragto)],
'xview' => [qw(moveto scroll)],
'yview' => [qw(moveto scroll)],
*Getselected
= \
&getSelected
;
my ($listbox,$balloon,$X,$Y,@opt) = @_;
my $e = $listbox->XEvent;
my $index = $listbox->index('@' . $e->x . ',' . $e->y);
my $info = $balloon->GetOption($opt,$listbox);
if ($opt =~ /^-(statusmsg|balloonmsg)$/ && UNIVERSAL
::isa
($info,'ARRAY'))
$balloon->Subclient($index);
if (defined $info->[$index])
$class->SUPER::ClassInit
($mw);
# Standard Motif bindings:
$mw->bind($class,'<1>',['BeginSelect',Ev
('index',Ev
('@'))]);
$mw->bind($class,'<B1-Motion>',['Motion',Ev
('index',Ev
('@'))]);
$mw->bind($class,'<ButtonRelease-1>','ButtonRelease_1');
$mw->bind($class,'<Shift-1>',['BeginExtend',Ev
('index',Ev
('@'))]);
$mw->bind($class,'<Control-1>',['BeginToggle',Ev
('index',Ev
('@'))]);
$mw->bind($class,'<B1-Leave>',['AutoScan',Ev
('x'),Ev
('y')]);
$mw->bind($class,'<B1-Enter>','CancelRepeat');
$mw->bind($class,'<Up>',['UpDown',-1]);
$mw->bind($class,'<Shift-Up>',['ExtendUpDown',-1]);
$mw->bind($class,'<Down>',['UpDown',1]);
$mw->bind($class,'<Shift-Down>',['ExtendUpDown',1]);
$mw->XscrollBind($class);
$mw->PriorNextBind($class);
$mw->bind($class,'<Control-Home>','Cntrl_Home');
$mw->bind($class,'<Shift-Control-Home>',['DataExtend',0]);
$mw->bind($class,'<Control-End>','Cntrl_End');
$mw->bind($class,'<Shift-Control-End>',['DataExtend','end']);
# $class->clipboardOperations($mw,'Copy');
$mw->bind($class,'<space>',['BeginSelect',Ev
('index','active')]);
$mw->bind($class,'<Select>',['BeginSelect',Ev
('index','active')]);
$mw->bind($class,'<Control-Shift-space>',['BeginExtend',Ev
('index','active')]);
$mw->bind($class,'<Shift-Select>',['BeginExtend',Ev
('index','active')]);
$mw->bind($class,'<Escape>','Cancel');
$mw->bind($class,'<Control-slash>','SelectAll');
$mw->bind($class,'<Control-backslash>','Cntrl_backslash');
# Additional Tk bindings that aren't part of the Motif look and feel:
$mw->bind($class,'<2>',['scan','mark',Ev
('x'),Ev
('y')]);
$mw->bind($class,'<B2-Motion>',['scan','dragto',Ev
('x'),Ev
('y')]);
# This procedure is invoked the first time the mouse enters a listbox
# widget or a listbox widget receives the input focus. It creates
# all of the class bindings for listboxes.
# event - Indicates which event caused the procedure to be invoked
# (Enter or FocusIn). It is used so that we can carry out
# the functions of that event in addition to setting up
return $w->index($Ev->xy);
$w->selectionClear(0,'end');
$w->selectionClear(0,'end');
if ($w->cget('-selectmode') ne 'browse')
$w->selectionClear(0,'end');
# This procedure is typically invoked on button-1 presses. It begins
# the process of making a selection in the listbox. Its exact behavior
# depends on the selection mode currently in effect for the listbox;
# see the Motif documentation for details.
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
if ($w->cget('-selectmode') eq 'multiple')
if ($w->selectionIncludes($el))
$w->selectionClear(0,'end');
$w->selectionAnchor($el);
$w->focus if ($w->cget('-takefocus'));
# This procedure is called to process mouse motion events while
# button 1 is down. It may move or extend the selection, depending
# on the listbox's selection mode.
# w - The listbox widget.
# el - The element under the pointer (must be a number).
if (defined($Prev) && $el == $Prev)
$anchor = $w->index('anchor');
my $mode = $w->cget('-selectmode');
$w->selectionClear(0,'end');
elsif ($mode eq 'extended')
if ($w->selectionIncludes('anchor'))
$w->selectionClear($i,$el);
$w->selectionSet('anchor',$el)
$w->selectionClear($i,$el);
$w->selectionClear('anchor',$el)
while ($i < $el && $i < $anchor)
if (Tk
::lsearch
(\
@Selection,$i) >= 0)
while ($i > $el && $i > $anchor)
if (Tk
::lsearch
(\
@Selection,$i) >= 0)
# This procedure is typically invoked on shift-button-1 presses. It
# begins the process of extending a selection in the listbox. Its
# exact behavior depends on the selection mode currently in effect
# for the listbox; see the Motif documentation for details.
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
if ($w->cget('-selectmode') eq 'extended' && $w->selectionIncludes('anchor'))
# This procedure is typically invoked on control-button-1 presses. It
# begins the process of toggling a selection in the listbox. Its
# exact behavior depends on the selection mode currently in effect
# for the listbox; see the Motif documentation for details.
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
if ($w->cget('-selectmode') eq 'extended')
@Selection = $w->curselection();
$w->selectionAnchor($el);
if ($w->selectionIncludes($el))
# This procedure is invoked when the mouse leaves an entry window
# with button 1 down. It scrolls the window up, down, left, or
# right, depending on where the mouse left the window, and reschedules
# itself as an "after" command so that the window continues to scroll until
# the mouse moves back into the window or the mouse button is released.
# x - The x-coordinate of the mouse when it left the window.
# y - The y-coordinate of the mouse when it left the window.
$w->yview('scroll',1,'units')
$w->yview('scroll',-1,'units')
$w->xview('scroll',2,'units')
$w->xview('scroll',-2,'units')
$w->Motion($w->index("@" . $x . ',' . $y));
$w->RepeatId($w->after(50,'AutoScan',$w,$x,$y));
# Moves the location cursor (active element) up or down by one element,
# and changes the selection if we're in browse or extended selection
# w - The listbox widget.
# amount - +1 to move down one item, -1 to move back one item.
$w->activate($w->index('active')+$amount);
$LNet__0 = $w->cget('-selectmode');
if ($LNet__0 eq 'browse')
$w->selectionClear(0,'end');
$w->selectionSet('active')
elsif ($LNet__0 eq 'extended')
$w->selectionClear(0,'end');
$w->selectionSet('active');
$w->selectionAnchor('active');
$Prev = $w->index('active');
# Does nothing unless we're in extended selection mode; in this
# case it moves the location cursor (active element) up or down by
# one element, and extends the selection to that point.
# w - The listbox widget.
# amount - +1 to move down one item, -1 to move back one item.
if ($w->cget('-selectmode') ne 'extended')
$w->activate($w->index('active')+$amount);
$w->Motion($w->index('active'))
# This procedure is called for key-presses such as Shift-KEndData.
# If the selection mode isn't multiple or extend then it does nothing.
# Otherwise it moves the active element to el and, if we're in
# extended mode, extends the selection to that point.
# w - The listbox widget.
# el - An integer element number.
$mode = $w->cget('-selectmode');
if ($w->selectionIncludes('anchor'))
elsif ($mode eq 'multiple')
# This procedure is invoked to cancel an extended selection in
# progress. If there is an extended selection in progress, it
# restores all of the items between the active one and the anchor
# to their previous selection state.
# w - The listbox widget.
if ($w->cget('-selectmode') ne 'extended' || !defined $Prev)
$first = $w->index('anchor');
$w->selectionClear($first,$last);
if (Tk
::lsearch
(\
@Selection,$first) >= 0)
# This procedure is invoked to handle the "select all" operation.
# For single and browse mode, it just selects the active element.
# Otherwise it selects everything in the widget.
# w - The listbox widget.
my $mode = $w->cget('-selectmode');
if ($mode eq 'single' || $mode eq 'browse')
$w->selectionClear(0,'end');
$w->selectionSet('active')
$w->selectionSet(0,'end')
foreach $i (reverse $w->curselection)
my $index = $w->index('active') || $w->index($w->XEvent->xy);
eval {local $SIG{__DIE__
}; $str = $w->clipboardGet };
foreach (split("\n",$str))
foreach $i ($w->curselection)
push(@result,$w->get($i));
return (wantarray) ?
@result : $result[0];