Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

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

by Anonymous Monk
on Jan 20, 2011 at 19:42 UTC ( #883397=note: print w/ replies, xml ) Need Help??


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

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


Comment on Re^3: Adding items to default Text widget <button-2> menus?
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://883397]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (12)
As of 2014-10-24 20:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (137 votes), past polls