Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
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 romping around the Monastery: (18)
As of 2015-07-07 14:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (90 votes), past polls