$ perl -d:Trace -MTk -e" tkinit()->Text()->pack; MainLoop" 2>2
$ grep -i bind 2 |grep -i "<3>"
Tk/Text.pm:146: $mw->bind($class, '<3>', ['PostPopupMenu', Ev('X'), E
+v('Y')] );
http://cpansearch.perl.org/src/SREZIC/Tk-804.029/Text/Text.pm
sub MenuLabels
{
return qw[~File ~Edit ~Search ~View];
}
sub SearchMenuItems
{
my ($w) = @_;
return [
['command'=>'~Find', -command => [$w => 'FindPopUp']],
['command'=>'Find ~Next', -command => [$w => 'FindSelectionNex
+t']],
['command'=>'Find ~Previous', -command => [$w => 'FindSelectionPre
+vious']],
['command'=>'~Replace', -command => [$w => 'FindAndReplacePo
+pUp']]
];
}
sub EditMenuItems
{
my ($w) = @_;
my @items = ();
foreach my $op ($w->clipEvents)
{
push(@items,['command' => "~$op", -command => [ $w => "clipboard$op
+"]]);
}
push(@items,
'-',
['command'=>'Select All', -command => [$w => 'selectAll']],
['command'=>'Unselect All', -command => [$w => 'unselectAll']],
);
return \@items;
}
sub ViewMenuItems
{
my ($w) = @_;
my $v;
tie $v,'Tk::Configure',$w,'-wrap';
return [
['command'=>'Goto ~Line...', -command => [$w => 'GotoLineNumberPop
+Up']],
['command'=>'~Which Line?', -command => [$w => 'WhatLineNumberPo
+pUp']],
['cascade'=> 'Wrap', -tearoff => 0, -menuitems => [
[radiobutton => 'Word', -variable => \$v, -value => 'word'],
[radiobutton => 'Character', -variable => \$v, -value => 'char']
+,
[radiobutton => 'None', -variable => \$v, -value => 'none'],
]],
];
}
http://cpansearch.perl.org/src/SREZIC/Tk-804.029/Tk/Widget.pm
}
sub PostPopupMenu
{
my ($w, $X, $Y) = @_;
if (@_ < 3)
{
my $e = $w->XEvent;
$X = $e->X;
$Y = $e->Y;
}
my $menu = $w->menu;
$menu->Post($X,$Y) if defined $menu;
}
sub FillMenu
{
my ($w,$menu,@labels) = @_;
foreach my $lab (@labels)
{
my $method = $lab.'MenuItems';
$method =~ s/~//g;
$method =~ s/[\s-]+/_/g;
if ($w->can($method))
{
$menu->Menubutton(-label => $lab, -tearoff => 0, -menuitems => $w
+->$method());
}
}
return $menu;
}
sub menu
{
my ($w,$menu) = @_;
if (@_ > 1)
{
$w->_OnDestroy('_MENU_') unless exists $w->{'_MENU_'};
$w->{'_MENU_'} = $menu;
}
return unless defined wantarray;
unless (exists $w->{'_MENU_'})
{
$w->_OnDestroy('_MENU_');
$w->{'_MENU_'} = $menu = $w->Menu(-tearoff => 0);
$w->FillMenu($menu,$w->MenuLabels);
}
return $w->{'_MENU_'};
}
perl tk trigger event
Tk::event->eventGenerate
$ perl -MTk -e" $a=tkinit(); $a->Button( qw! -text bam -command !, sub
+ { $b->eventGenerate(q!<3>!); } )->pack; $b = $a->Text()->pack; Main
+Loop"