Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

How to popup a widget such as “entry” or “label” at the mouse location

by smh (Novice)
on Mar 04, 2012 at 07:19 UTC ( #957737=perlquestion: print w/ replies, xml ) Need Help??
smh has asked for the wisdom of the Perl Monks concerning the following question:

Hi All,

I am writing code Perl TK. I am want to popup a widget such as “entry” or “label” at the mouse location in a tree widget. I have been trying ideas similar to what I have seen done with popup menu. I have read your peace “Tk::Wm::Popup” on CPAN. <\P>

"...For this discussion, we'll use the simple term dialog to refer any widget that pops up and awaits user interaction, whether it be a Menu, a special purpose Toplevel, or any of the dialog-type widgets, including, but not limited to, ColorEditor, Dialog, DialogBox, ErrorDialog, FileSelect, FBox, getOpenFile and getSaveFile. ..."

I assume that I should be able to able to popup simple widgets. Here is my test code.

use Tk; use Tk::Entry; use Tk::Tree; use Tk::Notebook; use warnings; use strict; my $mw = MainWindow->new(); my $nb = $mw->NoteBook( -font => 'Tahoma 8 bold', )->pack( -side => 'top', -anchor => 'ne', -expand => 1, -fill => 'both', ); my $tb = $nb->add( 'Tab 1', -label => 'Tab1', ); my $tree = $tb->Scrolled( 'Tree', -background => 'snow', -selectmode => 'extended', -selectbackground => '#E0FFCC', -selectforeground => 'red', -highlightthickness => 0, -relief => 'ridge', -borderwidth => 2, -scrollbars => 'osoe', -drawbranch => 'true', -indicator => 'true', -selectborderwidth => -1, -selectmode => 'extended', #-browsecmd => \&my_command, )->pack(-side => 'top', -anchor => 'nw', -expand => 1, -fill => 'both', ); # ##================================= # ## popup menu works fine # ##================================= # my $mb = $tree->Menu; # $tree->bind("<Button-3>" => sub { $mb->Popup( -popover => "cursor", # -tearoff => 0, # -popanchor => 'nw', # -overanchor => 'ne' # ) # } # ); # # my $mdel = $mb->cascade( -label => 'Delete', # -tearoff => 0, # ); # # $mdel->command( -label => "Delete", # -command => sub{ my @E = $tree->info( 'selection' ); # foreach my $e ( @E ) # { # $tree->delete( 'entry', $e); # } # } # ); ##================================= ## popup an entry that does NOT work ##================================= my $w = $tree->Frame(); $w->label( -text => 'popup label' ); $tree->bind("<Button-3>" => sub{ $w->Popup( -popover => "cursor", -popanchor => 'nw', -overanchor => 'ne' ) } ); MainLoop;

Comment on How to popup a widget such as “entry” or “label” at the mouse location
Download Code
Re: How to popup a widget such as “entry” or “label” at the mouse location
by Anonymous Monk on Mar 04, 2012 at 09:07 UTC

    I assume that I should be able to able to popup simple widgets.

    Why? The docs say

    You've probably had occasion to use a Dialog (or DialogBox) widget. These widgets are derived from a Toplevel (which is a subclass of Tk::Wm, the window manager)

    A Tk::Frame is not a Toplevel

Re: How to popup a widget such as “entry” or “label” at the mouse location
by zentara (Archbishop) on Mar 04, 2012 at 16:58 UTC
    To amplify on what AnonymousMonk said about it requiring a Toplevel window to display an arbitrary widget ( other than a Menu ), your best hack is to try and use an overrideredirect window. Here is a simple example, and you will need to work out the details of the enter/leave bindings for your Tree. It helps that bind sends the the calling widget as the first element of @_.
    #!/usr/bin/perl use warnings; use Tk; use strict; my $main = new MainWindow; $main->geometry('200x200'); $main->Button(-text=>"click",-command=>sub{ print "Button left click\n"; })->pack; $main->bind('<ButtonPress-3>', \&some_sub); MainLoop; sub some_sub{ print "@_\n"; my $widget = shift; my $x = $widget->pointerx; my $y = $widget->pointery; my $mw_bdw = 2; #mainwindow border width ### Create a Mainwindow ### my $top = new MainWindow(-borderwidth=>$mw_bdw, -relief=>'ridge', -bg => "#0000FF"); $top->geometry("150x100+$x+$y"); # displaying at top left on any resol +ution $top->overrideredirect(1); # Remove window decorations and keep on all + screens ### create a text widget ### my $imstr = "THIS IS A TEST NOTIFICTION LONG ENOUGH TO WRAP"; my $TEXT = $top->Text( -foreground=> 'white', -background=> '#0000FF', -wrap => 'word', -height => 7, -width => 50)->pack; $TEXT->insert('end', "$imstr", ); #$top-> after(5000, \&exitprg); # autoclose in 5000 milisecs $top->bind('<ButtonRelease>',sub{$top->destroy}); #or sub exitprg MainLoop; #### FUNCTIONS #### sub exitprg { my $top = shift; print STDERR "CALLED EXIT\n"; $top-> destroy; # to kill the window and exit from prog } }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (9)
As of 2015-07-03 16:27 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 (54 votes), past polls