#!/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>");
}
|