Re^3: Adding items to default Text widget <button-2> menus?

[Anonymous Monk]

$ 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"