$ 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')]  );

[download]

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'],
    ]],
  ];
}

[download]
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_'};
}

[download]
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"

[download]

In reply to Re^3: Adding items to default Text widget <button-2> menus? by Anonymous Monk
in thread Adding items to default Text widget <button-3> menus? by cmv

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.