I just start Perl Tk and I had a look on some tutorials but I have a problem. When I click on a button it displays on the entry widget the scalar that I want. It works but when I click an other time it keeps what was written on the entry. So I have two hello. I know that it comes from insert(0, "Hello") but I don't what to put instead of 0.
#!/usr/local/bin/perl
use Tk;
my $mw = MainWindow->new;
$mw->geometry("500x350+0+0");
$mw->title("Report Information about a Protein of Interest");
my ($bite) = $mw -> Label(-text=>"Enter the uniprot accession number:")->grid(-row => 0, - column => 0);
my ($ent) = $mw->Entry()->grid(-row => 0, - column => 1, -columnspan => 2, -sticky => 'nsew');
$ent2 = $mw->Button(-text=> "Search", -command => \&push_button)->grid(-row => 1, - column => 0);
MainLoop;
#This is executed when the button is pressed
sub push_button {
$ent -> insert(0,"Hello, ");
}
The insert method for a Tk::Entry widget inserts text after the current insertion cursor position; to delete the existing text in the widget before inserting you can do:
sub push_button {
$ent -> delete(0, 'end'); # clears the widget
$ent -> insert(0,"Hello, ");
}
Related
I am trying to create an Open Office document using PERL and OpenOffice::OODoc, and I wish for the resulting document to be in the landscape orientation.
I tried going through the OpenOffice::OODoc::Styles, and the best I got is: switchPageOrientation(page); but I don't know what page is.
So I put together the following code:
#!/usr/bin/perl -w
use strict;
use Data::Dumper;
use OpenOffice::OODoc;
my $docFile = "../resources/landscape.odt";
my $doc = odfDocument( file => $docFile,
create => 'text' );
my $pageLayout = $doc->updatePageLayout(
"LandscapeStyle",
properties => {
'fo:margin-bottom' => '0.7874in',
'fo:page-width' => '11in',
'style:footnote-max-height' => '0in',
'style:shadow' => 'none',
'fo:margin-left' => '0.7874in',
'fo:margin-right' => '0.7874in',
'fo:page-height' => '8.5in',
'style:num-format' => '1',
'style:print-orientation' => 'landscape',
'style:writing-mode' => 'lr-tb',
'fo:margin-top' => '0.7874in'
}
);
$doc->switchPageOrientation($pageLayout);
$doc->appendParagraph( text => "Testing",
style => $pageLayout );
$doc->save;
print "\"$docFile\" is saved.\n";
print "Done.";
exit 0;
The Output is:
Odd number of elements in hash assignment at C:/Strawberry/perl/site/lib/OpenOffice/OODoc/Styles.pm line 1301.
Use of uninitialized value in list assignment at C:/Strawberry/perl/site/lib/OpenOffice/OODoc/Styles.pm line 1301.
"../resources/landscape.odt" is saved.
Done.`
The document is created but not in landscape, rather within the regular portrait orientation.
Does anyone know what page is, and how I can get it to change my document?
Any ideas?
I have Gtk2::TreeView, some of columns are using CellRendererCombo. I have everything work ok, except of I can't get integer index of selected item in CellRendererCombo. Not a text, but the integer value.
As a workaround, it could be useful to associate somehow a hash with combo_model, but I don't know how.
Could somebody help me? Trying and googling for a couple of days already.
Here's the code:
#!/usr/bin/perl
package uform;
use utf8;
use warnings;
use strict;
use Gtk2 -init;
use Glib qw/TRUE FALSE/;
use Glib ':constants';
use Data::Dumper;
use constant col0 => 0;
use constant col1 => 1;
use constant col2 => 2;
use constant colC => 3;
binmode(STDOUT,':utf8');
my $model; my $treeview; my #attr_models;
sub create_window ($$) {
my ($width,$height)=(shift,shift);
my $window = Gtk2::Window->new( "toplevel" );
$window->signal_connect( "destroy", sub { Gtk2->main_quit(); } );
$window->set_default_size($width,$height);
my $vbox = Gtk2::VBox->new( 0, 5 );
$model = Gtk2::ListStore->new(
"Gtk2::Gdk::Pixbuf", #0 pic
"Glib::String", #1 product
"Glib::String", #2 attr
"Gtk2::ListStore" #combo values list
);
#sample_data
#some combo lists
foreach my $d (
[qw(fast medium slow)],
[qw(greay orange black white rainbow)],
[qw(fat with_wholes molded)],
[qw(long short jeans)]
)
{
my $cmodel = Gtk2::ListStore->new('Glib::String');
foreach my $str (#$d) {$cmodel->set($cmodel->append,0,$str);}
push #attr_models,$cmodel;
}
#some pixbufs to play with
my $pixbuf2 = Gtk2::Button->new->render_icon ('gtk-info', 'large-toolbar');
#add some rows
my #data = (
[$pixbuf2,'Shirt',1,$attr_models[0]],
[$pixbuf2,'Pants',0,$attr_models[0]],
[$pixbuf2,'Cheese',2,$attr_models[1]],
[$pixbuf2,'Cola',1,$attr_models[2]],
[$pixbuf2,'Laptop',0,$attr_models[3]]
);
foreach my $st(#data) {
$st->[2]=$st->[3]->get($st->[3]->iter_nth_child(undef,$st->[2]), 0);
$model->set( $model->append,
0, $st->[0],
1, $st->[1],
2, $st->[2],
3, $st->[3],
);
}
#Column0 setup
my $combo_model0 = Gtk2::ListStore->new( 'Gtk2::Gdk::Pixbuf' );
my $renderer_0 = Gtk2::CellRendererPixbuf->new;
my $column_0 = Gtk2::TreeViewColumn->new_with_attributes(
"Pic",
$renderer_0,
pixbuf => col0
);
#Column1 setup
my $renderer_1 = Gtk2::CellRendererText->new;
$renderer_1->set( editable => FALSE );
my $column_1 = Gtk2::TreeViewColumn->new_with_attributes(
"Product",
$renderer_1,
text => col1
);
#Column2 setup
my $renderer_2 = Gtk2::CellRendererCombo->new;
$renderer_2->set(
editable => TRUE,
text_column => 0,
has_entry => FALSE
);
$renderer_2->signal_connect (changed => sub {
my ($renderer, $str, $iter)=#_;
print Dumper (#_) . "\n";
}
);
$renderer_2->signal_connect (edited =>
sub {
my ($renderer, $text_path, $new_text) = #_;
my $combo_model = $renderer->get("model");
$model->set ($model->get_iter_from_string ($text_path), col2, $new_text);
}
);
my $column_2 = Gtk2::TreeViewColumn->new_with_attributes(
"Attr",
$renderer_2,
text => col2,
model => colC
);
# main program starts
$treeview = Gtk2::TreeView->new( $model );
$treeview->get_selection->set_mode ('single');
$treeview->set_rules_hint( TRUE );
$treeview->append_column( $column_0 );
$treeview->append_column( $column_1 );
$treeview->append_column( $column_2 );
my $sw = Gtk2::ScrolledWindow->new( undef, undef );
$sw->set_shadow_type( "etched-in" );
$sw->set_policy( "never", "always" );
$sw->add( $treeview );
$vbox->pack_start( $sw, 1, 1, 0 );
$window->add( $vbox );
$window->show_all;
}
So, looks like there isn't any direct answer for this question.
As a workaround, you may create array of hashes. Each element corresponds to one TreeView's row and have e.g. fields like 'combo_hash' and 'current_index'.
'current_index' is self-explained, 'combo_hash' is array which consists of hashes with some fields like 'text' and e.g. 'index' (or other id).
On CellRendererCombo's 'edited' signal you get current TreeView's index by $treeview->get_selection()->get_selected_rows()->get_indices() (it's simple int), and search for selected in CellRendererCombo's 'text' field through 'combo_hash' array. Don't forget to store finded 'index' to 'current_index'.
This workaround allows non-unique text in different TreeView's rows, but can't handle non-unique text in one CellRendererCombo's ListStore.
Another workaround is to inherite subclass from CellRenderer and embed ComboBox, which provides simple integer index. Looks better and have no limitations by non-unique data, but if array of hashes is unavoidable by design (you need to store lots of other info not visible in TreeView), first workaround should be more relevant.
I am having an issue getting my text validation to work properly. Basically I have 2 entry boxes, one to enter the name of a branch in CVS and the other to enter a directory name. I want my program to validate the text in each box whenever it is changed.
To do this, the documentation online says to use the "key" option to validate the entry whenever a keystroke changes the entry box's contents. The problem is, when I use the "key" option and then run the program, when I type into the entry boxes no text appears.
My code is shown below:
use strict;
use warnings;
use Tkx;
# Initialize BRANCH and DIRECTORY
my ($BRANCH, $DIRECTORY) = ();
# DEFINE DISPLAY OBJECTS ###########################################################################
# Define main window
my $main_window = Tkx::widget->new('.');
# Define content frame
my $content_frame = $main_window->new_ttk__frame(-padding => '5 5 5 5');
# Define labels
my $branch_label = $content_frame->new_ttk__label(-text => 'Branch' );
my $directory_label = $content_frame->new_ttk__label(-text => 'Directory');
# Define entry boxes
my $branch_entry = $content_frame->new_ttk__entry(-width => 20, -textvariable => \$BRANCH , -validate => 'key', -validatecommand => \&check_state);
my $directory_entry = $content_frame->new_ttk__entry(-width => 20, -textvariable => \$DIRECTORY, -validate => 'key', -validatecommand => \&check_state);
# Define buttons
my $generate_list_button = $content_frame->new_ttk__button(-text => 'Generate', -state => 'disabled', -command => \&generate_list);
# POSITION DISPLAY OBJECTS #########################################################################
# Position content frame
$content_frame->g_grid(-column => 0, -row => 0);
# Position labels
$branch_label ->g_grid(-column => 0, -row => 0);
$directory_label->g_grid(-column => 0, -row => 1);
# Position entry boxes
$branch_entry ->g_grid(-column => 1, -row => 0);
$directory_entry->g_grid(-column => 1, -row => 1);
# Position buttons
$generate_list_button->g_grid(-column => 0, -row => 2, -columnspan => 2);
# Add padding
for my $child (Tkx::SplitList($content_frame->g_winfo_children)) {
Tkx::grid_configure($child, -padx => 5, -pady => 5);
}
# Check the state of the program
sub check_state {
# Check conditions are met to enable generate_list
if ($BRANCH && $DIRECTORY) {
if (-d $DIRECTORY) {
$generate_list_button->state('!disabled');
} else {
$generate_list_button->state('disabled');
}
} else {
$generate_list_button->state('disabled');
}
return 0;
}
Tkx::MainLoop();
If I change "key" to something else (like focusout) it appears to work correctly. But I would really like it to validate after every keystroke instead of just when the focus is taken out of the entry box. Why doesn't this work?
Your check_state subroutine always returns 0 which means "validation failed" and prevents
the text from being entered. Since you aren't really validating the text -- just using the validation mechanism to trigger state updates to related widgets -- you should return 1 (unconditionally) instead. See validatecommand in the (Tcl) Tk documentation for more details.
The subroutines returning 0 turned out to be only half the problem. Once I fixed that the entry validation was not acting properly. What was happening was every time it tried to validate the entry it would actually be validating the previous entry.
ex:
If you typed in "/somedirectory" it would try to validate on every keystroke, after the last keystroke of "y" it would get the value of $DIRECTORY and validate against it. The problem was that at this point $DIRECTORY would be equal to "/somedirector"
To solve this issue I had to do a little digging so I wanted to post my findings in case someone else ran into this same issue.
The solution was to use Tkx::Ev() to get the "current" value of the entry as it was being entered.
(Tkx::Ev(%P) gets the newly entered value so the validation will work properly)
# Define the entry box
my $directory_entry = $content_frame->new_ttk__entry(
-width => 20,
-textvariable => \$DIRECTORY,
-validate => 'key',
-validatecommand => [\&check_dir, Tkx::Ev('%P')],
);
# Validate the entry box
sub check_dir {
# Unpack input arguments
my ($P) = #_;
if (-d $P) {
# Do something here
} else {
# Do something else here
}
return 1;
}
I am trying to create a GUI window using perl.
But the created GUI window size differs in different system.
Could anyone please tell me, how to set the fixed size, so that, it won't change depends on the following factors,
- Any resolution we set in our desktop
- Any system we use
- Any OS we use
Code Snippet i used in Perl:
use Tkx;
my $MainWindow = Tkx::widget -> new(".");
$MainWindow -> g_wm_geometry("600x15+340+612");
$MainFrame = $MainWindow -> new_ttk__frame();
$ExtractionTypeLabel = $MainFrame -> new_ttk__label(-text => <<TEXT>>,
-padding => 10,
);
$ExtractionTypeSingle = $MainFrame -> new_ttk__radiobutton(-text =>$ConfMainSingleExtractionText,
-variable => \$ExtractionTypeVal,
-value => $ConfMainSingleExtractionText,
-command => \&SINGLE_RADIO_BUTTON_LISTENER,
);
##### ALIGNMENT IN GRID LAYOUT #####
$ExtractionTypeLabel -> g_grid(-row => 3, -column => 0, -pady => 1);
$ExtractionTypeSingle -> g_grid(-row => 4, -column => 0, -ipadx => 4);
##### PACK #####
$MainFrame -> g_pack(-in => $MainWindow);
Tkx::MainLoop();
exit;
Try this to set a particular window size.
$MainWindow ->configure( -width=> 100, -height=> 100 );
So, I just started trying to use the perl curses module for a project I'm working on. The documentation seems to be extremely lacking, what little I can find on cpan seems to be half-finished and assumes previous curses library experience, which I don't have. I have two issues I am trying to solve, my code so far:
#!/usr/bin/perl
use strict;
use Curses::UI;
use Term::ReadKey;
my ($cols, $rows, $wp, $hp) = GetTerminalSize();
my $cui = new Curses::UI( -color_support => 1);
sub eDialog {
my $return = $cui->dialog(
-message => "Are you sure?",
-title => "Really quit?",
-buttons => ['yes', 'no']
);
exit(0) if $return;
}
sub entryUpdate {
my $mainentry = shift;
if($mainEntry->get() =~ m/.*\n$/)
{
print STDERR $mainEntry->get();
}
}
$cui->set_binding( \&eDialog , "\cQ");
my $mainWin = $cui->add(
'viewWin', 'Window',
-border => 1,
-height => ($rows - 3),
-bfg => 'green'
);
my $mainView = $mainWin->add(
"viewWid", "TextViewer",
-wrapping => 1
);
my $entryWin = $cui->add(
'entryWin', 'Window',
-border => 1,
-y => ($rows - 3),
-height => 1,
-bfg => 1
);
my $mainEntry = $entryWin->add(
"entryWid", "TextEntry",
-onchange => \&entryUpdate()
);
$mainEntry->focus();
$cui->mainloop();
I managed to get the UI set up how I want it, but actually making it work is proving problematic.
1). I want to be able to, when text is typed into the $mainEntry widget, detect when enter/return is pressed, and execute a subroutine to do stuff with the text typed into the widget, then clear it out. (I tried accomplishing this with the entryUpdate subroutine, but that isn't working at all, no matter how I've tried to do it.)
2). I want to be able to periodically (Say, every 1 second or 500ms), execute another subroutine, and have the string it returns added to the $mainView widget.
Getting either or both of these to work has proven to be a huge issue thus far, I just dont know enough about how curses works and I haven't been able to find the information I need anywhere. Any help would be much appreciated.
1) You can simply bind the return key to a subrouting using set_binding:
use Curses qw(KEY_ENTER);
$mainEntry->set_binding(sub {
$mainView->text($mainView->text . $mainEntry->get . "\n");
$mainView->draw;
$mainEntry->text("");
}, KEY_ENTER);
2) It seems that there are timer methods (found them by grepping the Curses-UI source code), but they are not documented, which is probably an issue. Here's how it's used:
$cui->set_timer('timer_name', sub {
$mainView->text($mainView->text . scalar(localtime)."\n");
$mainView->draw;
}, 1);