Putting It All Together
This section goes through the design and implementation of a real-world program. The assignment is to come up with a pattern-searching program called tk_grep.pl.
The GUI for this program was shown earlier (refer to Figure 13.4).
The user specifies a regular expression in the Pattern box and a set of files in the Files box and then clicks on Search to search all the files for the given pattern. The results are shown in a pop-up window.
First, you need a main window:
my $tk_mw = MainWindow–>new();
Next, you construct the main GUI. The top two widgets are a label for the Pattern string and an Entry for the pattern itself. You also need a frame in which to put them.
So create the frame and the two widgets. First the frame:
my $tk_top_frame = $tk_mw–>Frame(
)–>pack(
–side => "top",
–fill => "x"
);The frame goes against the top of the window. It is allowed to expand to fill any extra space, but in the x direction only. Next add in the label:
$tk_top_frame–>Label(
–text => "Pattern:"
)–>pack(
–side => "left"
);The label goes on the left side of the frame. It does not expand in any way.
The text entry follows:
my $tk_entry = $tk_top_frame–>Entry(
–textvariable => $pattern
)–>pack(
–side => "right",
–fill => "x",
–expand => 1
);The text entry is on the right side of the frame. It is allowed to expand in the x direction.
So the frame and entry can expand in the x direction. This means that if you make the window larger, the geometry manager will make the frame larger in the x direction. Because the frame is larger, the entry widget will grow to fill the available space (see Figure 13.6).
Figure 13.6. tk_grep after stretching.
The next line contains the Files blank. Because this requires essentially the same code as the first line, a subroutine called lab_box was created to do the work for both lines. You just call it twice.
Finally, you have two action buttons at the bottom of the window:
$button_frame–>Button(
–text => "Search",
–command => sub {search($tk_mw);}
)–>pack(
–side => "left",
–anchor => "e"
);
$button_frame–>Button(
–text => "Cancel",
–command => sub {print "Cancel Pushed
"; exit(); }
)–>pack(
–side => "right",
–anchor => "w"
);Searching
When the Search button is clicked, the program needs to search a list of files and display the results in a pop-up window.
The first step is to check the input to make sure that it’s valid:
sub search($)
{
my $parent = shift; # The parent window for our popup
#...
if ($pattern eq "") {
error_box($parent, "No search pattern");
return;
}
if ($file_list eq "") {
error_box($parent, "No file specification");
return;
}Next, you need to get a list of files to check. This is done using the glob function, which takes a file specification with wildcards (*, ?, and so on) in it and returns a list of the matching files:
my @file_list = glob($file_list);
At this point, you know that all the input fields are valid, so the results appear in the pop-up window:
my $tk_top = $parent–>Toplevel();
my $tk_text = $tk_top–>Scrolled(
'Text',
–scrollbars => "osoe",
–width => 80,
–height => 10,
–wrap => 'none'
)–>pack(
–side => "top",
–expand => 1,
–fill => "both"
);The results are placed in a Text widget. Because the widget may have scrollbars, the Scrolled method is used to create it. The scrollbars will be at the bottom (s) and right (e). They will appear only if needed (o).
The other element of this window is a Close button, which destroys the window:
$tk_top–>Button(
–text => "Close",
–command => sub {$tk_top–>destroy();}
)–>pack(
–side => "top",
–anchor => "w"
);The code then goes through each line of each file and checks to see whether it matches the pattern. If it does, a line number is added, and the result is inserted onto the end of the text in the Text widget:
if ($line =~ $pattern) {
my $display_line = sprintf("%3d %s",
$line_number, $line);
$tk_text–>insert('end', $display_line);
}The only other significant GUI element is the error box, which is displayed when there’s a problem. For this, you use a special method called messageBox.
The messageBox function displays a message and then waits until the user responds to it. This is different from most other Tk widgets, which use a call-back function to handle events.
In this case, you want an error type message box to be displayed, so use the following code:
sub error_box($$)
{
my $parent = shift;
my $message = shift;
$parent–>messageBox(
–icon => "error",
–title => "Error",
–message => $message,
–type => "ok");
}Listing 13.2 contains the full tk_grep.pl program.
Listing 13.2. tk_grep.pl
use strict;
use warnings;
use Tk;
use Tk::LabEntry;
my $pattern = ""; # The pattern to search for
my $file_list = "*.c"; # The files to search
######################################################
# error_box($parent, $message)
#
# Display an error message and wait until the user
# presses OK to continue.
######################################################
sub error_box($$)
{
my $parent = shift; # The parent window
my $message = shift;# The message to display
$parent–>messageBox(
–icon => "error",
–title => "Error",
–message => $message,
–type => "ok");
}
######################################################
# search($main_window)
#
# Perform a search through all the files
######################################################
sub search($)
{
my $parent = shift; # The parent window for our popup
if ($pattern eq "") {
error_box($parent, "No search pattern");
return;
}
if ($file_list eq "") {
error_box($parent, "No file specification");
return;
}
# The list of files to search
my @file_list = glob($file_list);
if ($#file_list == –1) {
error_box($parent, "No files match the specification");
return;
}
# The top level window for our results
my $tk_top = $parent–>Toplevel();
# The window to contains the actual text of the
# results
my $tk_text = $tk_top–>Scrolled(
'Text',
–scrollbars => "osoe",
–width => 80,
–height => 10,
–wrap => 'none'
)–>pack(
–side => "top",
–expand => 1,
–fill => "both"
);
$tk_top–>Button(
–text => "Close",
–command => sub {$tk_top–>destroy();}
)–>pack(
–side => "top",
–anchor => "w"
);
# Loop through each file
foreach my $cur_file (@file_list)
{
if (not open(IN_FILE, "<$cur_file"))
{
error_box($parent, "Could not open $cur_file");
next;
}
# Loop through each line
my $line_number = 1;
while (1) {
my $line = <IN_FILE>;
if (not defined($line)) {
last;
}
if ($line =~ $pattern) {
my $display_line = sprintf("%3d %s",
$line_number, $line);
$tk_text–>insert('end', $display_line);
}
$line_number++;
}
close (IN_FILE);
}
}
######################################################
# lab_box($window, $label, $var)
#
# Create a box consisting of a label and a entry.
######################################################
sub lab_box($$$)
{
my $window = shift; # the parent of the widgets
my $label = shift; # The text for the label
my $var = shift; # The variable for the entry
# The frame we use to hold our two widgets
my $frame = $window–>Frame(
)–>pack(
–side => "top",
–fill => "x"
);
$frame–>Label(
–text => $label
)–>pack(
–side => "left"
);
# The entry widget
my $tk_entry = $frame–>Entry(
–textvariable => $var
)–>pack(
–side => "right",
–fill => "x",
–expand => 1
);
$tk_entry–>bind('<Return>', sub {search($window);});
}
# The main window
my $tk_mw = MainWindow–>new();
lab_box($tk_mw, "Pattern: ", $pattern);
lab_box($tk_mw, "Files: ", $file_list);
# The frame we use for the buttons
my $button_frame = $tk_mw–>Frame(
)–>pack(
–side => "top",
–fill => "both"
);
$button_frame–>Button(
–text => "Search",
–command => sub {search($tk_mw);}
)–>pack(
–side => "left",
–anchor => "e"
);
$button_frame–>Button(
–text => "Cancel",
–command => sub {print "Cancel Pushed
"; exit(); }
)–>pack(
–side => "right",
–anchor => "w"
);
MainLoop(); |