#! /usr/contrib/bin/perl -w

my $version_id =
  '$Id: xmsg.pl,v 1.13 1999/10/19 19:01:57 v2kea318 Exp $ ';

# $Log: xmsg.pl,v $
# Revision 1.13  1999/10/19  19:01:57  v2kea318
# *** empty log message ***
#
# Revision 1.12  1999/10/18  23:26:37  v2kea318
# *** empty log message ***
#
# Revision 1.11  1999/10/18  18:34:48  v2kea318
# *** empty log message ***
#
# Revision 1.10  1999/10/18  17:40:02  v2kea318
# Abort the perform_search routine if there is no string to search for.
#
# Revision 1.9  1999/10/18  16:58:16  v2kea318
# Show an error_message window if a search operation fails to find the
# desired string.  Did some minor code cleanup, especially in the assignment
# of default values for optional parameters to subroutines.
#
# Revision 1.8  1999/10/15  20:20:38  v2kea318
# Added a search feature to the log display window.  This is accessed
# via the 'search' button, or by the command key ^s.  Currently, only case-
# sensitive exact matches are possible for the search.
#
# Revision 1.7  1999/10/04  17:29:29  v2kea318
# Handle the duplicate key exception from MSGaliases::setkey.
#
# Revision 1.6  1999/08/30  16:17:09  v2kea318
# Only compile the log extraction regexp once, rather than recompiling it
# each time through the loop.
#
# Revision 1.5  1999/08/30  16:05:01  v2kea318
# Improved the regexp which extracts the individual messages from the log.
# It is no longer required to add an artificial header to the log because
# we may optionally match the of the string.
#
# Revision 1.4  1999/08/12  19:04:25  v2kea318
# When sorting the mispelled words, use the map function rather than
# a foreach loop to build the temporary hash.
#
# Revision 1.3  1999/08/12  18:54:42  v2kea318
# When checking the output of msg_locate, look for 'error' at the beginning
# too.  This considers the case that the server isn't running or we for
# some other reason failed to connect.
#
# Revision 1.2  1999/08/11  22:09:36  v2kea318
# *** empty log message ***
#
# Revision 1.1  1999/08/11  19:57:44  v2kea318
# Initial revision
#
#***************************************************************************

=head1 NAME

xmsg - a graphical interface to msg

=head1 DESCRIPTION

B<xmsg> is a graphical interface to the msg program.  The program will allow 
messages to be sent to multiple users and provides the option of spell 
checking the message.  Aliases for recipient user ids may be provided
in the F<.msg_aliases> file.

=cut

#***************************************************************************

use strict;

# Library inclusion.
use MSGaliases;      # access info from the aliases file.
use FileNames;
use FileHandle; use IPC::Open2;
use Tk; use Tk::Dialog; 
use English; use TkCompositeWidgets; use TkGetText;
use exceptions_enabled;

# Subroutine prototypes.
sub send_message($\$);   # Send a message.  Pass the user id and a reference
                         # to the message text.  A return code of 0 indicates
                         # success.  Error return codes are listed in the
                         # comments to the routine.
sub spell_check();       # Check the spelling of the message text.  A
                         # callback function.
sub handle_msg();        # The main callback function, to send the msg 
                         # messages to the user list and log the message.
sub xmsg_help();         # help text window.
sub reset_window();      # Reset the main window.
sub show_log();          # Display the log file.
sub logfile_fname();     # return the log file name.
sub get_usrinfo();       # list some information about the users in the 
                         # recipient list.
sub no_userlst_error();  # issue an error message, that no user list has
                         # been provided
sub no_message_error();  # issue an error message, that the message has not
                         # been provided.
sub get_userlst();       # Get the user list from the window.  The return value
                         # is a reference to an array of user id's.  See the
                         # routine for a list of supported delimiters.
sub get_message();       # Get the message text from the window.  The return
                         # value is a reference to the text, trimmed of white
                         # space.  If there is no text, return undef.
