Perl Tkx entry validation not working

697 views Asked by At

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.

GUI

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?

2

There are 2 answers

0
tjwrona On BEST ANSWER

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;
}
1
Michael Carman On

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.