I have a dialogbox, to which i populate elements(labels) on activate event.
I want to remove these elements(labels) when the window is being deactivated. something like:[its erroneous fragment of main code but explanatory]
my $wchRW = Win32::GUI::DialogBox->new(
-name => "wchR",
-title => "whed",
-left => CW_USEDEFAULT,
-size => [300, 130],
-parent => $mw,
);
$wchRW->AddGroupbox(
-name => "wchR_gb",
-text => "being watched",
-width => $wchRW->ScaleWidth() - $padding,
-height => 100,
-left => $padding/2,
);
sub wchR_Activate {
my $wchtxt = "sample";
# lbleft, lbtop are calculated here
$wchRW->AddLabel(
-name => "wchR_lb0",
-text => $wchTxt,
-left => $lbLeft,
-top => $lbTop,
);
}
sub gitni_wchR_Deactivate {
print "Here\n";
Win32::GUI::DestroyWindow($wchRW->wchR_lb0); #this is line n
}
#i have a button in main window $mw.
#onclick of this button this dialogbox is shown.
#sub b1_Click { $wchRW->DoModal(); return 0; }
But the problem is, "Here" in deactivate is called many times and an exception is thrown thereafter [can't locate auto/wchR_.al in #INC .... line n]. Freezing the main window and only option is to end process through task-manager.
Please help me out.
Why "here" is printed many times?
How to remove element permanently?
Thanks
The sub wchR_Deactivate will be invoked many times because it happens every time when dialog lost focus.
Normally you should not do AddLabel in _Activeate() event handler. All the thing should be created ahead. You could do Win32::GUI::Hide or Win32::GUI::Show to manipulate the control display status, and using $wchRW->wchR_lb0->Text($new_message) to change the message.
Related
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;
}
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);
Using Perl Tkx, I want to get some input from the user, close the window, and maybe do it again later. For user input, I'm just displaying some buttons, and the user gets to click on one of them. Here's what I have now:
sub prompt_user {
my $answer;
my $mw = Tkx::widget->new("."); ## the main window is unavailable the second time
$mw->g_wm_title("Window Title"); ## line 40
$mw->g_wm_minsize(300, 200);
my $label = $mw->new_label( -text => "Question to the user?");
$label->g_pack( -padx => 10, -pady => 10);
my $button1 = $mw->new_button(
-text => "Option One",
-command => sub { $answer = 0; $mw->g_destroy; },
);
$button1->g_pack( -padx => 10, -pady => 10);
my $button2 = $mw->new_button(
-text => "Option Two",
-command => sub { $answer = 1; $mw->g_destroy; },
);
$button2->g_pack( -padx => 10, -pady => 10);
Tkx::MainLoop(); ## This blocks until the main window is killed
return $answer;
}
So the user clicks on one of the buttons, the window closes, prompt_user() returns 0 or 1 (depending on which button the user clicked), and execution continues. Until I try to prompt the user again. Then I get an error:
can't invoke "wm" command: application has been destroyed at MyFile.pm line 40
I just want a way to put up a bunch of buttons, let the user click one, wait to see which one is clicked, and maybe do it again later. Is there a way I can wait for a response to the button click without destroying the main window? Maybe create a subwindow?
I'm new to using Tkx, and googling shows lots of simple examples like the above code (using MainLoop/g_destroy), but I couldn't find any examples of recreating windows. I did see stuff about a Dialog Box or Message Box, but those won't suit my needs. I want to put text on the buttons, and use an arbitrary number of buttons (so I don't want to be limited to yes/no/cancel, and only have 3 options).
Update
Here's what I was able to use
# hide the main window, since I'm not using it
my $mw = Tkx::widget->new(".");
$mw->g_wm_withdraw();
# function to prompt the user to answer a question
# displays an arbitrary number of answers, each on its own button
sub prompt {
my $prompt = shift;
my $list_of_answers = shift;
# Note: the window name doesn't matter, as long as it's './something'
my $answer = Tkx::tk___dialog( "./mywindowpath", # window name
"Prompt", # window title
$prompt, # text to display
undef, # tk bmp library icon
undef, # default button
#$list_of_answers); # list of strings to use as buttons
return $answer;
}
# use the button to ask a question
my $index = prompt("Who was the best captain?",
[ "Kirk", "Picard", "Cisco", "Janeway", "Archer" ] );
I'm not really familiar with Tkx but Tk doesn't really work well that way. In general Tk applications are asynchronous. You should re-write your application in term of callbacks (kind of like javascript).
Basically, this kind of logic:
sub do_something {
perform_some_action();
my $result = prompt_user();
perform_some_other_action($result);
}
should be re-written to something like:
sub do_something {
perform_some_action();
prompt_user(perform_some_other_action);
}
Your program should basically not have a main loop. Instead the call to Tkx::MainLoop at the end of your program becomes the main loop and you should do all processing by handling events.
Having said that, there are some mechanisms available that emulates blocking. Read the documantation for vwait. Though, I think even that requires a running Tkx::MainLoop so it does not necessarily avoid refactoring your whole program.
On the question of how to create and destroy windows there are two solutions:
Use the main window (.) but don't destroy it at the end. Instead hide it and destroy all its children. You can then later reuse . by unhiding it.
Hide . and don't use it. Instead create other windows (toplevels) and use them. Since toplevels are children of . they are safe to destroy without screwing up Tk.
I have a Perl script that is running an infinite loop. I'd like to be able to minimize this to the system tray. Can I use the Win32::GUI to create a system tray icon that when maximized shows the command prompt and the output of the script?
Edit: My perl script is a process by itself. Its running continuously. How can I run the systray icon a sanother process?
Yes, you can.
use Win32::GUI();
my $main = Win32::GUI::Window->new(
-name => 'Main',
-text => 'Perl',
-width => 200,
-height => 200
);
my $icon = new Win32::GUI::Icon('GUIPERL.ICO');
my $ni = $main->AddNotifyIcon(
-name => "NI",
-icon => $icon,
-tip => "Hello"
);
Win32::GUI::Dialog();
sub Main_Terminate {
return -1;
}
sub Main_Minimize {
$main->Disable();
$main->Hide();
return 1;
}
sub NI_Click {
$main->Enable();
$main->Show();
return 1;
}
Copied from:
Win32-GUI Tutorial Part4
If you want your tray icon in a different process you can use fork() but then you will need some way to comunicate father and child process.
I've used the ActiveState PerlTray component to do and it has worked well for me. Of course, it's a commercial offering though reasonably priced (in my opinion).
In my Perl/Tk script I have opened two windows. After a specific button click I want to close one of them. How can I do that? Here's what I have so far:
$main = new MainWindow;
$sidebar = $main->Frame(-relief => "raised",
-borderwidth => 2)
->pack (-side=>"left" ,
-anchor => "nw",
-fill => "y");
$Button1 = $sidebar -> Button (-text=>"Open\nNetlist",
-command=> \&GUI_OPEN_NETLIST)
->pack(-fill=>"x");
MainLoop;
sub GUI_OPEN_NETLIST
{
$component_dialog = new MainWindow;
$Button = $component_dialog -> Button (-text=>"Open\nNetlist",
-command=> **close new window**)
->pack(-fill=>"x");
MainLoop;
}
The simplist way is to call $component_dialog->destroy in the buttons -command callback. This has the disadvantage that if you want to redisplay the window later you have to recreate it.
The withdraw method will hide the window without destroying it so you can redisplay it later if you need to. This will save you some time when the button is pressed. The classes Dialog and DialogBox do this for you automatically when one of their buttons is pressed. If you need a window that behaves like a traditional dialog they can a much simpler option that building your own.
Also except in unusual cases you shouldn't need more than one call to MainLoop. When your callback GUI_OPEN_NETLIST returns the MainLoop will resume, explicitly calling MainLoop will likely lead to odd bugs later.
I think this is close to what your looking for, I haven't tested it though.
use strict;
use warnings;
my $main = new MainWindow;
my $sidebar = $main->Frame(-relief => "raised",
-borderwidth => 2)
->pack (-side=>"left" ,
-anchor => "nw",
-fill => "y");
my $Button1 = $sidebar -> Button (-text=>"Open\nNetlist",
-command=> \&GUI_OPEN_NETLIST)
->pack(-fill=>"x");
my $component_dialog = $main->Dialog( -buttons => [ 'Close' ], );
MainLoop;
sub GUI_OPEN_NETLIST
{
$component_dialog->Show();
}
If you don't want a dialog you should consider if you want to create a second MainWindow or create a Toplevel window dependant on your existing MainWindow.
A Toplevel will close automaticaly when it's MainWindow is closed, a second MainWindow will stay open after the other MainWindow is closed.