$VERSION = '3.035'; # $Id: //depot/Tk8/HList/HList.pm#35 $
use Tk qw(Ev $XS_VERSION);
Construct Tk
::Widget
'HList';
sub Tk
::Widget
::ScrlHList
{ shift->Scrolled('HList'=>@_) }
sub Tk_cmd
{ \
&Tk
::hlist
}
my ($package,$parent,$args) = @_;
my @result = $package->SUPER::CreateArgs
($parent,$args);
my $columns = delete $args->{-columns
};
push(@result, '-columns' => $columns) if (defined $columns);
Tk
::Methods
qw(add addchild anchor column
delete dragsite dropsite entrycget
entryconfigure geometryinfo indicator header hide item info
nearest see select selection show xview yview);
use Tk
::Submethods
( 'delete' => [qw(all entry offsprings siblings)],
'header' => [qw(configure cget create delete exists size)],
'indicator' => [qw(configure cget create delete exists size)],
'info' => [qw(anchor bbox children data dragsite
dropsite exists hidden item next parent prev
'item' => [qw(configure cget create delete exists)],
'selection' => [qw(clear get includes set)],
'anchor' => [qw(clear set)],
$mw->bind($class,'<ButtonPress-1>',[ 'Button1' ] );
$mw->bind($class,'<Shift-ButtonPress-1>',[ 'ShiftButton1' ] );
$mw->bind($class,'<Control-ButtonRelease-1>','Control_ButtonRelease_1');
$mw->bind($class,'<ButtonRelease-1>','ButtonRelease_1');
$mw->bind($class,'<Double-ButtonRelease-1>','NoOp');
$mw->bind($class,'<B1-Motion>',[ 'Button1Motion' ] );
$mw->bind($class,'<B1-Leave>',[ 'AutoScan' ] );
$mw->bind($class,'<Double-ButtonPress-1>',['Double1']);
$mw->bind($class,'<Control-B1-Motion>','Control_B1_Motion');
$mw->bind($class,'<Control-ButtonPress-1>',['CtrlButton1']);
$mw->bind($class,'<Control-Double-ButtonPress-1>',['CtrlButton1']);
$mw->bind($class,'<B1-Enter>','B1_Enter');
$mw->bind($class,'<Up>',['UpDown', 'prev']);
$mw->bind($class,'<Down>',['UpDown', 'next']);
$mw->bind($class,'<Shift-Up>',['ShiftUpDown', 'prev']);
$mw->bind($class,'<Shift-Down>',['ShiftUpDown', 'next']);
$mw->bind($class,'<Left>', ['LeftRight', 'left']);
$mw->bind($class,'<Right>',['LeftRight', 'right']);
$mw->PriorNextBind($class);
$mw->bind($class,'<Return>', ['KeyboardActivate']);
$mw->bind($class,'<space>', ['KeyboardBrowse']);
$mw->bind($class,'<Home>', ['KeyboardHome']);
$mw->bind($class,'<End>', ['KeyboardEnd']);
sub Control_ButtonRelease_1
if($w->cget('-selectmode') ne 'dragdrop');
if($w->cget('-selectmode') ne 'dragdrop');
delete $w->{'shiftanchor'};
delete $w->{tixindicator
};
$w->focus() if($w->cget('-takefocus'));
my $mode = $w->cget('-selectmode');
# $w->Send_WaitDrag($Ev->y);
my $ent = $w->GetNearest($Ev->y, 1);
if (!defined($ent) || !length($ent))
my @info = $w->info('item',$Ev->x, $Ev->y);
die 'Assert' unless $info[0] eq $ent;
if (defined($info[1]) && $info[1] eq 'indicator')
$w->{tixindicator
} = $ent;
$w->Callback(-indicatorcmd
=> $ent, '<Arm>');
elsif ($mode eq 'browse')
elsif ($mode eq 'multiple')
elsif ($mode eq 'extended')
$w->Callback(-browsecmd
=> @info);
my $to = $w->GetNearest($Ev->y, 1);
delete $w->{'shiftanchor'};
delete $w->{tixindicator
};
return unless (defined($to) and length($to));
my $mode = $w->cget('-selectmode');
if($mode eq 'extended' or $mode eq 'multiple')
my $from = $w->info('anchor');
$w->selectionSet($from, $to);
my ($w,$y,$undefafterend) = @_;
my $ent = $w->nearest($y);
my $borderwidth = $w->cget('-borderwidth');
my $highlightthickness = $w->cget('-highlightthickness');
my $bottomy = ($w->infoBbox($ent))[3];
$bottomy += $borderwidth + $highlightthickness;
if ($w->header('exist', 0)){ $bottomy += ($w->header('size', 0))[1]; };
if ($y > $bottomy){ return undef; }
my $state = $w->entrycget($ent, '-state');
return $ent if (!defined($state) || $state ne 'disabled');
delete $w->{'shiftanchor'};
my $mode = $w->cget('-selectmode');
my ($x, $y) = ($Ev->x, $Ev->y);
my $ent = $w->GetNearest($y, 1);
if (!defined($ent) and $mode eq 'single')
my $ent = $w->info('selection');
return unless (defined($ent) and length($ent));
if(exists $w->{tixindicator
})
return unless delete($w->{tixindicator
}) eq $ent;
my @info = $w->info('item',$Ev->x, $Ev->y);
if(defined($info[1]) && $info[1] eq 'indicator')
$w->Callback(-indicatorcmd
=> $ent, '<Activate>');
if($mode eq 'single' || $mode eq 'browse')
elsif($mode eq 'multiple')
elsif($mode eq 'extended')
$w->Callback(-browsecmd
=>$ent);
return unless defined $Ev;
delete $w->{'shiftanchor'};
my $mode = $w->cget('-selectmode');
if (defined $w->info('anchor'))
$ent = $w->GetNearest($Ev->y);
$ent = $w->GetNearest($Ev->y, 1);
return unless (defined($ent) and length($ent));
if(exists $w->{tixindicator
})
my $event_type = $w->{tixindicator
} eq $ent ?
'<Arm>' : '<Disarm>';
$w->Callback(-indicatorcmd
=> $w->{tixindicator
}, $event_type );
elsif ($mode eq 'multiple' || $mode eq 'extended')
my $from = $w->info('anchor');
$w->selectionSet($from, $ent);
$w->Callback(-browsecmd
=>$ent);
delete $w->{'shiftanchor'};
my $ent = $w->GetNearest($Ev->y, 1);
return unless (defined($ent) and length($ent));
unless(defined $w->info('anchor'));
$w->Callback(-command
=> $ent);
delete $w->{'shiftanchor'};
my $ent = $w->GetNearest($Ev->y, 1);
return unless (defined($ent) and length($ent));
my $mode = $w->cget('-selectmode');
$w->anchorSet($ent) unless( defined $w->info('anchor') );
if($w->select('includes', $ent))
$w->select('clear', $ent);
$w->Callback(-browsecmd
=>$ent);
my $anchor = $w->info('anchor');
delete $w->{'shiftanchor'};
unless( defined $anchor )
$anchor = ($w->info('children'))[0] || '';
return unless (defined($anchor) and length($anchor));
if($w->entrycget($anchor, '-state') ne 'disabled')
# We search for the first non-disabled entry (downward)
# Find the prev/next non-disabled entry
$ent = $w->info($spec, $ent);
last unless( defined $ent );
next if( $w->entrycget($ent, '-state') eq 'disabled' );
next if( $w->info('hidden', $ent) );
$w->yview('scroll', $spec eq 'prev' ?
-1 : 1, 'unit');
if($w->cget('-selectmode') ne 'single')
$w->selection('set', $ent);
$w->Callback(-browsecmd
=>$ent);
my $mode = $w->cget('-selectmode');
if($mode eq 'single' || $mode eq 'browse');
my $anchor = $w->info('anchor');
return $w->UpDown($spec) unless (defined($anchor) and length($anchor));
$w->{'shiftanchor'} = $anchor unless( $w->{'shiftanchor'} );
my $ent = $w->{'shiftanchor'};
$ent = $w->info($spec, $ent);
last unless( defined $ent );
next if( $w->entrycget($ent, '-state') eq 'disabled' );
next if( $w->info('hidden', $ent) );
$w->yview('scroll', $spec eq 'prev' ?
-1 : 1, 'unit');
$w->selection('set', $anchor, $ent);
$w->{'shiftanchor'} = $ent;
$w->Callback(-browsecmd
=>$ent);
delete $w->{'shiftanchor'};
my $anchor = $w->info('anchor');
$anchor = ($w->info('children'))[0] || '';
$ent = $w->info('parent', $e);
$ent = $w->info('prev', $e)
unless(defined $ent && $w->entrycget($ent, '-state') ne 'disabled')
$ent = ($w->info('children', $e))[0];
$ent = $w->info('next', $e)
unless(defined $ent && $w->entrycget($ent, '-state') ne 'disabled')
last unless( defined $ent );
last if($w->entrycget($ent, '-state') ne 'disabled');
$w->xview('scroll', $spec eq 'left' ?
-1 : 1, 'unit');
if($w->cget('-selectmode') ne 'single')
$w->Callback(-browsecmd
=>$ent);
$w->yview('moveto' => 0);
$w->xview('moveto' => 0);
$w->yview('moveto' => 1);
$w->xview('moveto' => 0);
my $anchor = $w->info('anchor');
return unless (defined($anchor) and length($anchor));
if($w->cget('-selectmode'))
$w->selectionSet($anchor);
$w->Callback(-command
=> $anchor);
my $anchor = $w->info('anchor');
return unless (defined($anchor) and length($anchor));
if ($w->indicatorExists($anchor))
$w->Callback(-indicatorcmd
=> $anchor);
if($w->cget('-selectmode'))
$w->selectionSet($anchor);
$w->Callback(-browsecmd
=>$anchor);
return if ($w->cget('-selectmode') eq 'dragdrop');
return unless defined $Ev;
$w->yview('scroll', 1, 'units');
$w->yview('scroll', -1, 'units');
$w->xview('scroll', 2, 'units');
$w->xview('scroll', -2, 'units');
$w->RepeatId($w->SUPER::after
(50,[ AutoScan
=> $w, $x, $y ]));
# Tix has core-tk window(s) which are not a widget(s)
# the generic code returns these as an "undef"
my @info = grep(defined($_),$w->winfo('children'));