How can I scroll a single frame in Perl Tk? - perl

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();

Related

perl TK combination/ I cannot find any example

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();

How to quote this parameter in perl module

I'm trying to use the AnyEvent::Twitter::Stream module and I want to reference a file that lists the Twitter uids I want to follow. I can put the uids in the code itself and it works as follows:
my $done = AnyEvent->condvar;
my $nt_filter = AnyEvent::Twitter::Stream->new(
username => $cf{account},
password => $cf{password},
method => 'filter',
follow => '15855509,14760150,18598536',
on_tweet => sub {
#some code.....
},
on_error => sub {
my $error = shift;
debug "ERROR: $error";
},
timeout => 45,
);
$done->recv;
But when I try to do the same using a file as such:
my $done = AnyEvent->condvar;
my $nt_filter = AnyEvent::Twitter::Stream->new(
open UID_FILE, "/tmp/uids" or die $!;
my #uid_line = <UID_FILE>;
username => $cf{account},
password => $cf{password},
method => 'filter',
follow => #uid_file,
on_tweet => sub {
#some code....
},
on_error => sub {
my $error = shift;
debug "ERROR: $error";
},
timeout => 45,
);
$done->recv;
it fails. The uids file has the following contents:
'15855509,14760150,18598536'
I'm getting a 406 error from Twitter, suggesting the format is not correct. I'm guessing the quotes are not correct somehow?
The AnyEvent::Twitter::Stream module subclasses AnyEvent and you don't need to access the base module at all. All the functionality is provided by the new method and the callbacks that you specify there, and you shouldn't call AnyEvent->condvar or $done->recv.
The open call and assignment to #uid_line don't belong inside the call to AnyEvent::Twitter::Stream->new.
Furthermore the variable you are using to supply the value for the follow parameter is #uid_file instead of #uid_line.
You must use strict; and use warnings; at the start of your programs, especially if you are asking for help with them. This will trap simple mistakes like this that you could otherwise overlook.
You can't in general use an array to supply a single scalar value. In this instance it may be OK as long as the file has only a single line (so there is only one element in the array) but there is a lot that could go wrong.
In addition you are passing single-quotes in the value that don't belong there: they appear in the code only to mark the start and end of the Perl string.
I suggest you read all decimal strings from your file like this
open my $uid_fh, '<', '/tmp/uids' or die $!;
my #uids;
push #uids, /\d+/g for <$uid_fh>;
(Note that these lines belong before the call to AnyEvent::Twitter::Stream->new)
Then you can supply the follow parameter by writing
follow => join(',', #uids),
I hope this is clear. Please ask again if you need further help.
Edit
These changes incorporated into your code should look like this, but it is incomplete and I cannot guarantee that it will work properly.
use strict;
use warnings;
use AnyEvent::Twitter::Stream;
open my $uid_fh, '<', '/tmp/uids' or die $!;
my #uids;
push #uids, /\d+/g for <$uid_fh>;
my %cf = (
account => 'myaccount',
password => 'password',
);
my $nt_filter = AnyEvent::Twitter::Stream->new(
username => $cf{account},
password => $cf{password},
method => 'filter',
follow => join(',', #uids),
on_tweet => sub {
#some code....
},
on_error => sub {
my $error = shift;
debug "ERROR: $error";
},
timeout => 45,
);
It looks to me like you are trying to pass an array in a scalar context so it is possible that you are setting follow to 1, the number of elements in the array (the number of lines in the file).
Assuming there is only a single line of IDs in your file, does the following work:
open UID_FILE, "/tmp/uids" or die $!;
# Load the first line of uids
my $uid_line = <UID_FILE>;
# Remove apostrophes from input.
# This may or may not be necessary
$uid_line =~ s/'//g;
# Don't forget to close the file
close(UID_FILE);
my $done = AnyEvent->condvar;
my $nt_filter = AnyEvent::Twitter::Stream->new(
username => $cf{account},
password => $cf{password},
method => 'filter',
follow => $uid_line,
on_tweet => sub {
#some code....
},
on_error => sub {
my $error = shift;
debug "ERROR: $error";
},
timeout => 45,
);
$done->recv;
You will probably need to strip the leading and trailing apostrophes from your input line. For example:
$uid_line =~ s/^'//;
$uid_line =~ s/'$//;
You could probably get away with just removing all apostrophes, e.g.:
$uid_line =~ s/'//g;

Delete the subwidgets/entries from a tk::menu widget

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

Change the behavior of the "-browsecmd" callback from Tk::Tree

my problem is that the subroutine from "-browsecmd" is called twice, when a user clicks on an entry. It activates when the left mouse button is pressed and when it is released. Is it possible to tell "-browsecmd" to only activate once?
Here is an example script that demonstrates my problem. Whenever a user clicks on an entry the print function is called twice.
#!/usr/bin/perl
use strict;
use warnings;
use English qw( -no_match_vars );
use Tk;
use Tk::Tree;
my $mw = MainWindow->new();
my $tree = $mw->Tree(
-width => '25',
-browsecmd => \sub {
my ($numbers) = #ARG;
print $numbers. "\n";
}
);
foreach (qw(one two three four five six )) {
$tree->add( $ARG, -text => $ARG ); #populates the tree
}
$tree->pack();
MainLoop();
Thanks for reading my message.
EDIT1: Forgot to post the link to the Tk::Tree Documentation
There's way to get rid of that behavior:
my $tree = $mw->Tree(
-width => '25',
-selectmode => "single", # <= this makes it work
-browsecmd => \sub {
my ($numbers) = #ARG;
print $numbers. "\n";
}
);
Found this by browsing the doc for the parent widget: Tk::HList (the BINDINGS section is interesting).
I've poked around and found that the Tk::Tree is really a Tix Tree under the hood. Digging around further finds a tutorial with the following snippet (adapted very slightly):
Example: “my browsecmd gets called twice”
tixScrolledListBox .list -browsecmd Browse
proc Browse args {
if {[tixEvent type] ne "<ButtonRelease-1>"} {
puts "browsing [tixEvent value]"
}
}
That looks highly relevant, but I don't see how tixEvent has been mapped into Perl. You might need to ask the Perl/Tk maintainer directly (or file a bug report).

XML-SAX Error: Not an ARRAY reference

(WinXP Pro, ActivePerl 5.10.1, and XML-SAX 0.96 used)
MyXML.xml as this
<?xml version="1.0" standalone="yes"?>
<DocumentElement>
<subItem>
<bib>0006</bib>
<name>Stanley Cheruiyot Teimet</name>
<team>肯尼亚</team>
<time>2:17:59</time>
<rank>1</rank>
<comment />
<gender>Male</gender>
<distance>Full</distance>
<year>2010</year>
</subItem>
</DocumentElement>
MyPerl.pl
#!/usr/bin/perl -w
use strict;
use XML::Simple;
use Data::Dumper;
use utf8;
open FILE, ">myXML.txt" or die $!;
my $tree = XMLin('./myXML.xml');
print Dumper($tree);
print FILE "\n";
for (my $i = 0; $i < 1; $i++)
{
print FILE "('$tree->{subItem}->[$i]->{distance}')";
}
close FILE;
Output:
D:\learning\perl\im>mar.pl
$VAR1 = {
'subItem' => {
'distance' => 'Full',
'time' => '2:17:59',
'name' => 'Stanley Cheruiyot Teimet',
'bib' => '0006',
'comment' => {},
'team' => '肯尼亚',
'rank' => '1',
'year' => '2010',
'gender' => 'Male'
}
};
Not an ARRAY reference at D:\learning\perl\im\mar.pl line 41.
I don't know what the Array reference means? The Dumper() works well.But can't print the data to TXT file.
Actually, the sample code ran well days before, Then I remember I upgrade my Komodo Edit from V5. to newest V6.
Today, I just try to improve the script, at the beginning stage, I fixed another error. "Could not find ParserDetails.ini" with google help. (I didn't get the error before!)
But now I get the ARRAY reference error. I already reinstalled my XML-SAX via PPM just now. It still doesn't work.
The whole stack for XML parsing that you have set up works fine, as the dump of the parsed tree shows. XML::SAX is not the cause of the problem, and it is only involved indirectly.
The error comes simply from improper access to the data structure which was generated by XML::Simple.
I can guess what happened. In an earlier version of your program, you had the ForceArray option enabled (that is a good practice, see OPTIONS and STRICT_MODE in XML::Simple), and the algorithm for traversing the parsed tree also was written to take this into account, i.e. there is array access involved.
In the current version of your program ForceArray is not enabled, but the traversing algorithm does not match the data structure any more. I suggest to re-enable options that are recommended in the documentation.
#!/usr/bin/env perl
use utf8;
use strict;
use warnings FATAL => 'all';
use IO::File qw();
use XML::Simple qw(:strict);
use autodie qw(:all);
my $xs = XML::Simple->new(ForceArray => 1, KeyAttr => {}, KeepRoot => 1);
my $tree = $xs->parse_file('./myXML.xml');
{
open my $out, '>', 'myXML.txt';
$out->say;
for my $subitem (#{ $tree->{DocumentElement}->[0]->{subItem} }) {
$out->say($subitem->{distance}->[0]); # 'Full'
}
}
The tree looks like this now:
{
'DocumentElement' => [
{
'subItem' => [
{
'distance' => ['Full'],
'time' => ['2:17:59'],
'name' => ['Stanley Cheruiyot Teimet'],
'bib' => ['0006'],
'comment' => [{}],
'team' => ["\x{80af}\x{5c3c}\x{4e9a}"],
'rank' => ['1'],
'year' => ['2010'],
'gender' => ['Male']
}
]
}
]
}