Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Gtk2 Entry with validation and Pango coloration

by zentara (Archbishop)
on Jan 04, 2009 at 17:32 UTC ( [id://734025]=sourcecode: print w/replies, xml ) Need Help??
Category: Gui Programming
Author/Contact Info zentara of perlmonks
Description: Emmanual Rodriguez has come out with a helper module to do validation on an Gtk2::Entry widget. See Gtk2-Ex-Entry-Pango

This is a slightly modified version of one of the module's examples, that can be used to get data from a user. It also has a clever non-editable prompt, in the expose event.

#!/usr/bin/perl
use warnings;
use strict;
use Glib qw(TRUE FALSE);
use Gtk2 '-init';
use Gtk2::Ex::Entry::Pango;

# http://search.cpan.org/~potyl/Gtk2-Ex-Entry-Pango

# Gtk2::Ex::Entry::Pango module 
# by Emmanual Rodriguez 
# this example from the module, modified by
# me(zentara), for a bit more clarity

my $info; #global to pass entry text to continuing script

# Precompile the regex if desired.
# Disallow everything but small letters 
# a negated character class, so $1 matches below
# in the sub on_change.
# The difficulty in a precompiled regex, is that
# in the on_change sub needs to match illegal chars,
# while the validation portion of the script needs
# to match legal ones.

my $re = qr/([^a-z]+)/; # a negated character class 

my $window = Gtk2::Window->new();
$window->signal_connect(delete_event => sub { exit });
$window->set_position('center');   


my $entry = Gtk2::Ex::Entry::Pango->new();

#set a font and char width
my $font = Gtk2::Pango::FontDescription->from_string("Sans Bold 18");
$entry->modify_font($font);
$entry->set_width_chars(25);
    
my $vbox = new Gtk2::VBox(FALSE, 0);
$vbox->pack_start($entry, FALSE, FALSE, FALSE);
$vbox->set_focus_child($entry);
$window->add($vbox);
    
$entry->signal_connect(changed => \&on_change);

$entry->signal_connect ('key-press-event' => sub {
      my ($widget,$event)= @_;
         if( $event->keyval() == 65293){  # a return key press
              my $text = $entry->get_text;
          chomp $text;
          if( $text !~ /$re/ ){
                  #print "info good\n";
               $info =  $text;
               $window->destroy;
               Gtk2->main_quit();
               return 0;
            } 
            else {
              print "BAD $text\n"; 
          
           }
        }
    });

# add a greyed out prompt
$entry->signal_connect('expose-event' => \&on_expose); 
    
$window->show_all();
Gtk2->main();

#you can continue on here with a non-gui script if desired
print "Your info is $info, Hit a key to exit\n";
<>;
exit;

#################################3

# Each time that the text is changed we validate it. If there's an err
+or within
# the text we use Pango markup to highlight it.
#
sub on_change {
    my ($widget) = @_;
    my $string = $widget->get_text;

    # Validate the entry's text (accepting only letters)
#    $string =~ s/([^a-z]+)/apply_pango_makup($1)/egi;
#       I precompiled the regex above
    $string =~ s/$re/apply_pango_makup($1)/egi;
#       if ($1){print $1,"\n"}
        
    $widget->set_markup($string);
    $widget->signal_stop_emission_by_name('changed');
}


#
# Applies Pango markup to the given text. The text has the conflicting
+ XML
# characters encoded with entities first.
#
sub apply_pango_makup {
    my ($text) = @_;

    # Escape the XML entities - MUST be done before applying the Pango
+ markup
    $text = Glib::Markup::escape_text($text);

    # Apply the Pango markup to the escaped text
    return qq(<span underline="error" underline_color="red">$text</spa
+n>);
}

sub on_expose {
    my ($widget) = @_;
    return if $widget->get_text;
    # Set the widget's default text
    $widget->get_layout->set_markup("<span color='grey' size='smaller'
+>Search...</span>");
}

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://734025]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (8)
As of 2024-03-29 15:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found