sub trans_alias($);      # Check if a user ID is an alias, and if so
                         # return the unaliased user ID.  Return undef if
                         # the user ID is not an alias.
sub load_user_info();    # Reload the alias list.  The passwd alias list is
                         # a global variable, declared in the main program.

# Windowing routines.
sub create_window();     # Create the main window.
sub generic_message(\$;$$); # create a generic message window, with a reference
                            # to the text.
sub error_message(\$;$$); # create a generic error window, with a reference
                          # to the text.
sub search_text($$);     # Search the text in some Text widget.

# constants for the searching code.
use constant SEARCH_FORWARD => 1;
use constant SEARCH_REVERSE => 2;

# Catch CHLD signals and ignore them.  This will prevent a lot of defunct
# processes being stored around.
$SIG{CHLD} = 'IGNORE';

# store the program name.
my $progname = FileNames::basename($0);

# Store publically needed widgets from the window.
my $message_entry_widget;  # the widget for entering the message text
my $recip_list_widget;     # the widget for entering the recipient list

# Create the main window.
my $msgwin = create_window();

# Create a reference to an MSGaliases object.
my $user_aliases;

# Load the password file and the aliases.
load_user_info();

# Start the event loop.
MainLoop();

#***************************************************************************

sub configure_widget($;$$) {
  # configure the widget generically.
  my ($widget, $bgcolor, $fgcolor) = @_;
  $bgcolor ||= 'Blue';
  $fgcolor ||= 'Wheat';
  $widget->configure(
		     -background => $bgcolor,
		     -foreground => $fgcolor,
		    );

  # if the widget is a button, configure the active colors as well.
  $widget->configure(
		     -activebackground => $bgcolor,
		     -activeforeground => $fgcolor
		    ) if ($widget->isa('Tk::Button'));
}

#***************************************************************************

sub new_button($$$;$$$) {
  my ($text, $comm, $parent_widget, $do_configure, $bgcolor, $fgcolor) = @_;
  $do_configure = 1 unless (defined $do_configure);
  my $button = $parent_widget->Button(
				      -text    => $text,
				      -width   => 7,
				      -command => $comm
				     );
  configure_widget($button, $bgcolor, $fgcolor) if ($do_configure);
  $button->pack(
		-side => 'left',
		-padx => '1m'
	       );
  return $button;
}

#***************************************************************************

sub add_window_title($$;$$) {
  my ($widget, $title, $bgcolor, $fgcolor) = @_;
  my $title_w = $widget->Label(
			       -justify => 'center',
			       -text    => $title
			      );
  $title_w->configure(
		      -font => '-*-Helvetica-Bold-R-Normal--*-220-*-*-*-*-*-*'
		     );
  $title_w->configure(
		      -background => $bgcolor
		     ) if (defined $bgcolor);
  $title_w->configure(
		      -foreground => $fgcolor
		     ) if (defined $fgcolor);
  $title_w->pack( -side => 'top' );
}

#***************************************************************************

