I'm searching for any moderately short example that I can download which would combine Perl/GTK or any other graphics environment with buttons displayed after excution.
#!/usr/bin/perl
use warnings;
use strict;
use Tk qw{ MainLoop };
my $mw = 'MainWindow'->new;
my $b_show;
$b_show = $mw->Button(-text => 'Show',
-command => sub {
$b_show->configure(-command => undef);
$mw->Button(-text => 'Quit',
-command => sub { exit })->pack;
})->pack;
MainLoop();
Related
I am using the perl Tk interface where I want to have a button test_1 and upon clicking on this button I would like a variable $varchoice to be defined as test_1. If I press on the button test_2, the variable $varchoice should be defined as test_2.
Before is the snippet of code in which I attempted to accomplish this:
$budget_frame->Button(-text => 'test_1',-command => sub{$varchoice=budget_plot_1()})->pack(-side => "left");
$budget_frame->Button(-text => 'test_2',-command => sub{$varchoice=budget_plot_2()})->pack(-side => "left");
sub budget_plot_1()
{
print "plotting 1\n";
my $var=1;
return $var;
}
sub budget_plot_2()
{
print "plotting 2\n";
my $var=2;
return $var;
}
How do I tweak this code to get the desired results?
Your program seems to work fine. Here is an example of how I tested it:
use feature qw(say);
use strict;
use warnings;
use Tk;
my $budget_frame = MainWindow->new(-title=>"Button test");
my $varchoice;
$budget_frame->Button(
-text => 'test_1',
-command => sub{ $varchoice = budget_plot_1() }
)->pack(-side => "left");
$budget_frame->Button(
-text => 'test_2',
-command => sub{ $varchoice = budget_plot_2() }
)->pack(-side => "left");
MainLoop;
say "Value of \$varchoice = $varchoice";
sub budget_plot_1()
{
print "plotting 1\n";
return "test_1";
}
sub budget_plot_2()
{
print "plotting 2\n";
return "test_2";
}
Output:
Value of $varchoice = test_1
I want to implement a history/recent-files functionality for my Perl/Tk program.
Here is a working code excerpt from my program to demonstrate my problem.
#!/usr/bin/perl
use strict;
use warnings;
use English qw( -no_match_vars );
use Tk;
my #history_entries = qw(Back To The History);
my $mw = MainWindow->new();
my $menubar = $mw->Menu();
$mw->configure( -menu => $menubar );
my $file = $menubar->cascade( -label => '~File' );
my $history = $file->cascade( -label => '~History', );
build_history();
MainLoop();
#=== FUNCTION ================================================================
# NAME: build_history
# PURPOSE: Polulate the history
#===============================================================================
sub build_history {
foreach (#history_entries) {
$history->command(
-label => $ARG,
-command => \&some_function,
-compound => 'left',
);
}
return;
} # ---------- end of subroutine build_history ----------
As you can see, the entries are created with $history->command but how can I delete them every time I call build_history?
The reason I want them deleted is that everytime a user opens a file, the last item (in this case 'History') should be deleted and a new item should be put on top of the list. So that I have a maximum of (in this example) four entries.
Any other ways of implementing this functionality with Tk are welcome.
Thanks for your time.
UPDATE:
I followed the advice of "mu" and tried to get the subwidgets with the children() function just after the function is called, like this:
my #child = $history->children();
foreach my $c ( #child ) {
if ($c->Exists()){
$c->destroy;
}
}
The program exits with the error:
Can't locate object method "children" via package "Tk::Menu::Cascade" at /home/alex/Desktop/stack_history.pl line 28.
you can create a submenu from the menubar first:
my $sub_menu = $menubar->Menu(-tearoff => 0);
Then you can pass this submenu to the cascade menuitem:
$file->cascade( -label => '~History', -menu => $sub_menu);
Then you can add/delete menuitems to the submenu:
foreach (#history_entries) {
$sub_menu->command(
-label => $ARG,
-compound => 'left',
);
}
...
$sub_menu->delete(0); # Remove first element
With this solution you can avoid rebulding the whole menu.
I ended up rebuilding the whole menu. That's how my code looks like atm. I am not proud of it but it works ... I am open to any form of advice.
#!/usr/bin/perl
use strict;
use warnings;
use English qw( -no_match_vars );
use Tk;
# History entries are stored in array
my #history_entries = qw(Back To The History);
my $mw = MainWindow->new();
$mw->geometry('200x200');
my $menubar = $mw->Menu();
#Build menus
$mw->configure( -menu => $menubar );
build_menu();
$mw->Button(
-text => 'Update History',
-command => \sub {
#when a user opens a file insert_history is called.
insert_history();
}
)->pack( -side => 'bottom', -anchor => 'sw' );
MainLoop();
#=== FUNCTION ================================================================
# NAME: build_menu
# PURPOSE: Update/Build the menu
#===============================================================================
sub build_menu {
#delete the whole menu
$menubar->delete(1);
#built it again
my $file = $menubar->cascade( -label => '~File' );
my $history = $file->cascade( -label => '~History', );
foreach (#history_entries) {
$history->command(
-label => $ARG,
-compound => 'left',
);
}
return;
} # ---------- end of subroutine build_menu ----------
#=== FUNCTION ================================================================
# NAME: insert_history
# PURPOSE: Do something with the array containing the history entries.
# Then rebuild the menu.
#===============================================================================
sub insert_history {
#make something with the array
my $last_element = pop #history_entries;
unshift #history_entries, $last_element;
#update menu
build_menu();
return;
} # ---------- end of subroutine insert_history ----------
I want to add a new widget to my script that will open a new window with text and will close automatically after 1sec.
how can I do it ?
I think what you want is Tk::after.
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
my $mw = MainWindow->new;
my $spawn = $mw->Button(
-text => 'spawn',
-command => sub {
my $subwindow = MainWindow->new;
my $label = $subwindow->Label(-text => "spawned");
$label->pack;
$subwindow->after(1_000, sub { $subwindow->destroy; });
}
);
$spawn->pack;
my $exit = $mw->Button(
-text => 'exit',
-command => sub { print "exiting...\n"; exit }
);
$exit->pack;
MainLoop;
myscript.pl
my $R;
my $f1 = "f1.log";
my $f2 = "f2.log";
my $f3 = "f3.log";
sub checkflags {
GetOptions('a=s' => \$f1,
'b=s' => \$f2,
'c=s' => \$f3,
);
open $R, '>', $f1 or die "Cannot open file\n"; # Line a
}
All the flags are optional.
If I call the script as
perl myscript.pl -a=filename
I need to append a .log to the filename before opening it at Line a.
For that I need to know whether GetOptions read something into $f1 or not.
How can this be done?
The simplest solution is to look for /[.]log$/ in $f1 and add it if it isn't present. Unfortunately that means that when the user passes in "foo.log" and wanted it to become "foo.log.log" it won't, but I think we can agree that user is a jerk.
A better option, that will make the jerk happy, is:
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
GetOptions(
'a=s' => \my $f1,
'b=s' => \my $f2,
'c=s' => \my $f3,
);
if (defined $f1) {
$f1 .= ".log";
} else {
$f1 = "f1.log";
}
print "$f1\n";
If you want to define all of default names at the top, use a different variable to do that (it is probably better reading code anyway):
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
my $default_f1 = "f1.log";
my $default_f2 = "f2.log";
my $default_f3 = "f3.log";
GetOptions(
'a=s' => \my $f1,
'b=s' => \my $f2,
'c=s' => \my $f3,
);
if (defined $f1) {
$f1 .= ".log";
} else {
$f1 = $default_f1;
}
print "$f1\n";
if (defined $f1) {
# You got a -a option
}
But personally I'd prefer to read the options into a hash and then use exists().
$f1 = "$f1.log" unless $f1 =~ m/\.log$/i;
Appends the log extension if the file name does not already have one. Since the default value ends in log, nothing happens. And it works if the user types the log on the command line.
One way to achieve this is to use Moose and MooseX::Getopt:
package MyApp;
use strict;
use warnings;
use Moose;
with 'MooseX::Getopt';
has f1 => (
is => 'ro', isa => 'Str',
cmd_aliases => 'a',
default => 'f1.log',
predicate => 'has_a',
);
has f2 => (
is => 'ro', isa => 'Str',
cmd_aliases => 'b',
default => 'f2.log',
predicate => 'has_b',
);
has f3 => (
is => 'ro', isa => 'Str',
cmd_aliases => 'c',
default => 'f3.log',
predicate => 'has_c',
);
# this is run immediately after construction
sub BUILD
{
my $this = shift;
print "a was provided\n" if $this->has_a;
print "b was provided\n" if $this->has_b;
print "c was provided\n" if $this->has_c;
}
1;
I'm trying to create a GUI for a conversion program. I want to create a frame containing the log file, but I can't get it. I found some codes to make the entire window scrollable, but it's not what I want. I just want to scroll a frame containing a label with a chainging text-variable.
I've even tried the following code:
$s = $parent->new_ttk__scrollbar(-orient => 'vertical', -command => [$frame, 'yview']);
$frame->configure(-scrollcommand => [$s, 'set']);
but I get an error. Perl says that scrollcommand is not a recognised command.
I've posted a piece of my code on pastebin : http://pastebin.com/d22e5b134
Frame widgets aren't scrollable (i.e. they don't support the xview and yview methods). Use a text widget instead of a label in a frame. If you're lazy, use Tkx::Scrolled to do it for you. If you're using a label because you want it to be read-only, use Tkx::ROText instead. And while I'm promoting my own modules, use Tkx::FindBar for a nice Find-As-You-Type search interface.
use strict;
use warnings;
use Tkx;
use Tkx::FindBar;
use Tkx::ROText;
use Tkx::Scrolled;
my $mw = Tkx::widget->new('.');
my $text = $mw->new_tkx_Scrolled('tkx_ROText',
-scrollbars => 'osoe',
-wrap => 'none',
);
my $findbar = $mw->new_tkx_FindBar(-textwidget => $text);
$findbar->add_bindings($mw,
'<Control-f>' => 'show',
'<Escape>' => 'hide',
'<F3>' => 'next',
'<Control-F3>' => 'previous',
);
$text->g_pack(-fill => 'both', -expand => 1);
$findbar->g_pack(
-after => $text,
-side => 'bottom',
-fill => 'x',
);
$findbar->hide();
open(my $fh, '<', __FILE__) or die;
$text->insert('end', do { local $/; <$fh> });
close $fh;
$mw->g_focus();
Tkx::MainLoop();