sub create_window() {
  # create the window object.
  my $win = new MainWindow;

  # provide a title
  my $title = 'Xmsg';
  $win->title($title);
  $win->iconname($title);
  configure_widget($win);

  # provide a title in the window
  add_window_title($win, $title, 'Blue', 'Wheat');

  # provide the entry area for the recipient list.
  my $recip_list_area = $win->Frame();
  configure_widget($recip_list_area);
  $recip_list_area->pack( 
			 -side => 'top',
			 -pady => '2m'
			);
  my $recip_list_label = $recip_list_area->Label(
						 -text => 'Recipient list:',
						 -justify => 'left'
						);
  configure_widget($recip_list_label);
  $recip_list_label->pack( -side => 'left' );
  $recip_list_widget = $recip_list_area->Entry();
  configure_widget($recip_list_widget);
  $recip_list_widget->configure( -foreground => 'Black' );
  $recip_list_widget->pack( -side => 'left' );

  # create the entry area for the message text
  my $entry_area = $win->Frame();
  configure_widget($entry_area);
  $entry_area->pack(
		    -side => 'top'
		   );
  $message_entry_widget = make_scrolled_text($entry_area, 1, 0, 
					     'Blue', 'Black', 65, 15);

  # create the control buttons.
  my $win_buttons = $win->Frame();
  configure_widget($win_buttons);
  $win_buttons->pack(
		     -expand => 'y',
		     -pady   => '2m'
		    );
  
  # row 1
  my $win_buttons_row_1 = $win_buttons->Frame();
  configure_widget($win_buttons_row_1);
  $win_buttons_row_1->pack(
			   -side => 'top',
			   -fill => 'x',
			   -pady => '2m'
			  );
  my $send_button = new_button('send', \&handle_msg,
			       $win_buttons_row_1);
  my $spell_button = new_button('spell', \&spell_check,
				$win_buttons_row_1);
  my $clear_button = new_button('clear', \&reset_window,
				$win_buttons_row_1);
  my $log_button = new_button('log', \&show_log,
			      $win_buttons_row_1);

  # row 2
  my $win_buttons_row_2 = $win_buttons->Frame();
  configure_widget($win_buttons_row_2);
  $win_buttons_row_2->pack(
			   -side => 'top',
			   -fill => 'x',
			  );
  my $info_button = new_button('info', \&get_usrinfo,
			       $win_buttons_row_2);
  my $reload_button = new_button('reload', \&load_user_info,
				 $win_buttons_row_2);
  my $help_button = new_button('help', \&xmsg_help,
			       $win_buttons_row_2);
  my $exit_button = new_button('exit', [ $win => 'destroy' ],
			       $win_buttons_row_2);

  # return the window.
  return $win;
}

#***************************************************************************

sub load_user_info() {
  # Read the alias list.
  $user_aliases = new MSGaliases;
  try {
    $user_aliases->read();
  } catch {
    # The exception indicates that the aliases file could not be read.
    # The file is optional, so eat the exception and get on with it.
  };
  try {
    $user_aliases->setkey(0);
  } catch {
  EXBLOCK: {
      /duplicate key/ && do {
	# duplicate key exception, so issue it as an error message.
	s/^[^:]+: */Error loading aliases file: /;
	error_message($_);
	last EXBLOCK;
      };
      error_message($_);
      exit(1);
    }
  };

  # return value.
  return 1;
}

#***************************************************************************

sub send_message($\$) {
  # return codes:
  #    0  => success
  #    1  => invalid user ID
  #    2  => error sending message
  my ($userid, $mess) = @_;

  # If the user id is actually an alias, substitute the alias.
  $userid = $user_aliases->expand_alias($userid) || $userid;

  # Form the msg command line.
  my $msgcomline = "msg -t $userid";

  # Open a pipe to msg.  Die if unable to open the pipe.  Catch the
  # output in another pipe.
  my $msgpipe = new FileHandle; my $outpipe = new FileHandle;
  open2($outpipe, $msgpipe, "$msgcomline 2>&1");

  # Write the message.
  $msgpipe->print($$mess);

  # Close the pipe.  There will not be a return code for this because
  # we are ignoring CHLD signals.  We will determine an error occurred
  # if msg issues some messages.
  $msgpipe->close();

  # Read any messages from the process.  
  my $emsgs = join('', $outpipe->getlines());
  if ($emsgs) {
      my $msgtxt = "xmsg:  $emsgs";
      generic_dialog(\$msgtxt, [ 'Ok' ], "msg messages", 'info', 'Grey');
      return 2;
  }

  # Success!
  return 0;
}

#***************************************************************************

sub handle_msg() {
  # get the userid list and the message text.
  my $userlist = get_userlst();
  my $messtxt  = get_message();

  # Make sure we have everything we need.
  unless ($userlist) {
    no_userlst_error();
    return 0;
  }
  unless ($$messtxt) {
    no_message_error();
    return 0;
  }

  # Iterate over the user list
  my $do_clear = 1;  # clear the message?
  foreach my $user ( @$userlist ) {
    my $rc = send_message($user, $$messtxt);
    if ($rc != 0) { # error during send.
      my @errmsgs = (
		     '',
		     "$user is not a valid user ID!",
		     "Unable to send msg to user $user!"
		    );
      my $errmsg = $errmsgs[$rc] || "Unknown error code $rc";
      error_message($errmsg);
      $do_clear = 0;  # error occured, so don't clear the message
    }
  }

  # Clear the window, if needed.
  reset_window() if ($do_clear);

  # Return value to make EzWindow happy.
  return 1;
}

#***************************************************************************

sub trans_alias($) {
  my $user = shift();
  return unless(defined($user_aliases));
  return $user_aliases->expand_alias($user) || undef;
}

#***************************************************************************

sub get_usrinfo() {
  my ($is_alias, $alias);

  # Get the user list.
  my $userlist = get_userlst();
  unless ($userlist) {
    no_userlst_error();
    return 0;
  }

  # Iterate over the users, getting the full name.
  my $infotxt = '';
  foreach my $user (@$userlist) {
    $is_alias = 0;

    # If the user id is an alias, substitute the alias.
    $alias = $user;
    $user = trans_alias($alias) || $user;
    $is_alias = 1 unless ($user eq $alias);
    $infotxt = $alias;

    # Add to the text
    $infotxt .= " is an alias to $user, who" if ($is_alias);

    # ensure the person is running msg by running zlocate
    my $zlocoutstr = new FileHandle("msg_locate $user 2>&1 |");
    local $/ = undef;
    my $zloc = $zlocoutstr->getline();
    if ($zloc =~ /^(failed action|error)/ || 
	$zloc =~ /not registered\.$/) {
      $infotxt .= ' is not currently logged in';
    } else {
      $infotxt .= ' is currently logged in';
    }

    # finish the string.
    $infotxt .= ".\n\n";
  }

  # Show the info text in a message window.
  generic_message($infotxt);

  # return code
  return 1;
}

#***************************************************************************

sub delete_log() {
  # delete the log file.
  my $lfname = logfile_fname();

  # delete.
  if ( -f $lfname ) {
    unlink($lfname);
  } else {
    my $msg = "Log file not found!";
    error_message($msg);
  }

  # return value.
  return 1;
}

#***************************************************************************

sub spell_replace(\$$$$) {
  my ($text, $word, $repl, $window) = @_;

  # if there is no replacement, issue an error.
  unless ($repl) {
    my $etxt = "No replacement chosen.";
    error_message($etxt, 'NoReplacement', $window);
    return 1;
  }

  # do a global replacement.
  $$text =~ s/\b$word\b/$repl/g;
}

#***************************************************************************

sub get_spell_rep($$) {
  my ($user, $sugg) = @_;
  my $text = $user->getText();
  if (!$text) {
    my $index = $sugg->curselection();
    $text = $sugg->get($index) if (defined($index));
  }
  return $text;
}

#***************************************************************************

sub find_alternate_spelling(\$$) {
  my ($text, $m_word) = @_;

  # get the valid alternates.
  my $inphandle = new FileHandle;
  my $outhandle = new FileHandle;
  open2($outhandle, $inphandle, "ispell -a");
  $inphandle->print($m_word); $inphandle->close();
  my ($dummy, $alternates) = $outhandle->getlines();

  # process the output, generating a list of suggested spellings.
  $alternates =~ s/\n$//;
  my ($code, $m_word_again, $n_mispelleds, $sep, @alternatives)
    = split(/[\s,:]+/, $alternates);

  # create a new window, with the suggested spellings.
  my $suggestion_window = $msgwin->Toplevel(
					    -title => 'SpellingSuggestions'
					   );

  # add a label.
  my $suggestion_win_label 
    = $suggestion_window->Label( 
				-text    => "Correcting $m_word",
				-justify => 'center'
			       );
  $suggestion_win_label->pack(
			      -side => 'top',
			      -pady => '2m'
			     );

  # Create a frame in which the user can supply his/her own correction.
  my $user_defined_frame = $suggestion_window->Frame(
						     -relief      => 'raised',
						     -borderwidth => 1
						    );
  $user_defined_frame->pack( -side => 'top' );

  # add an entry widget.
  my $user_defined_label 
    = $user_defined_frame->Label(
				 -text => 'Corrected spelling: '
				);
  $user_defined_label->pack( 
			    -side   => 'left',
			    -padx   => '1m',
			    -anchor => 'nw'
			   );
  my $user_defined_entry = $user_defined_frame->Entry();
  $user_defined_entry->pack( -side => 'left' );

  # add a scrolled list box with the suggestions.
  my $suggestions_frame = $suggestion_window->Frame(
						    -relief      => 'raised',
						    -borderwidth => 1
						   );
  $suggestions_frame->pack( -side => 'top' );
  my $suggestions_label 
    = $suggestions_frame->Label(
				-text => 'Suggestions: '
			       );
  $suggestions_label->pack(
			   -side   => 'left',
			   -padx   => '1m',
			   -anchor => 'nw'
			  );
  my $suggestions_entry_frame = $suggestions_frame->Frame();
  $suggestions_entry_frame->pack(
				 -side => 'left'
				);
  my $suggestions_entry = make_scrolled_widget($suggestions_entry_frame,
					       'Listbox', 1, 0);
  $suggestions_entry->insert('end', @alternatives);

  # add the control buttons.
  my $buttons_frame = $suggestion_window->Frame();
  $buttons_frame->pack( -side => 'top' );
  my $replace_button 
    = $buttons_frame->Button(
			     -text    => 'replace',
			     -command => sub {
			       my $rep_text 
				 = get_spell_rep($user_defined_entry,
						 $suggestions_entry);
			       spell_replace($$text,
					     $m_word,
					     $rep_text,
					     $suggestion_window);
			       clear_widget($message_entry_widget);
			       $message_entry_widget->insert('end',
							     $$text);
			       $suggestion_window->destroy();
			     });
  $replace_button->pack(-side => 'left');
  my $done_button = $buttons_frame->Button(
					   -text    => 'done',
					   -command => [ $suggestion_window
							 => 'destroy' ]
					  );
  $done_button->pack( -side => 'left' );
}

#***************************************************************************

sub insert_misspelled_word($\$$) {
  my ($widget, $messtxt, $word) = @_;
  
  # define a tag that will bind the left mouse button to the correct
  # subroutine.
  my $tag = "alternate_spell_$word";
  $widget->tag('bind', $tag,
	       '<1>' => sub { find_alternate_spelling($$messtxt, $word); }
	      );

  # configure this tag to be raised relief when the mouse is over it.
  $widget->tag('bind', $tag,
	       '<Any-Enter>' => sub {
		 shift()->tag('configure', $tag, 
			      -relief      => 'raised',
			      -background  => 'LightBlue',
			      -borderwidth => 1
			     );
	       });
  $widget->tag('bind', $tag,
	       '<Any-Leave>' => sub {
		 shift()->tag('configure', $tag, 
			      -relief     => 'flat',
			      -background => undef,
			     );
	       });

  # insert the word.
  $word =~ s/\n$//;
  $widget->insert('end', $word, $tag);
  $widget->insert('end', "\n");
}

#***************************************************************************

sub spell_check() {
  # Get the message text from the window.
  my $messtxt = get_message();

  # Make sure we have something to check.
  unless(defined($messtxt) && $$messtxt) {
    no_message_error();
    return 0;
  }

  # get the list of mispelled words, from ispell -l.
  my ($ispell_l_in, $ispell_l_out) = (new FileHandle, new FileHandle);
  open2($ispell_l_out, $ispell_l_in, 'ispell -l');
  $ispell_l_in->print($$messtxt . "\n"); $ispell_l_in->close();
  my @misspelled = $ispell_l_out->getlines();

  # if there are none, get on with life.
  if ($#misspelled == -1) {
    my $txt = "No spelling errors found.";
    generic_message($txt);
    return;
  }

  # sort the list of misspelled words, removing duplicates.  Use the fact
  # that hash object have unique keys.
  my %temp_hash = map { $_ => 1 } @misspelled;
  @misspelled = sort(keys %temp_hash);

  # Dump the words to a window, with 'hypertext' capability.  When a word is
  # clicked, bring up the list of possible alternatives.
  my $misspelled_win = $msgwin->Toplevel(
					 -title => 'MisspelledWords',
					);
  my $mis_label_text = "Click on those words you wish to change.";
  my $misspelled_label = $misspelled_win->Label(
						-text    => $mis_label_text,
						-justify => 'left'
					       );
  $misspelled_label->pack(
			  -side => 'top',
			  -pady => '2m'
			 );
  my $words_frame = $misspelled_win->Frame();
  $words_frame->pack( -side => 'top' );
  my $words_list = make_scrolled_text($words_frame, 1, 0, undef, undef,
				      20, 6);
  
  foreach my $word (@misspelled) {
    insert_misspelled_word($words_list, $$messtxt, $word);
  }

  # add the button.
  my $buttons_frame = $misspelled_win->Frame();
  $buttons_frame->pack( -side => 'top' );
  my $done_button = $buttons_frame->Button(
					   -text    => 'done',
					   -command => [ $misspelled_win =>
							 'destroy' ]
					  );
  $done_button->pack(-side => 'left');
}

#***************************************************************************

sub logfile_fname() {
    return $ENV{MSG_LOG_FILE} || $ENV{HOME} . "/msg.log";
}

#***************************************************************************

sub trim_ws(\$) {
  my $s = shift();
  $$s =~ s/^[\s\n]*(.*?)[\s\n]*$/$1/o;
}

#***************************************************************************

sub get_text($) {
  my $txt = shift()->getText();
  return unless ($txt);
  trim_ws($txt);
  return \$txt;
}

#***************************************************************************

sub get_userlst() {
  my $lst = get_text($recip_list_widget);
  return unless($lst);
  my @lst = split(/[,:\s]+/, $$lst);
  return \@lst;
}

#***************************************************************************

sub get_message() {
  return get_text($message_entry_widget);
}

#***************************************************************************

sub clear_widget($) {
  shift()->delete('0.0', 'end');
}

#***************************************************************************

sub reset_window() {
  foreach my $w ($message_entry_widget, $recip_list_widget) {
    clear_widget($w);
  }
}

#***************************************************************************

sub generic_dialog(\$$$$$;$) {
  my ($text, $button_array, $title, $bitmap, $color, $parent) = @_;

  $parent = $msgwin unless (defined($parent));

  # create the dialog
  my $dialog = $parent->Dialog(
			       -title    => $title,
			       -text     => $$text,
			       -bitmap   => $bitmap,
			       -buttons  => $button_array,
			      );
  $dialog->configure(
		     -background => $color
		    );

  # wait for a button to be pushed.
  my $choice = $dialog->Show();

  # destroy the dialog.
  $dialog->destroy();

  # return the choice
  return $choice;
}

#***************************************************************************

sub generic_message(\$;$$) {
  my ($text, $title, $parent) = @_;
  $title ||= 'Message';
  generic_dialog($$text, [ 'Ok' ], $title, 'info', 'LightBlue', $parent);
}

#***************************************************************************

sub error_message(\$;$$) {
  my ($text, $title, $parent) = @_;
  $title ||= 'Error';
  generic_dialog($$text, [ 'Ok' ], $title, 'error', 'firebrick2', $parent);
}

#***************************************************************************

sub no_userlst_error() {
  my $msg = "User ID list required!";
  error_message($msg);
}

#***************************************************************************

sub no_message_error() {
  my $msg = "No message text provided!";
  error_message($msg);
}

#***************************************************************************

sub start_search($) {
    search_text(shift(), SEARCH_REVERSE);
}

#***************************************************************************

sub show_log() {
  my $fname = logfile_fname();

  # If there is no log file, issue a message saying so.
  unless ( -f $fname ) {
    my $msg = "No log file found!";
    error_message($msg);
    return 1;
  }
  
  # Read the file into a string;
  my $logfh = new FileHandle($fname, O_RDONLY);
  if (!$logfh) {
      my $msg = "Unable to open log file!";
      error_message($msg);
      return 1;
  }
  local $/ = undef;
  my $logtext = $logfh->getline();
  $logfh->close();

  # create the window.
  my $logwin = $msgwin->Toplevel();
  $logwin->title("Xmsg log");
  $logwin->iconname("Xmsg log");

  # Add a scrolled text widget.
  my $log_display_area = $logwin->Frame();
  $log_display_area->pack( -side => 'top' );
  my $log_display = make_scrolled_text($log_display_area, 1, 0);

  # define a tag for the header line in each log entry.
  $log_display->tag('configure', 'entry_header',
		    -background => 'LightBlue'
		   );

  # add the text.
  my $cnt = 1;
  while ($logtext =~ /^__(To|From)(:.*?)(?=(^__(To|From):|\Z))/mgso) {
    my $logentry = $1 . $2;
    my ($header, $entry) = ($logentry =~ m/^(.*?)(\n.*?)$/s);
    $log_display->insert('end', $cnt++ . ". $header", 'entry_header');
    $log_display->insert('end', $entry . "\n");
  }

  # position to the bottom of the log.
  $log_display->see('end');

  # make the display uneditable
  $log_display->configure(
			  -state => 'disabled'
			 );

  # add the buttons.
  my $buttons_area = $logwin->Frame();
  $buttons_area->pack( -side => 'top' );
  my $ok_button = new_button('Ok', [ $logwin => 'destroy' ], $buttons_area, 0);
  my $search_button = new_button('search', 
				 sub { start_search($log_display); },
				 $buttons_area, 0);
  my $clear_button = new_button('clear log',
				sub { delete_log(); $logwin->destroy(); },
				$buttons_area, 0);

  # bind ^s to the search function.
  $logwin->bind('<Control-s>' => 
		    sub { start_search($log_display); });

  # return value.
  return 1;
}

#***************************************************************************

sub perform_search($$$) {
  my ($textw, $direction, $entry) = @_;
  my $highlight_tag = 'search highlight';

  # do we have something to search for?
  my $target = $entry->get();
  unless ($target) {
    my $notarg = 'Search string not specified';
    error_message($notarg, 'No target', $entry);
    return;
  }

  # clear the results of the last search.
  $textw->tagDelete($highlight_tag);

  # set up search paramters.
  my ($slabel, $endpos, $startpos);
  if ($direction == SEARCH_FORWARD) {
    $slabel = '-forwards';
    $endpos = 'end';
    $startpos = $textw->index('insert + 1 c');
  } else {
    $slabel = '-backwards';
    $endpos = '0.0';
    $startpos = $textw->index('insert');
  };

  # Do the search.  I would like to add a few more switches, but I haven't
  # figured out the syntax yet.  For now, simply specify the direction.
  my $swtchs = [ $slabel, '-regexp', '-nocase' ]; # what I want
  my $pos = 
    $textw->search($slabel, $target, $startpos, $endpos);

  # did we find anything?
  unless ($pos) {
    my $etxt = "String $target not found";
    error_message($etxt, 'Not found', $entry);
    $textw->markSet('insert', $endpos);
    return;
  }

  # position the view and the insert cursor to the new position.
  $textw->see($pos);
  $textw->markSet('insert', $pos);

  # highlight the word.
  $textw->tag('configure', $highlight_tag,
	      -background => 'red');
  $textw->tagAdd('search highlight', $textw->index('insert wordstart'), 
		 $textw->index('insert wordend'));
}

#***************************************************************************

sub search_text($$) {
  my ($textw, $direction) = @_;
  
  # create a dialog to get the search string.
  my $entry = $textw->Toplevel();
  $entry->title('Search');
  $entry->iconname('Search');
  $entry->grab();

  # make the entry frame.
  my $entry_frame = $entry->Frame();
  $entry_frame->pack( -side => 'top' );
  my $entry_frame_label = $entry_frame->Label(
					      -text => 'Enter search string:'
					     );
  $entry_frame_label->pack(
			   -side => 'left'
			  );
  my $string_entry = $entry_frame->Entry(
					 -width => 30
					);
  $string_entry->pack( -side => 'left' );
  $string_entry->focus();

  # radio buttons to indicate search direction.
  my $buttons_frame = $entry->Frame();
  $buttons_frame->pack( -side => 'top' );
  my $forward_button = $buttons_frame->Radiobutton(
						   -text     => 'forward',
						   -variable => \$direction,
						   -value    => SEARCH_FORWARD,
						  );
  $forward_button->pack( -side => 'left' );
  my $reverse_button = $buttons_frame->Radiobutton(
						   -text     => 'reverse',
						   -variable => \$direction,
						   -value    => SEARCH_REVERSE
						  );
  $reverse_button->pack( -side => 'left' );
  my $button_on = ($direction == SEARCH_REVERSE) 
    ? $reverse_button : $forward_button;
  $button_on->configure( -indicatoron => 1 );

  # control buttons.
  my $control_frame = $entry->Frame();
  $control_frame->pack( -side => 'top' );
  my $search_button = new_button('search', 
				 sub { 
				   perform_search($textw, $direction, 
						  $string_entry); 
				 },
				 $control_frame, 0);
  my $quit_button = new_button('done', 
			       sub {
				   $textw->markSet('insert', 'end');
				   $entry->destroy();
			       },
			       $control_frame, 0);
}

#***************************************************************************

sub xmsg_help() {
  # define the help text.
  my $hlptxt = "This program provides a GUI to the msg program. 
Enter a list of user ID's in the recipient list and the text of your
message in the Message box.";

  # define the help for each button.
  my %button_help_text = (
			  spell => 'invoke a spell check on your text. Words that are possibly misspelled will be listed in a separate window.',
			  send  => 'send your message to the users in your list.',
			  clear => 'clear the recipient list and the message text.',
			  log   => 'display the log file.',
			  info  => 'show the real names of the people on the recipient list, if the user ID is valid, and if they are capable of receiving msg messages.',
			  reload=> 'tell the program to reload the alias file.  This allows the user to change an alias without having to restart the program.'
			 );

  # Create the help window.
  my $hlptitle = "Help for $progname";
  my $wincolor = 'LightBlue';
  my $help_win = $msgwin->Toplevel();
  $help_win->title($hlptitle);
  $help_win->iconname($hlptitle);
  configure_widget($help_win, $wincolor);

  # add a scrolled text widget.
  my $hlp_display_area = $help_win->Frame();
  $hlp_display_area->pack( -side => 'top' );
  my $hlp_display = make_scrolled_text($hlp_display_area, 1, 0, $wincolor);

  # define a tag for the button name in the help display.
  $hlp_display->tag('configure', 'button_name',
		    -font       => '-*-Courier-Medium-O-Normal-*-120-*-*-*-*-*-*',
		    -foreground => 'Blue'
		   );

  # add the text.
  $hlp_display->insert('end', $hlptxt ."\n");
  foreach my $help_button (keys %button_help_text) {
    $hlp_display->insert('end', "\nThe ");
    $hlp_display->insert('end', $help_button, 'button_name');
    $hlp_display->insert('end', ' button will ' 
			        . $button_help_text{$help_button} . "\n");
  }

  # Configure the display area to not be edittable.
  $hlp_display->configure(
			  -state => 'disabled'
			 );

  # add the buttons.
  my $buttons_area = $help_win->Frame();
  $buttons_area->pack( -side => 'top' );
  my $ok_button = new_button('Ok', [ $help_win => 'destroy' ],
			     $buttons_area, 1, $wincolor, 'Black');

  # return value.
  return 1;
}
