#!/usr/bin/perl
my $RCSRevKey = '$Revision: 0.82 $';
$RCSRevKey =~ /Revision: (.*?) /;
$VERSION=$1;

use Fcntl;
use Tk;
use Tk::TextUndo;
use Tk::MListbox;
use Tk::SimpleFileSelect;

#
#  Path names for library files.  Edit these for your
#  configuration.
#
# Icon file name
$iconpath = &qualify_path('~/.ec/ec.xpm');
#  Configuration options file.
$cfgfilename = &qualify_path('~/.ec/.ecconfig'); # Unix directory
# Server authorization file.
$serverfilename = &qualify_path('~/.ec/.servers'); # Unix directory

# $headerid = "X-Mailer\: EC E-Mail Client, Version $VERSION.";
my $datesortorder;
my $defaultuserdir;
                     # Default option settings when config file not found
my $defaults =       # config file; see ~/.ec/.ecconfig for description
  {                  # of each option and valid parameters
   maildomain => 'localhost',
   debug => 0,
   verbose => 0,
   smtpport => 25,
   usesendmail => 0,
   useqmail => 0,
   sendmailprog => '/usr/sbin/sendmail',
   sendmailsetfrom => 0,
   sigfile => '~/.signature',
   usesig => 1,
   mailspooldir => '/var/spool/mail',
   maildir => '~/Mail',
   qmailbox => "Mailbox",
   incomingdir => 'incoming',
   trashdir => 'trash',
   helpfile => '~/.ec/ec.help',
   trashdays => 7,
   pollinterval => 600000,
   senderlen => 20,
   datelen => 26,
   fccfile => '',
   quotestring => '> ',
   senderlen => 25,
   datelen => 21,
   weekdayindate => 1,
   sortfield => 1,
   sortdescending => 0,
   servertimeout => 10,
   headerview => 'brief',
   ccsender => 1,
   browser => '',
   timezone => '-0400'
   };

my %userconfig;  # Hash of configuration options.

$defaulttextfont = '*-courier-medium-r-*-*-12-*';
                       # Default text font.  Change to your preference.
                       # Monospaced fonts work best.
$headerfont = '*-courier-medium-i-*-*-12-*';
                       # Default font for non-editable headers.
$menufont = '*-helvetica-medium-r-*-*-12-*';
                       # Default font for menus and other widgets.
##
##  The following code is for Socket stuff.
##
$AF_INET = 2;	        # 2 = linux, Win95/NT, solaris, and sunos
$SOCK_STREAM = 1;	    # 1 = linux, AIX, and Win95/NT
                        # 2 = solaris and sunos
# padding for message list fields.  This should be enough to space
# out a completely blank header field.
my $padding = ' ' x 30;

# Text for mailbox message counter.
my $countertext = '0 Messages';

# Message ID sequence counter.
my $msgsequence = 1;

my @sortedmessages; # headers after being sorted;

# Message header fields.
my $fromfield = "From:";
my $tofield = "To:";
my $ccfield = "Cc:";
my $subjfield = "Subject:";
my $bccfield = "Bcc:";
my $fccfield = "Fcc:";
my $replytofield = "Reply-To:";
my $msgidfield = "Message-Id:";
my $msgsep = "--- Enter the message text below this line\. ---";
my $sigsep = "-- ";

my @daynames = qw( Sun Mon Tue Wed Thu Fri Sat );
my @monthnames = qw ( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );

($localuser,$dummy,$UID,@dummy) = getpwuid($<); undef @dummy;
$localuser =~ /(.*)/;

open USER, 'echo $USER|' or die "Can't get \$USER: $!\n";
$username=<USER>;
close USER;
chop $username;

sub readconfig {
  my ($l);
  my @tmpfolders;  # So the final list can show the required folders on top.
  if( open CONFIG, "$cfgfilename" ) {
    while ( defined ($l = <CONFIG>)) {
      if( $l !~ /^\#/) {
	my ($opt, $val) = ($l =~ /^(\S+)\s(.*)$/);
	$val =~ s/[\'\"]//g;
	if( $opt =~ /folder/ ) {
	  push @tmpfolders, ($val);
	} elsif ( $opt =~ /filter/ ) {
	  push @{$userconfig{'filter'}}, ($val);
	} else {
	  $userconfig{$opt} = $val;
	}
	print "config: $opt = ".$userconfig{$opt}."\n" if $debug;
      }
    }
    close CONFIG;
    push @{$userconfig{'folder'}}, ($userconfig{incomingdir});
    push @{$userconfig{'folder'}}, ($userconfig{trashdir});
    push @{$userconfig{'folder'}}, ($_)  foreach( @tmpfolders );
    foreach ( keys %$defaults ) {
      if (! exists $userconfig{$_}) {
	print "Using default value for $_\n." if $debug;
	$userconfig{$_} = $defaults{$_};
      }
    }
  } else {
    print "Could not open $cfgfilename: using defaults.\n";
    foreach (keys %$defaults) {
      $userconfig{$_} = $defaults{$_};
      print "config: $_ = ".$userconfig{$_}." from defaults\n" if $debug;
    }
  }
  $defaultuserdir = &qualify_path(($userconfig{'maildir'}));
  $userconfig{'helpfile'} = &qualify_path( ($userconfig{'helpfile'}));
  $userconfig{'sigfile'} = &qualify_path( ($userconfig{'sigfile'}));
  foreach( @{$userconfig{folder}} ) { $_ = $defaultuserdir.'/'.$_; }
  $userconfig{'incomingdir'} =
    $defaultuserdir .'/'.$userconfig{'incomingdir'};
  $userconfig{'trashdir'}
    = $defaultuserdir .'/'.$userconfig{'trashdir'};
}

sub die_gracefully {
    local($msg) = @_;

    print STDERR "An error occurred: $msg\n";
    print STDERR "Resetting.\n";
    unlink $LFILE;
      print "<<<RSET\n" if ($userconfig{verbose});
      print SOCK "RSET\r\n";
      print "<<<QUIT\n" if ($userconfig{verbose});
      print SOCK "QUIT\r\n";
      close (SOCK);
#    exit(1);
}

sub close_pop_server {
    local($status, $smsg);
    if( SOCK ) {
      print "<<<QUIT\n" if ($userconfig{verbose});
      print SOCK "QUIT\r\n";
      ($status, $smsg) = &pop_ack();
      if ($status ne "OK") {
	&die_gracefully($smsg);
      }
    }
}

sub openserver {
  my ($mw, $remote, $port, $user, $passwd) = @_;
  my ($iaddr,$paddr,$proto,$status,$smsg,$sockaddr);
  my ($err, $errcode);
  my $md = $userconfig{'maildomain'};
  my $c = $mw -> Subwidget( 'canvas' );
  my $servermsg = $mw -> Subwidget( 'servermsg' );
  my $t = $mw -> Subwidget( 'text' );
  $| = 1;
  $c -> dchars( $servermsg, '0', 'end' );
  $c -> insert( $servermsg, 'end',
		"Connecting: $remote... ");
  if( (substr $passwd,0,1) eq '-' ) {
    $passwd = &passwd_dialog($mw,$host);
    return $passwd if $passwd =~ /Cancel|OK/
  }
  $c -> update;
  print "getservbyname..." if $userconfig{debug};
  if ($port =~ /\D/) {
    ($name, $aliases, $port, $proto) = getservbyname($port, 'tcp')
  }
  print "done\n" if $userconfig{debug};
  die "No port found.  Verify using the correct port (usually 110).\n"
    unless $port;
  $SIG{ALRM} = sub { alarm 0; die 'gethostbyname' };
  eval {
    alarm( $userconfig{servertimeout} );
    print "gethostbyname..." if $userconfig{debug};
    ($name, $aliases, $type, $len, $iaddr) = gethostbyname($remote);
    print "done\n" if $userconfig{debug};
    alarm( 0 );
  };
  if ( $@ or not $iaddr ) {
    if( $@ =~ /gethostbyname/ ) {
      &server_error_dialog( $mw, $port,
		    "$remote:\nGethostbyname function timed out:\n$!" );
      $errcode = 'gethostbyname';
      $err = undef;
      goto CLOSE_SERVER;
    }
    &server_error_dialog( $mw, $port, "No host: $remote\n" );
    $errcode = 'gethostbyname';
    $err = undef;
    goto CLOSE_SERVER;
  }
  $sockaddr = 'S n a4 x8';
  $paddr = pack($sockaddr, $AF_INET, $port, $iaddr);

  print "getprotobyname..." if $userconfig{debug};
  $proto = getprotobyname('tcp');
  print "done\n" if $userconfig{debug};

  $SIG{ALRM} = sub { alarm 0; die 'socket' };
  eval {
    alarm( $userconfig{servertimeout} );
    print "socket..." if $userconfig{debug};
    socket(SOCK, $AF_INET, $SOCK_STREAM, $proto) ||
      die "Can't open socket: $!\n";
    print "done\n" if $userconfig{debug};
    alarm( 0 );
  };
  if( $@ ) {
    if( $@ =~ /socket/ ) {
      &server_error_dialog( $mw, $port, "Can't connect to $remote:\n$!" );
      $errcode = 'socket';
      $err =  undef;
      goto CLOSE_SERVER;
    }
  }

  $SIG{ALRM} = sub { alarm 0; die 'timeout' };
  eval {
    alarm( $userconfig{servertimeout} );
    print "connect..." if $userconfig{debug};
    connect(SOCK,$paddr);
    print "done\n" if $userconfig{debug};
    alarm( 0 );
  };
  if( $@ ) {
    if ( $@ =~ /timeout/ ) {
      &server_error_dialog( $mw, $port, "Connect timeout: $!." );
      $err = undef;
      $errcode = 'socket';
      goto CLOSE_SERVER;
    }
  }
  # Catch whatever signals we need to...
  $SIG{"INT"} = 'die_gracefully';
  $SIG{"TERM"} = 'die_gracefully';
  print "select..." if $userconfig{debug};
  select(SOCK); $| = 1; select(STDOUT); # always flush SOCK
  print "done\n" if $userconfig{debug};

  if( $port eq 25 ) {
    # if SMTP, wait for server initiation
    if( ! defined ( $status = &smtpack ) ) {
      &server_error_dialog( $mw, $port,
			    "Timed out while waiting for server greeting." );
      $err = "servergreeting";
      goto CLOSE_SERVER;
    };
    print "$status\n" if ($userconfig{verbose}) and defined $status;
    while ( $status !~ /^220|^421/ ) {
      if( ! defined ( $status = &smtpack(1) ) ) {
	&server_error_dialog( $mw, $port,
			      "Timed out during server greeting." );
	$err = undef;
	goto CLOSE_SERVER;
      };
      # $status = &smtpack();
      print "$status\n" if ($userconfig{verbose}) and defined $status;
      if ( $status =~ /^421/ms ) {
	&server_error_dialog( $mw, $port,
			      "421: Service not available: $!" );
	print "<<<RSET\n" if ($userconfig{verbose});
	print SOCK "RSET\r\n";
	$err = undef;
	goto CLOSE_SERVER;
      }
    }
    print "<<<HELO $md\n" if ($userconfig{verbose});
    print SOCK "HELO $md\r\n";
    if( ! defined ( $status = &smtpack ) ) {
      &server_error_dialog( $mw, $port,
			    "\'HELO $md\' timed out... resetting." );
      print "<<<RSET\n" if ($userconfig{verbose});
      print SOCK "RSET\r\n";
      $err = undef;
      goto CLOSE_SERVER;
    };
    print "$status\n" if ($userconfig{verbose}) and defined $status;
    # non-readable response.
    while ( $status !~ /^250|^500|^501|^504|^421/ ) {
      if( ! defined ( $status = &smtpack ) ) {
	&server_error_dialog( $mw, $port,
	      "\'HELO $md\' error. Server said: $status... resetting." );
	print "<<<RSET\n" if ($userconfig{verbose});
	print SOCK "RSET\r\n";
	$err = undef;
	goto CLOSE_SERVER;
      };
      print "$status\n" if ($userconfig{verbose}) and defined $status;
      # rfc821 specified error condition
      if ($status =~ /^500|^501|^504|^421/ ) {
	print "<<<RSET\n" if ($userconfig{verbose});
	print SOCK "RSET\r\n";
	&server_error_dialog( $mw, $port,"$status: $!... Resetting" );
	$err = undef;
	goto CLOSE_SERVER;
      }
    }
    print "<<<MAIL FROM: $user\@$md\n" if $userconfig{verbose};
    print SOCK "MAIL FROM: $user\@$md\r\n";
    if( ! defined ( $status = &smtpack ) ) {
      print "<<<RSET\n" if ($userconfig{verbose});
      print SOCK "RSET\r\n";
      &server_error_dialog($mw, $port,
		   "\'MAIL FROM: $user\@$md\' not acknowledged... resetting.");
      $err = undef;
      goto CLOSE_SERVER;
    };
    print "$status\n" if ($userconfig{verbose}) and defined $status;
    while ( $status !~ /^250|^552|^451|^452|^500|^501|^421/ ) {
      if( ! defined ( $status = &smtpack ) ) {
	print "<<<RSET\n" if $userconfig{verbose};
	print SOCK "RSET\r\n";
	&server_error_dialog($mw, $port,
	     "\'$user\@$md\' error. Server said: $status ... resetting.");
	$err = undef;
	goto CLOSE_SERVER;
      };
      print "$status\n" if ($userconfig{verbose}) and defined $status;
      if ($status =~ /^552|^451|^452|^500|^501|^421/ ) {
	print "<<<RSET\n" if ($userconfig{verbose});
	print SOCK "RSET\r\n";
	&server_error_dialog($mw, $port,
      "\'MAIL FROM: $user\@$md\' error. Server said: $status ... resetting." );
	$err = undef;
	goto CLOSE_SERVER;
      }
    }
    local $msg = $t -> get( '1.0', 'end' );
    $msg =~ /^To:\s?(\S*?)$/sm;
    local $forwardpath = $1;
    print "$forwardpath\n" if ($userconfig{debug});
    print "<<<RCPT TO:<$forwardpath>\n" if $userconfig{verbose};
    print SOCK "RCPT TO:<$forwardpath>\r\n";
    if( ! defined ( $status = &smtpack ) ) {
      &server_error_dialog($mw, $port, "Server timeout");
      $err = undef;
      goto CLOSE_SERVER;
    };
    print "$status\n" if ($userconfig{verbose}) and defined $status;
    while ( $status !~ /^25|^42|^45|^50|^55/ ) {
      print
     "SMTP: \'RCPT TO: <$forwardpath>' error. Server said: $status ... resetting.\n";
      if( ! defined ( $status = &smtpack ) ) {
	print "$status\n" if ($userconfig{verbose}) and defined $status;
	$err = undef;
	goto CLOSE_SERVER;
      };
      if ($status =~ /^25|^42|^45|^50|^55/ ) {
	print "<<<RSET\n" if ($userconfig{verbose});
	print SOCK "RSET\r\n";
	&server_error_dialog($mw, $port,
    "\'RCPT TO: <$forwardpath>' error. Server said: $status ... resetting.");
	$err = undef;
	goto CLOSE_SERVER;
      }
    }
  }
  if( $port ne 25 ) {
    ($status, $smsg) = &pop_ack();
    if ($status ne "OK") {
      &server_error_dialog( $mw, $port, "Authorization error: $remote." );
      $err = undef;
      goto CLOSE_SERVER;
    }
    print "<<<USER $user\n" if ($userconfig{verbose});
    print SOCK "USER $user\r\n";
    ($status, $smsg) = &pop_ack();
    if ($status ne "OK") {
      &server_error_dialog( $mw, $port, "Authorization error: $remote." );
      $err = undef;
      goto CLOSE_SERVER;
    }
    print "<<<PASS ....\n" if ($userconfig{verbose});
    print SOCK "PASS $passwd\r\n";
    ($status, $smsg) = &pop_ack();
    if ($status !~ /OK/) {
      &server_error_dialog( $mw, $port, "Authorization error: $remote." );
      $err = undef;
      goto CLOSE_SERVER;
    }
  }
  $c -> dchars( $servermsg, '0', 'end' );
  $c -> insert( $servermsg, 'end', "$remote: Connected.");
  $c -> update;
  $err = 1;
  return $err;
 CLOSE_SERVER:
  if( $errcode !~ /socket|gethostbyname/ ) {
    &close_pop_server;
  }
  close SOCK;
  return $errcode;
}

sub passwd_dialog {
  my ($mw,$host) = @_;
  my ($pwd,$resp);
  $mw -> update;
  my $dw = new MainWindow( -title => 'Enter Password' );
  my $l1 = $dw -> Label( -text => "Enter password for $host:",
                          -font => $menufont );
  $l1 -> grid( -row => 1, -column => 1, -padx => 5, -pady => 5,
	     -columnspan => 3);
  my $e1 = $dw -> Entry( -width => 20, -show => '*');
  $e1 -> bind( '<Return>',  sub{$pwd = $e1 -> get} );
  $e1 -> grid( -row => 2, -column => 1, -padx => 5, -pady => 5,
	     -sticky => 'e,w', -columnspan => 3 );
  my $bok = $dw -> Button( -text => 'OK', -font => $menufont,
		 -command => sub{$pwd = $e1 -> get},
	         -width => 8, -command => sub{$pwd = $e1 -> get} );
  $bok -> grid( -column => 1, -row => 3, -padx => 5, -pady => 5 );
  my $bcancel = $dw -> Button( -text => 'Cancel', -font => $menufont,
		 -command => sub{ $pwd = 'Cancel'},
		 -width => 8 );
  $bcancel -> grid( -column => 3, -row => 3, -padx => 5, -pady => 5 );
  $mw -> lower($dw);
  $dw -> waitVariable(\$pwd);
  $dw -> destroy;
  return $pwd;
}

sub server_error_dialog {
  my ($mw, $port, $msg) = @_;
  require Tk::Dialog;
  $mw -> Subwidget('canvas') ->
    dchars( $mw -> Subwidget('servermsg'), '0', 'end' );
  my $title = ($port =~ /25/)?"SMTP Server Error":"POP3 Server Error";
  my $dialog = $mw -> Dialog( -title => $title,
      -text => $msg, -font => $menufont, -default_button => 'OK',
      -bitmap => 'error', -buttons => ['OK'] ) -> Show;
}

sub next_message {
  my ($mw) = @_;
  my $l = $mw -> Subwidget( 'messagelist' );
  my ($selection) = ($l->curselection)[0];
  return if $selection eq '';
  return if ($selection + 1) eq $l -> size;
  $l -> selectionClear( $selection );
  $selection += 1;
  $l -> selectionSet( $selection );
  $l -> see( $selection );
  &displaymessage( $mw, $currentfolder );
}

sub previous_message {
  my ($mw) = @_;
  my $l = $mw -> Subwidget( 'messagelist' );
  my ($selection) = ($l->curselection)[0];
  return if $selection eq '';
  return if $selection eq 0;
  $l -> selectionClear( $selection );
  $selection -= 1;
  $l -> selectionSet( $selection );
  $l -> see( $selection );
  &displaymessage( $mw, $currentfolder );
}

sub displayserverror {
  my ($mw, $op, $msg) = @_;
  my $c = $mw -> Subwidget( 'servermsg' );
  $c -> dchars( $servermsg, '0', 'end' );
  $c -> insert( $servermsg, 'end', "Can't connect to socket: $!" );
}

sub nummsgs {
  print "nummsgs()..." if $userconfig{debug};
  print "<<<STAT\n" if (($userconfig{verbose}));
  print SOCK "STAT\r\n";
  local($status, $messages) = &pop_ack();
  if ($status !~ /OK/) {
#        &die_gracefully("stat: $messages");
  }
  ($msgs,$octets) = split(' ',$messages);
  print "done\n" if $userconfig{debug};
  return( $msgs, $octets);
}

# the delay parameter is necessary to lengthen the timeout
# while server is relaying message.
sub smtpack {
  my ($delay) = @_;
  local $l;
    $SIG{ALRM} = sub{ alarm 0; die 'Time out: smtp acknowledgement\n' };
    $delay = 1 if (not $delay);
    alarm( ($userconfig{servertimeout}) * $delay );
  eval {
    while ( defined ( $l = <SOCK> ) ) {
      Tk::Event::DoOneEvent(255);
      goto RET_ACK if $l =~ /^\d\d\d/;
    }
  };
  return undef;
RET_ACK:
  alarm( 0 );
  return $l;
}

sub pop_ack {
   # Search for common POP acknowledgments
   $search_pattern="^.\(OK|ERR|\)\(.*\)";
   my ($stat, $msg);
   $SIG{ALRM} =
     sub{ alarm 0; $stat='ERR'; $msg = 'server timeout'; die; };
   eval {
      alarm( $userconfig{servertimeout} );
      $_ = <SOCK>;
      print $_ if ($userconfig{verbose});
      print "" if ($userconfig{verbose});
      # Have to do regex match outside of while loop to keep
      # the resulting $1 and $2 in proper scope
      /$search_pattern/;
      $stat = $1;
      while (! $stat) {
	$_ = <SOCK>;
        /$search_pattern/;
	Tk::Event::DoOneEvent(255);
      }
      $stat = $1;
      $msg = $2;
      alarm(0);
    };
    if( $@ ) {
      print "pop_ack(): server timeout\n" if $userconfig{debug};
      $stat = 'ERR';
      $msg = 'Timeout';
    }
    return ($stat, $msg);
}

sub retrieve {
  local($msgnum, $servermsg, $c) = @_;
  local($themsg) = "";
  local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
  local($tempfile) = "/tmp/poptmp.$$";

  open(SPOOLOUT,"+>$tempfile");

  print "<<<RETR $msgnum\n" if ($userconfig{verbose});
  print SOCK "RETR $msgnum\r\n";
  local($status,$smsg) = &pop_ack();
  if ($status !~ /OK/) {
#		&die_gracefully($smsg);
  } else {
    #
    # Some mailers are very persnickity about the time string,
    # hence the goop. BR Wed Sep  8 14:52:34 MDT 1993
    printf(SPOOLOUT
	   "From popserver %s %s %2d %02d:%02d:%02d GMT %04d\n",
	   $daynames[$wday],
	   $monthnames[$mon],
	   $mday,$hour,$min,$sec,$year+1900);
    $_ = <SOCK>;
    while (!/^\.\r*$/) {
      s/\r//g;
      print SPOOLOUT $_ ;
      $_ = <SOCK>;
    }
    if( ! $keepmails ) {
      print "<<<DELE $msgnum\n" if ($userconfig{verbose});
      print SOCK "DELE $msgnum\r\n";
      ($status, $smsg) = &pop_ack();
      if ($status ne "OK") {
	# &die_gracefully($smsg);
      }
    }
  }

#  Here is the section where an alternate local delivery agent
#  can be invoked if you want...
#	if (defined $local_mailer)
#	{
#	        # use local delivery agent...
#		open (MBOX, $local_mailer) ||
#			&die_gracefully("Can't start local mailer " .
#					"- some mail is in $tempfile");
#	} else {

  $mailfile = ((defined $ENV{'MAIL'}) ? $ENV{'MAIL'} :
	       ($userconfig{mailspooldir}."/" . $localuser));
  open(MBOX, ">>$mailfile") ||
    &die_gracefully("Can't open mailbox $mailfile " .
		    "- some mail is in $tempfile");
  flock(MBOX,$LOCK_EX);
  # and, in case someone appended
  # while we were waiting...
  seek(MBOX, 0, 2);
  seek(SPOOLOUT,0,0);
  while(<SPOOLOUT>){
    print MBOX $_ ||
      &die_gracefully( ((defined $local_mailer)
			? "Can't pipe to local mailer"
			: "Can't write to mailbox $mailfile")
		       . "- some mail is in $tempfile");
  }
  close SPOOLOUT;
  unlink "$tempfile";
  flock(MBOX,$LOCK_UN) unless defined $local_mailer;
  close MBOX;
}

sub get_user_info {
  my(%sites);
  if (-f $serverfilename) {
    open(POPFILE,$serverfilename)
      || &die_gracefully("Can't Open $serverfilename file! $!");
    local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	  $atime,$mtime,$ctime,$blksize,$blocks) = stat POPFILE;
    if($mode != 0100600){
      &die_gracefully("$serverfilename needs permissions rw-------");
    }
    my $lineno = 1;
    while (<POPFILE>) {
      next if /^$/;
      ($host, $port, $user, $passwd) = split(' ',$_);
      print("No password for host $host - skipping.\n") if( $passwd eq '' );
      print("No hostname in line $lineno of server file - skipping.\n")
	if( $host eq '' );
      print("No username in line $lineno of server file - skipping.\n")
	if( $user eq '' );
      print("No port no. in line $lineno of server file - skipping.\n")
	if( $port eq '' );
      push @{$sites{"sitelist"}},
	  { 'host' => $host,
	    'port' => $port,
	    'user' => $user,
	    'pass' => $passwd };
    }
    close(POPFILE);
  } else {
    print "Server file ".$serverfilename ." not found.\n";
    print "Please read the file INSTALL.\n";
    exit(255);
  }
  if ( ($userconfig{debug}) ) {
    foreach (@{$sites{'sitelist'}}) {
      print "\'host\' = ".$_ -> {'host'}."\n";
      print "\'port\' = ".$_ -> {'port'}."\n";
      print "\'user\' = ".$_ -> {'user'}."\n";
      print "\'pass\' = ......\n\n";
    }
  }
  return \%sites;
}

sub visit_sites {
  my ($mw, $sites) = @_;
  my ($openstatus);
  my $servermsg = $mw -> Subwidget( 'servermsg' );
  my $c = $mw -> Subwidget( 'canvas' );
  foreach $i (@{$sites->{"sitelist"}}) {
    next if ( $i -> {'port'} == ($userconfig{smtpport}) );
    $pass = $i->{"pass"};
    $host = $i->{"host"};
    $openstatus = &openserver($mw,$host,$i->{"port"},$i->{"user"},$pass);
    # from password entry
    next if $openstatus =~ /Cancel|OK/;
    goto SERV_ERROR if $openstatus =~ /socket|gethostbyname/;
    my($msgs,$octets) = &nummsgs;
    $c -> dchars( $servermsg, '0', 'end' );
    $c -> insert( $servermsg, 'end', "Number of messages on host: $msgs.");
    $c -> update;
    for ($msg = 1; $msg <= $msgs; $msg++ ) {
      $c -> dchars( $servermsg, '0', 'end' );
      $c -> insert( $servermsg, 'end', "Retrieving message $msg/$msgs.");
      $c -> update;
      &retrieve( $msg, $servermsg, $c );
    }
    &close_pop_server;
  SERV_ERROR:
    close SOCK;
  }
}
	
sub format_sender {
  my ($s) = @_;
  # Only for standard listbox
#  if( ( length $s ) < ($userconfig{senderlen}) ) {
#    $s .=  substr $padding, 0, ($userconfig{senderlen}) - length $s;
#    return $s;
#  }
#  if( ( length $s ) > ($userconfig{senderlen}) ) {
#    return substr $s, 0, ($userconfig{senderlen});
#  }
  return $s;
}

sub format_subject {
  my ($s) = @_;
  return $s;
}

# Regex and implied split based on Hans Helgesen's Tk::MListbox widget.
sub format_possible_rfcdate {
  my ($s) = @_;
  return '' if ($s eq '');
  # RFC 822-standard date with weekday
  my ($wday,$day,$mon,$year,$hour,$min,$sec,$tz) =
    ($s =~ m/(\w\w\w,)\s*(\S*)\s*(\S*)\s*(\S*)\s*(\d*):(\d*):(\d*)\s*(\S*).*/);
  if (( $sec ne '') and $sec) {
    my $r = sprintf ("%4s %02d %s %4d %02d:%02d:%02d %s",
		     $wday,$day,$mon,
		     ((length($year)==2)?"20{$year}":$year),
		     $hour,$min,$sec,$tz) if ($sec ne '') and $sec;
    return $r if ($sec ne '' ) and $sec;
  }
  # Date with no weekday
  my ($day,$mon,$year,$hour,$min,$sec,$tz) =
    ($s =~ m/(\S*)\s*(\S*)\s*(\S*)\s*(\d*):(\d*):(\d*)\s*(\S*).*/);
  $r = sprintf ("%02d %s %4d %02d:%02d:%02d %s",
		  $day,$mon,
		  ((length($year)==2)?"20{$year}":$year),
		  $hour,$min,$sec,$tz);
  return $r;
}

sub timezone {
  my ($day,$mon,$year,$hour,$min,$sec,$tz) = @_;
  my ($chour,$cmin,$ztime,$ntz);
  return ( $day,$mon,$year,$hour,$min,$sec )
    if ( ($tz eq /^\w*$/) || ( $tz =~ /UT|GMT|Z|\-0000|\+0000/ ) );

  # also account for AM and PM in the timezone slot.
  if ( $tz =~ /PM/ ) {
    $hour = sprintf "%02d", $hour += 12;
    if ( $hour eq '24' ) {
      $hour = '00';
      $day = sprintf "%02d", $day += 1;
    }
    return $day, $mon, $year, $hour, $min, $sec;
  }
  return $day, $mon, $year, $hour, $min, $sec if $tz =~ /AM/;

  $ntz = $tz;
  $ntz = '-0100' if $tz eq 'A';
  $ntz = '-0200' if $tz eq 'B';
  $ntz = '-0300' if $tz eq 'C';
  $ntz = '-0400' if $tz eq 'D';
  $ntz = '-0500' if $tz eq 'E';
  $ntz = '-0600' if $tz eq 'F';
  $ntz = '-0700' if $tz eq 'G';
  $ntz = '-0800' if $tz eq 'H';
  $ntz = '-0900' if $tz eq 'I';
  # 'J' not used
  $ntz = '-1000' if $tz eq 'K';
  $ntz = '-1100' if $tz eq 'L';
  $ntz = '-1200' if $tz eq 'M';
  $ntz = '+0100' if $tz eq 'N';
  $ntz = '+0200' if $tz eq 'O';
  $ntz = '+0300' if $tz eq 'P';
  $ntz = '+0400' if $tz eq 'Q';
  $ntz = '+0500' if $tz eq 'R';
  $ntz = '+0600' if $tz eq 'S';
  $ntz = '+0700' if $tz eq 'T';
  $ntz = '+0800' if $tz eq 'U';
  $ntz = '+0900' if $tz eq 'V';
  $ntz = '+1000' if $tz eq 'W';
  $ntz = '+1100' if $tz eq 'X';
  $ntz = '+1200' if $tz eq 'Y';
  $ntz = '-0500' if $tz =~ /EST/;
  $ntz = '-0400' if $tz =~ /EDT/;
  $ntz = '-0600' if $tz =~ /CST/;
  $ntz = '-0500' if $tz =~ /CDT/;
  $ntz = '-0700' if $tz =~ /MST/;
  $ntz = '-0600' if $tz =~ /MDT/;
  $ntz = '-0800' if $tz =~ /PST/;
  $ntz = '-0700' if $tz =~ /PDT/;
  # just return the time if there's no recognizable timezone.
  if( $ntz !~ /^\+|\-\d\d\d\d/ ) {
    return ($day,$mon,$year,$hour,$min,$sec)
  }
  ($chour,$cmin) = ($ntz =~ /(\d\d)(\d\d)/);
  if( $cmin ne '00' ) {
    $min = sprintf "%02d", ($ntz =~ /\+/)?$hour + $cmin:$hour - $cmin;
    if ( $min gt '59' ) {
      $hour = sprintf "%02d", $hour += 1;
      $min = sprintf "%02d", $min -= 60;
    } elsif ( $min lt '00' ) {
      $hour = sprintf "%02d", $hour -= 1;
      $min = sprintf "%02d", $min += 60
    }
  }
  $hour = sprintf "%02d", ($ntz =~ /\+/)?$hour + $chour:$hour - $chour;
  if( $hour gt '23' ) {
    $day = sprintf "%02d", $day += 1;
    $hour = sprintf "%02d", $hour -= 24;
  } elsif ( $hour lt '00' ) {
    $day = sprintf "%02d", $day -= 1;
    $hour = sprintf "%02d", $hour += 24;
  }
  return ($day,$mon,$year,$hour,$min,$sec);
}

# sort part of the rfc 822 date fields.
sub rfcdate_compare {
  my ($ap, $bp) = @_;
    my ($a_day,$a_mon,$a_year,$a_hour,$a_min,$a_sec,$a_tz) =
      ($ap =~
       m/.*?(\d+)\s*(\S*)\s*(\S*)\s*(\d*)\:(\d*)\:(\d*)\s*(\S*)/);
    my ($b_day,$b_mon,$b_year,$b_hour,$b_min,$b_sec,$b_tz) =
      ($bp =~
       m/.*?(\d+)\s*(\S*)\s*(\S*)\s*(\d*)\:(\d*)\:(\d*)\s*(\S*)/);
    my ($a_dayz,$a_monz,$a_yearz,$a_hourz,$a_minz,$a_secz) =
      &timezone( $a_day,$a_mon,$a_year,$a_hour,$a_min,$a_sec,$a_tz);
    my ($b_dayz,$b_monz,$b_yearz,$b_hourz,$b_minz,$b_secz) =
      &timezone( $b_day,$b_mon,$b_year,$b_hour,$b_min,$b_sec,$b_tz);
    if( ! $datesortorder ) {
      return ( $b_yearz cmp $a_yearz ) if $a_yearz ne $b_yearz;
      if( $a_monz ne $b_monz ) {
	my ($i, $a_mno, $b_mno);
	for($i = 0; $i < 12; $i++) {
	  $a_mno = $i if $monthnames[$i] eq $a_monz;
	  $b_mno = $i if $monthnames[$i] eq $b_monz;
	}
	return ( $b_mno <=> $a_mno );
      }
      return ( $b_dayz cmp $a_dayz ) if $a_dayz ne $b_dayz;
      return( $b_hourz cmp $a_hourz) if $a_hourz ne $b_hourz;
      return( $b_minz cmp $a_minz) if $a_minz ne $b_minz;
      return( $b_secz cmp $a_secz) if $a_secz ne $b_secz;
    } else {
      return ( $a_yearz cmp $b_yearz ) if $a_yearz ne $b_yearz;
      if( $a_monz ne $b_monz ) {
	my ($i, $a_mno, $b_mno);
	for($i = 0; $i < 12; $i++) {
	  $a_mno = $i if $monthnames[$i] eq $a_monz;
	  $b_mno = $i if $monthnames[$i] eq $b_monz;
	}
	return ( $a_mno <=> $b_mno );
      }
      return ( $a_dayz cmp $b_dayz ) if $a_dayz ne $b_dayz;
      return( $a_hourz cmp $b_hourz) if $a_hourz ne $b_hourz;
      return( $a_minz cmp $b_minz) if $a_minz ne $b_minz;
      return( $a_secz cmp $b_secz) if $a_secz ne $b_secz;
    }
  return 0;
}

sub sort_column {
  my ($l, $selectedcolumn) = @_;
  if( $userconfig{sortfield} eq $selectedcolumn ) {
    $l -> {'ml_sort_descending'} =
      (($l -> {'ml_sort_descending'} =~ /0/ ) ? 1 : 0 );
    $datesortorder = $l -> {'ml_sort_descending'};
  } else {
    $userconfig{sortfield} = $selectedcolumn;
    $l -> {'ml_sort_descending'} =
      (($l -> {'ml_sort_descending'} =~ /0/ ) ? 1 : 0 );
    $datesortorder = $l -> {'ml_sort_descending'};
  }
  &watchcursor($l->parent->parent);
  eval {
    &listmailfolder( $l, $currentfolder );
  };
  $l -> update;
  &defaultcursor($l->parent->parent);
}

# like the above, but for the menu options, not the list columns.
sub sort_option {
  my ($mw, $selectedcolumn) = @_;
  my $l = $mw -> Subwidget( 'messagelist' );
  if( $userconfig{sortfield} eq $selectedcolumn ) {
    $l -> {'ml_sort_descending'} =
      (($l -> {'ml_sort_descending'} =~ /0/ ) ? 1 : 0 );
    $datesortorder = $l -> {'ml_sort_descending'};
  } else {
    $userconfig{sortfield} = $selectedcolumn;
    $l -> {'ml_sort_descending'} =
      (($l -> {'ml_sort_descending'} =~ /0/ ) ? 1 : 0 );
    $datesortorder = $l -> {'ml_sort_descending'};
  }
  &watchcursor($mw);
  eval {
    &listmailfolder( $l, $currentfolder );
  };
  $l -> update;
  &defaultcursor($mw);
}

sub changefolder {
  my ($mw, $f) = @_;
  &watchcursor( $mw );
  eval {
    my $l = $mw -> Subwidget( 'messagelist' );
    my $t = $mw -> Subwidget( 'text' );
    my $msgcounter = $mw -> Subwidget( 'msgcounter' );
    $currentfolder = $f;
    $l -> delete( 0, $l -> size );
    $t -> delete( '1.0', 'end' );
    &listmailfolder( $l, $currentfolder );
    &updatemsgcount( $mw, $currentfolder );
    $mw -> configure( -title => "$currentfolder");
    };
  &defaultcursor( $mw );
}

sub listmailfolder {
  my($l,$folder) = @_;
  my (@msgfiles,@msgfilelist,@subjline,@fromline,@dateline,@msgtext,$msgid);
  my ($listingstatus,$lindex,@findex,$sresult);
  my ($listingdate,$listingfrom,$listingsubject,$listingid);
  $l -> delete( 0, 'end' );
  $#sortedmessages = -1;
  opendir MDIR, $folder or die "Could not open folder $folder: $!\n";
  @msgfiles = grep /[^\.]|[^\.][^\.]/, readdir MDIR;
  closedir MDIR;
  foreach $msgid (@msgfiles) {
    next if $msgid =~ /\.index/;
    next if $msgid eq '';
    open MSG, "<$folder/$msgid"
      or warn "Couldn't open message $msgid: $!\n";
    while( @msgtext = <MSG> ) {
      @subjline = grep /^Subject: /i, @msgtext;
      @fromline = grep /^From: /i, @msgtext;
      @dateline = grep /^Date: /i, @msgtext;
    }
    close MSG;
    chomp $fromline[0];
    chomp $subjline[0];
    $fromline[0] =~ s/From:\s*//i;
    $subjline[0] =~ s/Subject:\s*//i;
    $dateline[0] =~ s/Date:\s*//i;
    $dateline[0] =~ s/\n//; #instead of chomp.
    push @msgfilelist, ( &format_possible_rfcdate($dateline[0]).' ~~~'.
		  &format_sender($fromline[0]).'~~~'.
		  &format_subject($subjline[0]) . "~~~$msgid" );
  }
  if ( $userconfig{sortfield} =~ /1/ ) { # sort by date
    @sortedmessages = sort {
      $a =~ /^(.*?)\s~~~/; my $a1 = $1;
      $b =~ /^(.*?)\s~~~/; my $b1 = $1;
      if ( length $a1 and  length $b1 ) {
	&rfcdate_compare($a1,$b1);
      }
    } @msgfilelist;
  } elsif ( $userconfig{sortfield} =~ /2/) { # sort by sender
    @sortedmessages = sort {
      $a =~ /^.*?~~~(.*?)~~~/; $a1 = $1;
      $b =~ /^.*?~~~(.*?)~~~/; $b1 = $1;
      ($l -> {ml_sort_descending}) ? $b1 cmp $a1 : $a1 cmp $b1 ;
    } @msgfilelist;
  } elsif ( $userconfig{sortfield} =~ /3/) { # sort by subject
    @sortedmessages = sort {
      $a =~ /^.*?~~~.*?~~~(.*?)~~~/; $a1 = $1;
      $b =~ /^.*?~~~.*?~~~(.*?)~~~/; $b1 = $1;
      ($l -> {ml_sort_descending}) ? $b1 cmp $a1 : $a1 cmp $b1 ;
    } @msgfilelist;
  } else { # don't sort
    push @sortedmessages, @msgfilelist;
  }

  if ( -f "$folder/.index" ) {
    open INDEX, "$folder/.index" or
      warn "Could not open $folder/.index in listmailfolder(): $!\n";
    while( defined ( $lindex = <INDEX> ) ) {
      chomp $lindex;
      push @findex, ($lindex);
    }
    close INDEX;
  }
  foreach (@sortedmessages ) {
    ($listingdate,$listingfrom,$listingsubject,$listingid) = split /~~~/, $_;
    $listingstatus = '';
    $sresult = grep /$listingid/, @findex;
    if ( ! $sresult ) {
      $listingstatus .= 'u';
    }
    if ( $userconfig{weekdayindate} =~ /0/ ) {
      $listingdate =~ s/^\w\w\w\, //;
    }
    $l -> insert('end',[$listingstatus,
	  $listingdate," $listingfrom"," $listingsubject"]);
  }
}

sub movemail {
  my (@msgs, $line, $mbox, $msgid, $idcnt, $msgcount );
  my ($pattern, $filterfolder);
  my $lbuf = '';
  open MBOX, "<$systemmbox" or die "Couldn't open $systemmbox: $!\n";
  while ( defined ($line = <MBOX>) ) {
    $mbox .= $line;
  }
  close MBOX;
  # the split gives us a 0th empty element whether or not
  # there's a match - the first message if it exists is
  # always $msgs[1], because a match of the mailbox record
  # occurs on the first line.
  @msgs = split /^From \S+/ms, $mbox;
  return if ! defined shift @msgs;
  # if there was actually a match
  $msgsequence = 1;
  foreach my $message (@msgs) {
    foreach my $filter (@{$userconfig{filter}}) {
      ($pattern,$filterfolder) = split /==/, $filter;
      if ( $message =~ /$pattern/msi ) {
	$filterfolder = "$defaultuserdir/$filterfolder";
	last;
      }
      # fall through if no match.
      $filterfolder = $incomingfolder;
    }
    # Avoid existing filenames
    while ( -e "$filterfolder/$$-$msgsequence" ) {
      $msgsequence++;
    }
    open MSG, ">$filterfolder/$$-$msgsequence" or
      print "Couldn't save message in $incomingfolder: $!.\n";
    print MSG $message;
    close MSG;
    print STDERR "Saved message $$-$msgsequence\n" if ($userconfig{debug});
    $msgsequence++;
  }
  if( ! ($userconfig{debug})  and ! $keepmails ) {
    open MBOX, ">$systemmbox" or
      warn "Couldn't empty $systemmbox: $!\n";
    close MBOX;
  }
}

sub redisplaymessage {
  my ($mw) = @_;
  &watchcursor($mw);
  eval {
    my $t = $mw -> Subwidget('text');
    $t -> delete( '1.0', 'end' );
    &displaymessage( $mw, $currentfolder );
  };
  &defaultcursor($mw);
}

sub displaymessage {
  my ($mw, $msgdir) = @_;
  my $l = $mw -> Subwidget( 'messagelist' );
  my $t = $mw -> Subwidget( 'text' );
  my ($ml, $line, $ofrom, $hdr, @hdrlines, $body, $msg, $msgfile);
  $mw -> update;
  &watchcursor( $mw );
  $t -> delete( '1.0', 'end' );
  # this prevents the program from carping if there's no selection.
  $msgfile = $sortedmessages[($l->curselection)[0]];
  $msgfile =~ s/.*\~\~\~//;
  open MSG, "<$msgdir/$msgfile" or
    warn "Couldn't open $msgdir/$msgfile: $!\n";
  while( defined($ml = <MSG>)) { $msg .= $ml }
  close MSG;
  &addmsgtoindex( $msgfile,$msgdir );
  &updatemsgcount($mw, $msgdir);
  my $nrow = ($l->curselection)[0];
  my @listrow = $l -> getRow( $nrow );
  $listrow[0] = '';
  $l -> delete( $nrow );
  $l -> insert( $nrow, [@listrow] );
  $l -> selectionSet( $nrow );
  ($hdr, $body) = split /\n\n/, $msg, 2;
  if( $userconfig{headerview} eq 'full' ) {
    @hdrlines = split /\n/, $hdr;
    foreach( @hdrlines ) {
      next if /^$/smi;
      $t -> insert( 'end', "$_\n", 'header' );
    }
    $t -> insert( 'end', "\n", 'header' );
  }
  if( $userconfig{headerview} eq 'brief' ) {
    @hdrlines = split /\n/, $hdr;
    foreach( @hdrlines ) {
      next unless /^To\: |^From\: |^Date\: |^Subject\: /smi;
      $t -> insert( 'end', "$_\n", 'header' );
    }
    $t -> insert( 'end', "\n", 'header' );
  }
  $t -> insert( 'end', "$body" );
  $t -> markSet( 'insert', '1.0' );
  $t -> see( 'insert' );
  $t -> focus;
  &defaultcursor( $mw );
}

sub addmsgtoindex {
  my ($file, $folder) = @_;
  my $l;
  if( -f "$folder/.index" ) {
    open INDEX, "<$folder/.index" or
      warn "Could not open index in $folder: $!\n";
    while( defined ( $l = <INDEX> ) ) {
      if ( $l =~ /$file/ ) {
	close INDEX;
	return;
      }
    }
    close INDEX;
  }
  #re-open for append
  open INDEX, ">>$folder/.index" or
    warn "Could not open index in $folder: $!\n";
  chomp $file;
  print INDEX "$file\n";
  close INDEX;
}

sub deletemsgfromindex {
  my ($file, $folder) = @_;
  my @msgs;
  my ($l, $newindex, $deleted);
  if( -f "$folder/.index" ) {
    open INDEX, "<$folder/.index" or
      warn "Could not open index in $folder: $!\n";
    while ( defined ( $l = <INDEX> )  ) {
      chomp $l;
      next if ( ! -f "$folder/$l" );
      if ( $l =~ /$file/ ) {
	$deleted = $l;
	next;
      }
      chomp $l;
      $newindex .= "$l\n";
    }
    close INDEX;
  }
  # open and clobber
  open INDEX, ">$folder/.index" or
    warn "Could not open new index in $folder: $!\n";
  print INDEX $newindex;
  close INDEX;
  return $deleted;
}

sub updatemsgcount {
  my($mw,$folder) = @_;
  my $l = $mw -> Subwidget( 'messagelist' );
  my $c = $mw -> Subwidget( 'canvas' );
  my $m = $mw -> Subwidget( 'foldermenu' );
  my $msgcounter = $mw -> Subwidget( 'msgcounter' );
  my ($f, $findex, $bname, @ffiles, $unread, $nmsgs );
  $f = $folder;
  $f =~ /.*?([^\/]*)$/;
  $bname = ucfirst $1;
  $findex = $m -> index( $bname );
  next if ! $findex;
  opendir DIR, "$f" or warn "Couldn't open $f: $!\n";
  @ffiles = grep /^[^\.].*/, readdir DIR;
  $nmsgs = $#ffiles + 1;
  closedir DIR;
  $unread = $nmsgs;
  if( -f "$f/.index" ) {
    open INDEX, "<$f/.index" or
      warn "Could not open $f/.index in updatemsgcount(): $!\n";
    while( defined ($ff = <INDEX> ) ) {
      chomp $ff;
      if(-f "$f/$ff"){$unread--};
    }
    close INDEX;
  }
  $m -> entryconfigure( $findex, -accelerator => " $unread/$nmsgs " );
  $c -> dchars( $msgcounter, 0, length( $countertext ));
  $countertext = $l -> index( 'end' )." Message";
  if( $l -> index( 'end' ) != 1 ) { $countertext .= 's' }
  $c -> insert( $msgcounter, 1, $countertext );
}

sub movemesg {
  my( $mw, $dir ) = @_;
  my $l = $mw -> Subwidget( 'messagelist' );
  my $t = $mw -> Subwidget( 'text' );
  my $c = $mw -> Subwidget( 'canvas' );
  my $msgcounter = $mw -> Subwidget( 'msgcounter' );
  my($il, $selindex, $omsgfile,$nmsgfile );
  &watchcursor;
  eval {
    $selindex = ($l->curselection)[0];
    print "$selindex\n" if ($userconfig{debug});
    return if $selindex < 0 ;

    my $listing = $sortedmessages[$selindex];
    my ($msgdate,$msgfrom,$msgsub,$omsgfile) =
      split /\~\~\~/, $listing;
    $omsgfile =~ s/.*\~\~\~//;
    $nmsgfile = $omsgfile;

    open INMSG, "<$currentfolder/$omsgfile"
      or die "Couldn't open message file: $!\n";

#    This is a bit ugly - better renaming for duplicate filenames?
    while( -e "$dir/$nmsgfile" ) {
      $nmsgfile .= '1';
    }

    open OUTMSG, "+>>".$dir."/$nmsgfile"
      or die "Couldn't open message file: $!\n";

    while ( defined ($il = <INMSG> ) ) {
      print OUTMSG $il;
    }

    close INMSG;
    close OUTMSG;

    &deletemsgfromindex( $omsgfile, $currentfolder );
    &addmsgtoindex( $nmsgfile, $dir );
    &updatemsgcount( $mw, $currentfolder );
    &updatemsgcount( $mw, $dir );

    unlink( "$currentfolder/$omsgfile");

    $t -> delete( '1.0', 'end' );
    $l -> delete( ($l->curselection)[0] );
    &listmailfolder( $l, $currentfolder );

    if( $selindex >= ( $l -> index( 'end' ) ) ) {
      $selindex--;
    }
    $l -> selectionSet( $selindex, $selindex );
    if( $selindex >= 0 ) {
      &displaymessage( $mw, $currentfolder );
      $l -> see( $selindex + 1 );
    }

    &updatemsgcount( $mw, $currentfolder );

    }; # eval

  &defaultcursor;
}

sub emptytrash {
  my (@files, $utctime, $mtime, $expiresafter,$f,$tf);
  $utctime = time;
  $expiresafter = ($userconfig{trashdays}) * 24 * 3600;
  print "emptytrash(): UTC time: $utctime, older than $expiresafter.\n" 
    if $userconfig{debug};
  opendir TRASH, $userconfig{trashdir} 
    or warn "Could not open ".$userconfig{trashdir}.": $!\n";
  @files = grep /^[^.]/, readdir TRASH;
  closedir TRASH;
  foreach $f (@files) {
    $tf = $userconfig{trashdir}."/$f";
    $mtime = (stat($tf))[9];
    print "$tf, mtime\: $mtime, age: ".($utctime - $mtime)."\n"
      if ($userconfig{debug});
    if(($utctime - $mtime) >= $expiresafter ) {
      unlink( $tf ) if not $userconfig{debug};
      &deletemsgfromindex( $f, $userconfig{trashdir} )
	if not $userconfig{debug};
      print "unlink $tf.\n" if $userconfig{debug};
    }
  }
}

sub incoming_poll {
  my ($mw, $lsites) = @_;
  my ($hdr, $selindex);
  my $l = $mw -> Subwidget( 'messagelist' );
  my $t = $mw -> Subwidget( 'text' );
  my $c = $mw -> Subwidget( 'canvas' );
  my $servermsg = $mw -> Subwidget( 'servermsg' );
  my $msgcounter = $mw -> Subwidget( 'msgcounter' );
  &watchcursor( $mw );
  eval {
    # remember selection if there is one
    $selindex = ($l->curselection)[0];
    &visit_sites( $mw, $lsites );
    &movemail;
    $l -> delete( 0, $l -> size );
    &listmailfolder( $l, $currentfolder );
    &updatemsgcount($mw,$_) foreach (@{$userconfig{folder}});
    &emptytrash;
    $c -> dchars( $servermsg, '0', 'end' );
    if( $selindex ne '' ) {
      $l -> selectionSet( $selindex, $selindex) if ($selindex ne '');
      $l -> see( $selindex );
      &displaymessage( $mw, $currentfolder );
    }
    $l -> after( ($userconfig{pollinterval}),
		 sub{&incoming_poll($mw, $lsites)});
  };
  &defaultcursor( $mw );
}

sub quitclient {
  my( $mw ) = @_;
#  $mw -> WmDeleteWindow;
  exit 0;
}

sub sendmsg {
  my ($cw, $ct, $c, $servermsg) = @_;
  my $md = $userconfig{maildomain};
  my ($openstatus,$addressee,$toline,$subjline,$i);
  my (@msgtextlist,$fcc_file,$msghdr,$msgtext,@hdrlist);
  &watchcursor($cw);
  eval {
    $c -> dchars( $servermsg, '0', 'end' );
    $c -> insert( $servermsg, 'end',
		  "Formatting message... ");
    $cw -> update;
    ($msghdr, $msgtext) = split /$msgsep/, $ct -> get( '1.0', 'end' );
    while ( $msgtext =~ /(.*?\n)/s ) {
      push @msgtextlist, ($1);
      $msgtext =~ s/$tl//;
    }
    print $msghdr if ($userconfig{debug});
    @hdrlist = split /\n/, $msghdr;
    foreach( @hdrlist ) {
      if ( /To:/i ) {
	$toline = $_;
	$toline =~ /To: (.*)/;
	$addressee = $1;
      }
      if( /Subject:/i ) {
	$subjline = $_;
      }
      if( /Fcc:/i ) {
	$fcc_file = $_;
	$fcc_file =~ s/Fcc: (.*)/\1/i;
      }
    }

    if ( $userconfig{usesendmail} ) {
      ($msghdr, $msgtext) = split /$msgsep/, $ct -> get( '1.0', 'end' );
      $addressee =~ s/([<> ])/\\\1/g;
      # watch backslash interpolation in addressee.
      if( $userconfig{sendmailsetfrom} ) {
	open MTA,
	  "|".$userconfig{sendmailprog}." -f $username\@$md $addressee" or
	    warn "Couldn't open ".$userconfig{sendmailprog}.": $!\n";
      } else {
	open MTA,
	  "|".$userconfig{sendmailprog}." $addressee" or
	    warn "Couldn't open ".$userconfig{sendmailprog}.": $!\n";
      }
      print MTA "$msghdr\n$msgtext\n.\n";
      close MTA;
      &write_fcc($ct->get('1.0','end'))
	if $fcc_file ne '' and length $fcc_file;
      goto CLOSE_MTA;
    }

    $c -> dchars( $servermsg, '0', 'end' );
    $c -> insert( $servermsg, 'end',
		  "Getting server info... ");
    $cw -> update;

    my ($host, $port, $uname, $passwd);
    foreach $i ( @{$lsites -> {'sitelist'}} ) {
      if( $i -> {'port'} != ($userconfig{smtpport}) ) {
	next;
      } else {
	$host = $i -> {'host'};
	$port = $i -> {'port'};
	$uname = $i -> {'user'};
	$pass = $i -> {'pass'};
	break;
      }
    }
    if ( $host eq '' or ! defined $host ) {
      &die_gracefully( "No SMTP hostname defined\!\n" );
    }
    if ( $port != ($userconfig{smtpport}) ) {
      &die_gracefully( "Incorrect port $port\!\n" );
    }
    if ( $uname eq '' or ! defined $uname ) {
      &die_gracefully( "No user name defined\!\n" );
    }
    # Probably want to make this enterable by the user...
    if ( $pass eq '' or ! defined $pass ) {
      &die_gracefully( "No password defined\!\n" );
    }
    $c -> dchars( $servermsg, '0', 'end' );
    $c -> insert( $servermsg, 'end',
		  "Opening server... ");
    $cw -> update;

    $openstatus = &openserver($cw,$host,$port,$uname,$pass);
    return if $openstatus =~ /Cancel|OK/;
    goto SERVER_ERR if $openstatus =~ /socket|gethostbyname|servergreeting/;

    $c -> dchars( $servermsg, '0', 'end' );
    $c -> insert( $servermsg, 'end',
		  "Sending message header... ");
    $cw -> update;
    print "<<<DATA\n" if ($userconfig{verbose});
    print SOCK "DATA\r\n";
    my $dataack = &smtpack();

# Wait for a numeric acknowledgement code.
    while ( $dataack !~ /^[2-5]/ ) {
      $dataack = &smtpack();
      print "$dataack\n" if ($userconfig{verbose});
      if ($status =~ /^354|^50|^45|^55|^421/ ) {
	$c -> dchars( $servermsg, '0', 'end' );
	$c -> insert( $servermsg, 'end', "$status: $!" );
	$cw -> update;
	print "<<<RSET\n" if ($userconfig{verbose});
	print SOCK "RSET\r\n";
	goto SERVER_CLOSE;
      }
    }
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time);
    $year += 1900;
    my $dn = $daynames[$wday];
    my $mn = $monthnames[$mon];
    print "<<<Date: $dn, $mday $mn $year $hour\:$min\:$sec -0000\n"
      if ($userconfig{verbose});
    print SOCK "Date: $dn, $mday $mn $year $hour\:$min\:$sec -0000\r\n";
    my $localhost = `uname -n`;
    my $inetmsgid = time.'ec@'.$localhost;
    chop $inetmsgid;
    print "<<<$msgidfield <$inetmsgid>\n" if ($userconfig{verbose});
    print SOCK "$msgidfield <$inetmsgid>\r\n";
    print "<<<$fromfield <$uname\@$md>\n" if ($userconfig{verbose});
    print SOCK "$fromfield <$uname\@$md>\r\n";
    print "<<<$msghdr" if ($userconfig{verbose});
    my $crhdr = $msghdr;
    $crhdr =~ s/\n/\r\n/gsm;
    print SOCK $crhdr;

    $c -> dchars( $servermsg, '0', 'end' );
    $c -> insert( $servermsg, 'end',
		  "Sending message body... ");
    $cw -> update;

    # Format and send message body.
    foreach my $mline (@msgtextlist) {
      print "<<<$mline" if ($userconfig{verbose});
      chomp $mline;
      # when there's a single period alone on a line,
      # add a space, so server doesn't interpret as end-
      # of message.  Thanks to NI-S for reminding me of
      # this on perl/tk mailing list. The SMTP server
      # would quote it with another period, so the
      # program might as well do it here.
      $mline = '..' if $mline eq '.';
      print SOCK "$mline\r\n";
    }
    print "<<<\n\<<<.\n" if ($userconfig{verbose});
    print SOCK "\r\n\.\r\n";
    # use longer timeout to give server time to finish
    $c -> dchars( $servermsg, '0', 'end' );
    $c -> insert( $servermsg, 'end',
		  "Waiting for acknowledgement... ");
    $cw -> update;

  $SIG{ALRM} = sub { alarm 0; die 'smtp acknowledgement' };
    eval {
      while() {
	alarm( $userconfig{servertimeout} );
	$status = &smtpack();
	print "$status\n" if ($userconfig{verbose});
	if ( $status =~ /^250/ ){
	  &write_fcc($ct->get('1.0','end'))
	    if $fcc_file ne '' and length $fcc_file;
	  alarm( 0 );
	  goto SERVER_CLOSE;
	}
	if ($status =~ /^45|^55/ ) {
	  $c -> dchars( $servermsg, '0', 'end' );
	  $c -> insert( $servermsg, 'end', "$status: $!" );
	  alarm( 0 );
	  print "<<<RSET\n" if ($userconfig{verbose});
	  print SOCK "RSET\r\n";
	  goto SERVER_CLOSE;
	}
      }
      alarm( 0 );
    };
  };  # end of eval scope
 SERVER_CLOSE:
  $c -> dchars( $servermsg, '0', 'end' );
  $c -> insert( $servermsg, 'end',
		"Closing server... ");
  $cw -> update;
  &defaultcursor($cw);
  print "<<<QUIT\n" if ($userconfig{verbose});
  print SOCK "QUIT\r\n";
  local $quitack = &smtpack();
  print "$quitack\n" if ($userconfig{verbose}) and defined $quitack;
  while ( $quitack !~ /^221|^500/ ) {
    $status = &smtpack();
    print "$status\n" if ($userconfig{verbose});
    if ($status =~ /^500/ ) {
      $c -> dchars( $servermsg, '0', 'end' );
      $c -> insert( $servermsg, 'end', "$status: $!" );
      $cw -> update;
      print "<<<RSET\n" if ($userconfig{verbose});
      print SOCK "RSET\r\n";
      return;
    }
  }
  $cw -> destroy;
  return 1;

  SERVER_ERR:
  &defaultcursor($cw);
  print "<<<QUIT\n" if ($userconfig{verbose});
  print SOCK "QUIT\r\n";
  local $quitack = &smtpack();
  return undef if not defined $quitack;
  print "$quitack\n" if ($userconfig{verbose}) and defined $quitack;
  return 1 if $quitack =~ /221/;
  while ( $quitack !~ /^221|^500/ ) {
    $status = &smtpack();
    print "$status\n" if ($userconfig{verbose});
    if ($status =~ /^500/ ) {
      $c -> dchars( $servermsg, '0', 'end' );
      $c -> insert( $servermsg, 'end', "$status: $!" );
      $cw -> update;
      print "<<<RSET\n" if ($userconfig{verbose});
      print SOCK "RSET\r\n";
      return;
    }
  }
  $cw -> destroy;
  return undef;
 CLOSE_MTA:
  $cw -> destroy;
  return 1;
}

sub write_fcc {
  my ($msg) = @_;
  my ($msghdr, $msgtext) = split /$msgsep/, $msg, 2;
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time);
  $year += 1900;
  my $dn = $daynames[$wday];
  my $mn = $monthnames[$mon];
  $msghdr =~ /^Fcc\:\s+(.*)$/smi;
  my $fccfile = $1;
  chop $fccfile;
  print "Fcc file: $fccfile\n" if $userconfig{debug};
  if ( defined $fccfile and ( length $fccfile ) ) {
    $fccfile = &qualify_path( $fccfile );
    print "writing FCC: $fccfile\n" if $userconfig{debug};
    open FCC, "+>> $fccfile"
      or warn "Could not open FCC file $fccfile: $!\n";
    print FCC  "\nDate: $dn, $mday $mn $year $hour\:$min\:$sec\r\n";
    print FCC "$msghdr\n\n$msgtext";
    close FCC;
  }
}

# prepend $HOME directory to path name in place of ~
sub qualify_path {
  my ($s) = @_;
  if( $s =~ /^\~/ ) {
    $s =~ s/~//;
    $s = $ENV{'HOME'}."/$s";
  }
  $s =~ s/\/\//\//g;
  return $s;
}

sub unfold_field {
  my ($fieldname, @header) = @_;
  my (@unfolded, @field,$unfoldedfield,$header,$infield);
  $infield = 0;
  foreach my $l (@header) {
    if( $infield ) {
      if ( ($l) =~ /^([ \t]+.*?)/i ) {
	$l =~ s/^[ \t]+//;
	push @field, ($l);
      } else {
	$infield = 0;
      }
    } elsif( ($l) =~ /$fieldname\s(.*)/i ) {
      push @field, ($1);
      $infield = 1;
    }
  }
  $unfoldedfield = join "\n ", @field;
  $unfoldedfield =~ s/\n\s+/, /g;
  return $unfoldedfield;
}

sub rfc822_addr {
  my ($s) = @_;
  $s =~ s/<|>//g;
  my ($s1,$s2) = ($s =~ /(.*\s)*(.+\@.+)/ );
  $s2 =~ s/ |\t//g;
  $s = ( (defined $s1) ? "$s1 <$s2>" : "<$s2>");
  return $s;
}

sub reply {
  my ($mw) = @_;
  my $cw = &composewidgets( $mw );
  my $ct = $cw -> Subwidget( 'text' );
  my $c = $mw -> Subwidget( 'canvas' );
  my $l = $mw -> Subwidget( 'messagelist' );
  my $servermsg = $mw -> Subwidget( 'servermsg' );
  my ($origmsgid, $origmsg, $origbody, $fromaddr, $replyaddr, $subj);
  my ($line, $orighdr, $ccline, $bccline);
  my $sigfile = $userconfig{sigfile};
  my $fcc_file = $userconfig{fccfile};
  $ccline = '';
  $bccline = '';
  $origmsgid = $sortedmessages[($l->curselection)[0]];
  $origmsgid =~ s/^.*\~\~//;
  open ORIGMSG, "$currentfolder/$origmsgid" or
    warn "reply(): Could not open $currentfolder/$origmsgid: $!\n";
  while ( defined ( $line = <ORIGMSG> ) ) { $origmsg .= $line }
  close ORIGMSG;
  $origmsg =~ /(.*?\n)(\n.*)/sm;
  $orighdr = $1;
  $origbody = $2;
  if( $orighdr =~ /^Reply-To\:\s+(.*?)$/smi ) {
    $replyaddr = rfc822_addr( $1 );
  } else {
    $replyaddr = '';
  }
  if ( $orighdr =~ /^From\:\s+(.*?)$/smi) {
    $fromaddr = &rfc822_addr( $1 );
  }
  if( $replyaddr eq '' ) {
    $replyaddr = $fromaddr;
  } elsif ($userconfig{ccsender} ) {
    $replyaddr =~ /(\S\@\S)/;
    local $r1 = $1;
    $fromaddr =~ /(\S\@\S)/;
    local $f1 = $1;
    $ccline .= $fromaddr if $r1 ne $f1;
  }
  $ccline .= rfc822_addr($1) if( $orighdr =~ /^CC\:\s+(.*)$/smi );
  $bccline = $1 if( $orighdr =~ /^BCC\:\s+(.*)\n/smi );
  if( $orighdr =~ /^Subject\:\s+(.*?)$/smi ) {
    $subj = $1;
    if ( $subj !~ /Re\:/smi ) {
      $subj = "Re: $subj";
    }
  }

  $ct->insert('1.0',"$tofield $replyaddr\n",'header');
  $ct->insert('end',"$ccfield $ccline\n",'header') if $ccline;
  $ct->insert('end',"$bccfield $bccline\n",'header') if $bccline;
  $ct->insert('end',"$subjfield $subj\n",'header');
  $ct -> insert('end', "$fccfield $fcc_file\n", 'header') if $fcc_file;
  $ct -> insert('end',"$msgsep\n\n",'header');

  $ct -> insert( 'end', "$fromaddr writes:\n" );
  my @formattedmsg = split /\n/, $origbody;
  foreach (@formattedmsg) {
    $ct -> insert( 'end', $userconfig{quotestring}."$_\n" );
  }
  if ( $userconfig{usesig} ) {
    $ct -> insert( 'end', "\n$sigsep" );
    open SIG, "$sigfile" or
      warn "Couldn't open $sigfile: $!";
    my ($sl, $sigtext);
    while ( defined ( $sl = <SIG> ) ) {
      $sigtext .= $sl;
    }
    close SIG;
    $ct -> insert( 'end', "\n$sigtext" );
  }
  return $cw;
}

sub compose {
  my $sigfile = $userconfig{sigfile};
  my $cw = &composewidgets( $mw );
  my $ct = $cw -> Subwidget( 'text' );
  my $c = $cw -> Subwidget( 'canvas' );
  my $fcc_file = $userconfig{fccfile};
  $ct -> insert( '1.0', "$tofield \n", 'header');
  $ct -> insert( '2.0', "$subjfield \n", 'header');
  $ct -> insert( '3.0', "$fccfield $fcc_file\n", 'header') if $fcc_file;
  $ct -> insert( 'end', "$msgsep\n\n", 'header');
  if ( $userconfig{usesig} ) {
    $ct -> insert( 'end', "\n$sigsep" );
    open SIG, "$sigfile" or
      warn "Couldn't open $sigfile: $!";
    my ($sl, $sigtext);
    while ( defined ( $sl = <SIG> ) ) {
      $sigtext .= $sl;
    }
    close SIG;
    $ct -> insert( 'end', "\n$sigtext" );
  }
  return $cw;
}

sub composemenu {
  my ($mw) = @_;
  my $cm = $mw -> Menu( -type => 'menubar', -font => $menufont );
  my $composefilemenu = $cm -> Menu;
  my $composeeditmenu = $cm -> Menu;
  my $optionalfieldsmenu = $cm -> Menu;
  $cm -> add( 'cascade', -label => 'File', -menu => $composefilemenu );
  $cm -> add( 'cascade', -label => 'Edit', -menu => $composeeditmenu );
  $composefilemenu -> add( 'command', -label => 'Insert File...',
			   -accelerator => 'Alt-I',
			   -font => $menufont,
			   -command => sub {&InsertFileDialog($mw)});
  $composefilemenu -> add( 'separator' );
  $composefilemenu -> add( 'command', -label => 'Minimize', -state => 'normal',
		  -font => $menufont, -accelerator => 'Alt-Z',
		  -command => sub{$mw->toplevel->iconify});
  $composefilemenu -> add( 'command', -label => 'Close',
			   -accelerator => 'Alt-C',
			   -font => $menufont,
			   -command => sub { $mw -> WmDeleteWindow } );
  &EditMenuItems( $composeeditmenu, ($mw -> Subwidget( 'text' )) );
  my $optionalfields = &OptionalFields( $mw -> Subwidget('text'));
  $optionalfieldsmenu -> AddItems ( @$optionalfields );
  $optionalfieldsmenu -> configure( -font => $menufont );
  $composeeditmenu -> add( 'separator' );
  $composeeditmenu -> add( 'cascade',  -label => 'Insert Field',
			   -state => 'normal', -font => $menufont,
			   -menu => $optionalfieldsmenu );
  return $cm;
}

sub OptionalFields {
  my ($t) = @_;
  return
    [
     [command=>'Bcc:', -command=>sub{insertfield($t,$bccfield)}],
     [command=>'Cc:', -command=>sub{insertfield($t,$ccfield)}],
     [command=>'Fcc:', -command=>sub{insertfield($t,$fccfield)}],
     [command=>'Reply-To:', -command=>sub{insertfield($t,$replytofield)}],
    ]
}

sub insertfield {
  my ($t, $field) = @_;
  my ($point);
  $point = $t -> search( '--', $msgsep, '1.0', 'end' );
  $t -> insert( $point, "$field \n", 'header' );
}

sub composewidgets {
  my ($mw) = @_;
  my $cw = new MainWindow( -title => "New Message" );
  my $ct = $cw -> Scrolled( 'TextUndo', -height => 24,
	 -scrollbars => 'se',
	 -background => 'white',
	 -font => $defaulttextfont,
	 -wrap => 'word',
	 -width => 80 );
  $cw -> Advertise( 'text' => $ct );
  $ct -> tagConfigure( 'header', '-font', $headerfont );
  my $menu = &composemenu( $cw );
  $menu -> pack( -anchor => 'w', -fill => 'x' );
  $ct -> pack( -expand => 1, -fill => 'both' );
  my $c = $cw -> Canvas( -height => 40, -width => 600 );
  $cw -> Advertise( 'canvas' => $c );
  my $servermsg = $c -> createText( 500, 20, -font => $menufont,
				  -text => 'Composing message.',
				  -justify => 'right' );
  $cw -> Advertise( 'servermsg' => $servermsg );
  my $sendbutton = $cw -> Button( -text => 'Send',
				  -font => $menufont,
				  -width => 8,
				  -underline => 0,
				  -command => sub{ sendmsg( $cw, $ct,
							  $c, $servermsg)});
  my $closebutton = $cw -> Button( -text => 'Cancel',
				  -font => $menufont,
				  -width => 8,
				   -underline => 0,
				   -command => sub{ $cw -> WmDeleteWindow});
  my $cdcanv = $c -> createWindow( 55, 18, -window => $sendbutton );
  my $cncanv = $c -> createWindow( 137, 18, -window => $closebutton );
  $c -> pack( -expand => '1', -fill => 'x' );
  $cw -> bind('<Alt-s>',sub{sendmsg( $cw, $ct, $c, $servermsg)});
  $cw -> bind('<Alt-c>',sub{$cw -> WmDeleteWindow });
  $cw -> bind('<Alt-i>',sub{&InsertFileDialog($cw)});
  $cw -> bind('<Alt-w>',sub{$cw -> WmDeleteWindow });
  $cw -> bind( '<Alt-z>', sub{ $cw -> toplevel -> iconify });
  return $cw;
}

sub watchcursor {
  my ($mw) = @_;
  $mw -> Busy( -recurse => '1' );
}

sub defaultcursor {
  my ($mw) = @_;
  $mw -> Unbusy( -recurse => '1' );
}

#
# Need to figure out how to synchronize with X server.
#
#sub browse_url {
#  my ($mw) = @_;
#  require Tk::DialogBox;
#  my $t = $mw -> Subwidget('text');
#  my($line,$col) = split /\./, ($t -> index('insert'));
#  my $url = $t -> get( "$line\.0", ($line+1)."\.0");
#  chomp $url;
#  $url =~ s/^.*(http\:\/\/.*)\s.*/\1/;
#  my $dialog = $mw -> DialogBox( -title => 'Open URL',
#			       -buttons => ['Ok', 'Cancel'],
#			       -default_button => 'Ok');
#  my $urlentry = $dialog -> add( 'Entry',
#			       -textvariable => \$url,
#			       -width => 35 ) -> pack;
#  return if $dialog -> Show !~ /Ok/;
#  my ($retval, $pid);
#  if( $userconfig{'browser'} =~ 'netscape' ) {
#    $retval =
#	system( 'netscape', '-remote', "openURL($url)" );
#    if( $retval =~ /256/msi ) {
#      if($pid = fork) {
#	my $retval = system( 'netscape', $url );
#      }
#    }
##  } elsif( $userconfig{'browser'} =~ /lynx/ ) {
##    if($pid = fork) {
##    $mw ->toplevel->protocol( 'WM_COMMAND' => [\&system, @cmd] );
##    $mw ->toplevel->command( 'xterm', '-e lynx', $url, '&' );
##      $retval = system('xterm', '-e lynx', $url );
##    }
#  }
#}

sub deletetrashfolder {
  my ($mw) = @_;
  eval {
    &watchcursor($mw);
    require Tk::Dialog;
    my $trashdir = $userconfig{trashdir};
    my $dialog = $mw -> Dialog( -title => "Empty Trash",
				-text => "Confirm empty trash?",
				-font => $menufont, -default_button => 'No',
		-bitmap => 'question', -buttons => ['Yes', 'No'] );
    return if ($dialog -> Show) eq 'No';
    opendir MDIR, $trashdir or warn "Could not open $trashdir: $!\n";
    @trashfiles = grep /[^\.]|[^\.][^\.]/, readdir MDIR;
    closedir MDIR;
    foreach (@trashfiles) {
      unlink "$trashdir/$_";
    }
  };
  &defaultcursor($mw);
}

require "getopts.pl";

&readconfig;

$opt_errs = &Getopts("f:hkv");
if ($opt_h || !$opt_errs) {
    print "Usage: ec [-f filename][-hkv]\n";
    print "Download messages from POP host(s) to file.\n\n";
    print "  -f filename        Get server defaults from file filename.\n";
    print "  -h                 Print help file.\n";
    print "  -k                 Keep mail on server (don't delete).\n";
    print "  -v                 Print verbose messages.\n";
    die "\nPlease report bugs to rkiesling\@mainmatter.com.\n";
}

if ($opt_f) {
     if (-f $opt_c) {
 		$serverfilename = $opt_c;
    }
}

if ($opt_v) {
    ($userconfig{verbose}) = 1;
}

if ($opt_k) {
	$keepmails = 1;
}

chop( $ARCH = `uname`);
$LINUX = 1 if $ARCH eq "Linux";

$SIG{'INT'} = 'die_gracefully';
$SIG{'QUIT'} = 'die_gracefully';
$SIG{'TERM'} = 'die_gracefully';

$LFILE = "/tmp/popm.$UID";

#Perl 5 - have to set PATH to known value - security feature
$ENV{'PATH'}="/bin:/usr/bin:/usr/local/bin:/usr/lib:/usr/sbin";

# Get list of sites from configuration file: See above.
$lsites = &get_user_info;

#
# Initialize main window widgets.
#
my $mw = new MainWindow( -title => "Email Client");
my $l = $mw -> Scrolled( 'MListbox',
	 -height => 7,
	 -selectmode => 'single',
	 -bd => 2, -relief => sunken,
	 -width => 80,
       -scrollbars => 'se',
       -columns => [[-text => 'St',
		     -font => $defaulttextfont,
		     -sortable => 0,
		     -background => 'white',
		     -textwidth => 2 ],
		    [-text => 'Date:',
		     -font => $defaulttextfont,
		     -sortable => 0,
		     -background => 'white',
		     -textwidth => $userconfig{datelen}],
		    [-text => 'From:',
		     -sortable => 0,
		     -font => $defaulttextfont,
		     -background => 'white',
		     -textwidth => $userconfig{senderlen}],
		    [ -text => 'Subject:',
		      -sortable => 0,
		      -font => $defaulttextfont,
		      -background => 'white',
		      -textwidth => 80 ]]);
$mw -> Advertise( 'messagelist' => $l );
$l -> {'ml_sort_descending'} = $userconfig{sortdescending};
$datesortorder = $userconfig{sortdescending};
my $t = $mw -> Scrolled( 'TextUndo', -height => 20,
	 -scrollbars => 'se',
	 -wrap => 'word',
	 -background => 'white',
	 -font => $defaulttextfont,
	 -wrap => 'word',
	 -width => 80 );
$mw -> Advertise( 'text' => $t );
$t -> tagConfigure( 'header', -font => $headerfont );
my $c = $mw -> Canvas( -height => 40, -width => 600 );
$mw -> Advertise( 'canvas' => $c );
my $msgcounter = $c -> createText( 500, 15, -font => $menufont,
			       -text => $countertext,
			       -justify => 'right' );
$mw -> Advertise( 'msgcounter' => $msgcounter );
my $servermsg = $c -> createText( 500, 30, -font => $menufont,
				  -text => '',
				  -justify => 'right' );
$mw -> Advertise( 'servermsg' => $servermsg );
my $mb = $mw -> Menu( -type => 'menubar', -font => $menufont );
my $filemenu = $mb -> Menu;
my $editmenu = $mb -> Menu;
my $messagemenu = $mb -> Menu;
my $foldermenu = $mb -> Menu;
$mw -> Advertise( 'foldermenu' => $foldermenu );
my $destfoldermenu = $mb -> Menu;
$mw -> Advertise( 'destfoldermenu' => $destfoldermenu );
my $optionmenu = $mb -> Menu;
my $helpmenu = $mb -> Menu;
my $headerviewmenu = $mb -> Menu;
my $sortfieldmenu = $mb -> Menu;
$mb -> add( 'cascade', -label => 'File', -menu => $filemenu );
$mb -> add( 'cascade', -label => 'Edit', -menu => $editmenu );
$mb -> add( 'cascade', -label => 'Message', -menu => $messagemenu );
$mb -> add( 'cascade', -label => 'Folder', -menu => $foldermenu );
$mb -> add( 'cascade', -label => 'Options', -menu => $optionmenu );
$mb -> add( 'separator' );
$mb -> add( 'cascade', -label => 'Help', -menu => $helpmenu );
$filemenu -> add( 'command', -label => 'Save As...', -state => 'normal',
		  -font => $menufont, -accelerator => 'Alt-S',
		  -command => sub{ SaveFileAsDialog( $mw ) } );
$filemenu -> add( 'command', -label => 'Empty Trash...', -state => 'normal',
		  -font => $menufont,
		  -command => sub{ &deletetrashfolder( $mw ) } );
#$filemenu -> add( 'command', -label => 'Browse URL...',
#		  -state => 'normal', -font => $menufont,
#		  -accelerator => 'Alt-U',
#		  -command => sub{ &browse_url( $mw )});
$filemenu -> add( 'separator' );
$filemenu -> add( 'command', -label => 'Minimize', -state => 'normal',
		  -font => $menufont, -accelerator => 'Alt-Z',
		  -command => sub{$mw->toplevel->iconify});
$filemenu -> add( 'command', -label => 'Close', -state => 'normal',
		  -font => $menufont, -accelerator => 'Alt-W',
		  -command => sub{ quitclient( $mw ) } );
&EditMenuItems($editmenu,($mw -> Subwidget('text')));
$messagemenu -> add( 'command', -label => 'Check Server for Messages',
		     -state => 'normal',
		  -font => $menufont, -accelerator => 'Alt-O',
	  -command => sub{ incoming_poll( $mw,$lsites)});
$messagemenu -> add( 'separator' );
$messagemenu -> add( 'command', -label => 'Compose New Message',
		     -state => 'normal',
		  -font => $menufont, -accelerator => 'Alt-N',
		  -command => sub{ &compose});
$messagemenu -> add( 'command', -label => 'Reply', -state => 'normal',
		  -font => $menufont, -accelerator => 'Alt-R',
		  -command => sub{reply( $mw )});
$messagemenu -> add( 'command', -label => 'Delete', -state => 'normal',
		  -font => $menufont, -accelerator => 'Alt-D',
		  -command => sub{ movemesg( $mw, $userconfig{trashdir} )});
$messagemenu -> add( 'separator' );
$messagemenu -> add( 'command', -label => 'Next Message', -state => 'normal',
		     -font => $menufont, -accelerator => 'Alt-Down',
		     -command => sub{ next_message( $mw )});
$messagemenu -> add( 'command', -label => 'Previous Message',
		     -state => 'normal',
		     -font => $menufont, -accelerator => 'Alt-Up',
		     -command => sub{ previous_message( $mw )});
$messagemenu -> add( 'separator' );
foreach my $fn ( @{$userconfig{folder}} ) {
  my $dirname = $fn;
  $dirname =~ s/.*\/(.*?)$/\1/;
  $destfoldermenu -> add( 'command',-label => ucfirst $dirname,
	      -state => 'normal', -font => $menufont,
	      -command => sub{ movemesg($mw, $fn)});
  $foldermenu -> add( 'command',-label => ucfirst $dirname,
	      -state => 'normal', -font => $menufont,
	      -command => sub{ changefolder($mw, $fn)});
}
$destfoldermenu -> insert( 3, 'separator' );
$foldermenu -> insert( 3, 'separator' );
$messagemenu -> add( 'cascade', -label => 'Move To',  -state => 'normal',
		  -font => $menufont,
		  -menu =>  $destfoldermenu);
$optionmenu -> add( 'cascade', -label => 'View Headers', -state => 'normal',
		  -font => $menufont,
		  -menu =>  $headerviewmenu);
$optionmenu -> add( 'cascade', -label => 'Sort by', -state => 'normal',
		  -font => $menufont,
		  -menu =>  $sortfieldmenu);
$helpmenu -> add( 'command', -label => 'About...', -state => 'normal',
		  -font => $menufont,
		  -command => sub{ &about( $mw ) } );
$helpmenu -> add( 'separator' );
$helpmenu -> add( 'command', -label => 'Help...', -state => 'normal',
		  -font => $menufont, -accelerator => 'F1',
		  -command => sub{ &self_help } );
$helpmenu -> add( 'command', -label => 'Sample .ecconfig File...',
 		  -state => 'normal',
		  -font => $menufont,
		  -command => sub{ &sample('ecconfig') } );
$headeritems = HeaderViews( $mw );
$headerviewmenu -> AddItems( @$headeritems );
$headerviewmenu -> configure( -font => $menufont );
$sortfielditems = SortFields($mw);
$sortfieldmenu -> AddItems( @$sortfielditems );
$sortfieldmenu -> configure( -font => $menufont );
$mb -> pack( -anchor => 'w', -fill => 'x' );

sub HeaderViews {
  my ($w) = @_;
  return [
  [radiobutton => 'Full',
   -variable => \$userconfig{headerview}, -value => 'full',
   -command => sub{redisplaymessage($mw)}],
  [radiobutton => 'Brief',
   -variable => \$userconfig{headerview}, -value => 'brief',
   -command => sub{redisplaymessage($mw)}],
  [radiobutton => 'None',
   -variable => \$userconfig{headerview}, -value => 'none',
   -command => sub{redisplaymessage($mw)}],
	 ];
}

sub SortFields {
  my ($w) = @_;
  return [
  [radiobutton => 'Date',
   -variable => \$userconfig{sortfield}, -value => 1,
   -command => sub{sort_option($w,1)}],
  [radiobutton => 'Sender',
   -variable => \$userconfig{sortfield}, -value => 2,
   -command => sub{sort_option($w,2)}],
  [radiobutton => 'Subject',
   -variable => \$userconfig{sortfield}, -value => 3,
   -command => sub{sort_option($w,3)}],
  [radiobutton => 'None',
   -variable => \$userconfig{sortfield}, -value => 0,
   -command => sub{sort_option($w,0)}],
	 ];
}

$l -> pack( -expand => '1', -fill => 'both', -anchor => 'w'  );
my $deletebutton = $mw -> Button( -text => 'Delete',
				  -font => $menufont,
				  -width => 8,
				  -underline => 0,
		  -command => sub{ movemesg( $mw, $userconfig{trashdir} )});
my $newbutton = $mw -> Button( -text => 'New',
				  -font => $menufont,
				-width => 8,
				-underline => 0,
				  -command => 
			       sub{ compose( $mw ) } );
my $replybutton = $mw -> Button( -text => 'Reply',
				  -font => $menufont,
				-width => 8,
				-underline => 0,
			  -command => sub{ reply( $mw ) } );
my $dcanv = $c -> createWindow( 55, 18, -window => $deletebutton );
my $ncanv = $c -> createWindow( 137, 18, -window => $newbutton );
my $rcanv = $c -> createWindow( 219, 18, -window => $replybutton );
#my $qcanv = $c -> createWindow( 301, 18, -window => $quitbutton );
$l -> Subwidget('yscrollbar') -> configure(-width=>10);
$l -> Subwidget('xscrollbar') -> configure(-width=>10);
$t -> Subwidget('yscrollbar') -> configure(-width=>10);
$t -> Subwidget('xscrollbar') -> configure(-width=>10);
$c -> pack( -expand => '1', -fill => 'x' );
$t -> pack( -expand => '1', -fill => 'both' );
$l -> bindColumns ( '<Button-1>', sub{&sort_column} );
$l -> bindRows( '<Button-1>', sub{ displaymessage( $mw, $currentfolder )});
$mw -> bind('Tk::TextUndo','<3>', '' );
$mw -> bind( '<Alt-w>', sub{ quitclient( $mw ) } );
$mw -> bind( '<Alt-s>', sub{ SaveFileAsDialog($mw) } );
$mw -> bind( '<Alt-d>', sub{ movemesg( $mw, $userconfig{trashdir} ) } );
$mw -> bind( '<Alt-n>', sub{ compose( $mw ) } );
$mw -> bind( '<Alt-r>', sub{ reply( $mw ) } );
$mw -> bind( '<Alt-o>', sub{ incoming_poll($mw,$lsites)});
$mw -> bind( '<F1>', sub{ &self_help });
#$mw -> bind( '<Alt-u>', sub{ &browse_url( $mw )});
$mw -> bind( '<Alt-z>', sub{ $mw -> toplevel -> iconify });
$mw -> bind( '<Alt-Up>', sub{&previous_message( $mw )});
$mw -> bind( '<Alt-Down>', sub{&next_message( $mw )});


sub about {
    my ($mw) = @_;
    my $aboutdialog;
    my $title_text;
    my $version_text;
    my $name_text;
    require Tk::DialogBox;
    $aboutdialog =
      $mw -> DialogBox( -buttons => ["Ok"],
		       -title => 'About' );
    $title_text = $aboutdialog -> add('Label');
    $bug_text = $aboutdialog -> add('Label');
    $version_text = $aboutdialog -> add ('Label');
    $copyright_text = $aboutdialog -> add('Label');
    $title_text -> configure ( -font => $menufont,
	-text => "\nEC Email Client\n Version $VERSION\n" );
    $copyright_text -> configure( -text =>
	       "  Copyright \xa9 2001, <rkiesling\@mainmatter.com>  \n\n" .
	       "Please refer to the file \"Artistic\" in \n" .
	       "the distribution archive for license terms\n",
	      -font => $menufont);
    $title_text -> pack;
    $copyright_text -> pack;
    my $response = $aboutdialog -> Show;
}

sub self_help {
    my $help_text;
    my $helpwindow;
    my $textwidget;

    open  HELP, $userconfig{helpfile}
      or $help_text = "Unable to open help file ".$userconfig{helpfile}.".";
    while (<HELP>) {
	$help_text .= $_;
    }
    close( HELP );

    $helpwindow = new MainWindow( -title => "$appfilename Help" );
    my $textframe = $helpwindow -> Frame( -container => 0,
					  -borderwidth => 1 ) -> pack;
    my $buttonframe = $helpwindow -> Frame( -container => 0,
					  -borderwidth => 1 ) -> pack;
    $textwidget = $textframe
	-> Scrolled( 'Text',
		     -font => $defaulttextfont,
		     -scrollbars => 'e' ) -> pack( -fill => 'both',
						   -expand => 1 );
    $textwidget -> Subwidget('yscrollbar') -> configure(-width=>10);
    $textwidget -> Subwidget('xscrollbar') -> configure(-width=>10);
    $textwidget -> insert( 'end', $help_text );

    $buttonframe -> Button( -text => 'Close',
			    -font => $menufont,
			    -command => sub{$helpwindow -> DESTROY} ) ->
				pack;
}

sub sample {
  my( $f ) = @_;
    my $help_text;
    my $helpwindow;
    my $textwidget;
  my $filename;
  if ( $f =~ /ecconfig/ ) {
    $filename = $cfgfilename;
  } else {
    return;
  }

    open  HELP, $filename
      or $help_text = "Unable to open file $filename.";
    while (<HELP>) {
	$help_text .= $_;
    }
    close( HELP );

    $helpwindow = new MainWindow( -title => "$filename" );
    my $textframe = $helpwindow -> Frame( -container => 0,
					  -borderwidth => 1 ) -> pack;
    my $buttonframe = $helpwindow -> Frame( -container => 0,
					  -borderwidth => 1 ) -> pack;
    $textwidget = $textframe
	-> Scrolled( 'TextUndo',
		     -font => $defaulttextfont,
		     -scrollbars => 'e' ) -> pack( -fill => 'both',
						   -expand => 1 );
    $textwidget -> Subwidget('yscrollbar') -> configure(-width=>10);
    $textwidget -> Subwidget('xscrollbar') -> configure(-width=>10);
    $textwidget -> insert( 'end', $help_text );

    $buttonframe -> Button( -text => 'Close',
			    -font => $menufont,
			    -command => sub{$helpwindow -> DESTROY} ) ->
				pack;
}

# From Tk::Widget, Tk::Text, and Tk::TextUndo.
# $mw -> FillMenu( FileMenuItems );
#
# sub FileMenuItems
# {
#  my ($w) = @_;
#  return [
#    ["command"=>'~Open',    -command => [$w => 'FileLoadPopup']],
#    ["command"=>'~Save',    -command => [$w => 'Save' ]],
#    ["command"=>'Save File ~As', -command => [$w => 'FileSaveAsPopup']],
#    ["command"=>'~Include', -command => [$w => 'IncludeFilePopup']],
#    ["command"=>'~Clear',   -command => [$w => 'ConfirmEmptyDocument']],
#    "-",@{$w->SUPER::FileMenuItems}
#   ]
# }
#

sub EditMenuItems {
  my ($m,$w) = @_;
     $m -> add ( 'command', -label => 'Undo',
				 -state => 'normal',
				 -accelerator => 'Alt-U',
				 -font => $menufont,
				 -command => sub{$w -> undo});
    $m -> add ('separator');
    $m -> add ( 'command', -label => 'Cut', -state => 'normal',
				 -accelerator => 'Alt-X',
				 -font => $menufont,
				 -command => sub{$w -> clipboardCut});
    $m -> add ( 'command', -label => 'Copy', -accelerator => 'Alt-C',
				 -state => 'normal',
				 -font => $menufont,
				 -command => sub{$w -> clipboardCopy});
    $m -> add ( 'command', -label => 'Paste', -accelerator => 'Alt-V',
				 -state => 'normal',
				 -font => $menufont,
				 -command => sub{$w -> clipboardPaste});
    $m -> add ( 'command', -label => 'Select All',
				 -accelerator => 'Ctrl-/',
				 -state => 'normal',
				 -font => $menufont,
			 -command => sub{$w -> selectAll} );
#    $m -> add ('separator');
#    $m -> add( 'command', -label => 'Search & Replace...',
#				  -accelerator => 'Alt-F',
#				 -state => 'normal',
#				 -font => $menufont,
#		 -command => sub{$self -> ws_search} );
#    $m -> add( 'command', -label => 'Repeat Last Search',
#				 -accelerator => 'Alt-G',
#				 -state => 'normal',
#				 -font => $menufont,
#				 -command => sub{$self -> ws_search_again});
}

sub InsertFileDialog
{
 my ($w)=@_;
 my $l;
 my $t = $w -> Subwidget( 'text' );
 my $fs = $mw -> SimpleFileSelect( -directory => $defaultuserdir,
			     -initialfile => $subj,
				 -acceptlabel => 'Insert' );
 my $name = $fs -> Show;
 &watchcursor( $w );
 eval {
   if ( defined($name) and length($name)) {
     $defaultuserdir = $name;
     $defaultuserdir =~ s/(.*)\/.*?$/\1/;
     open IFILE, $name
       or warn "Couldn't open file $name for insert: $!\n";
     while( defined ( $l = <IFILE> ) ) {
       $t -> insert( 'insert', $l );
       $w -> update;
     }
     close IFILE;
     return 1;
   }
 };
 &defaultcursor($w);
 return 0;
}

sub SaveFileAsDialog
{
 my ($mw)=@_;
 my $text = $mw -> Subwidget( 'text' );
 my $l = $mw -> Subwidget( 'messagelist' );
 my $selindex = ($l->curselection)[0];
 my $msg = $text -> get( '1.0', 'end' );
 $subj =~ s/.*Subject:\s?(.*?)$/\1/sm;
 my $fs = $mw -> SimpleFileSelect( -directory => $defaultuserdir,
			     -initialfile => $subj,
				 -acceptlabel => 'Save' );
 my $name = $fs -> Show;
 $l -> selectionSet( $selindex, $selindex ) if $selindex ne '';
 if ( defined($name) and length($name)) {
   &watchcursor($mw);
   eval {
     $defaultuserdir = $name;
     $defaultuserdir =~ s/(.*)\/.*?$/\1/;
     open SAVE, "+>>$name" or
       warn "Can't save message to file $name: $!\n";
     print SAVE $msg;
     close SAVE;
     return 1;
   };
   &defaultcursor($mw);
 }
 return 0;
}

#
#  Poll POP server, and list incoming messages.
#

$currentfolder =       # The folder that is currently being viewed.
$userconfig{incomingdir};
$incomingfolder = $userconfig{incomingdir};
$systemmbox = ($userconfig{mailspooldir})."/$username";
$mailaddress = $username.'@'.$userconfig{maildomain};
$mw -> configure( -title => $currentfolder );

if ( -f $iconpath ) {
  my $icon = $mw -> toplevel -> Pixmap( -file => $iconpath );
  $mw -> toplevel -> iconimage( $icon );
}

# Event updates from window manager;
$SIG{WINCH} = sub{&wm_update($mw)};
sub wm_update {
  my ($mw) = @_;
  $mw->update;
  $SIG{WINCH} = sub{&wm_update($mw)};
}

sub timer_update {
  my ($mw) = @_;
  return if not defined $mw;
  $mw -> update;
  Tk::Event::DoOneEvent(255);
}

$l -> after( 100, sub{ &incoming_poll($mw,$lsites) } );
$mw -> after(100,sub{&timer_update( $mw )});
foreach my $f (@{$userconfig{folder}}) {
  &updatemsgcount($mw,$f);
}

MainLoop;
unlink $LFILE;

=head1 NAME

  ec -- POP/SMTP GUI E-mail client using Perl/Tk.

=head1 SYNOPSIS

  ec [-f filename][-hkv]

=head2  Command Line Options

=over 4

=item -f filename

Use <filename> instead of the default server authentication file.

=item -h

Print help message and exit.

=item -k

Don't delete messages from POP server.

=item -v

Print verbose transcript of dialogs with servers.

=head1 DESCRIPTION

EC is an Internet E-mail reader and composer that can download
incoming messages from one or more POP3 servers, and send mail
directly to a SMTP server, or through sendmail if it's installed.  It
maintains an index of read and unread messages in each of the user's
mailbox folders (refer to Mailbox Configuration, below, and the
comments in the .ecconfig configuration file), and displays the number
of unread and total messages in each folder.  Messages can be moved
from folder to folder, including the trash folder, from which unwanted
messages are permanently deleted after a user-configurable period of
time (seven days is the default).

=head1 CONFIGURATION

The e-mail client expands leading tildes ('~') in file and
path names to the value of the $HOME environment variable,
following the convention of the Unix Bourne shell.  Directory
separators are forward slashes ('/'), so compatibility with
non-Unix file systems depends on the Perl environment to
perform the path name translation.

=head2 Configuration Files

The e-mail client uses two configuration files, .ecconfig and
.servers, which by default reside in the ~/.ec directory.

The .ecconfig file contains user-settable defaults for the program's
operating parameters using <option> <value> statements on each line.
The function of each setting is explained in the .ecconfig file's
comments.

You can edit the .ecconfig file by selecting 'Sample .ecconfig
File...' from the Help menu.  Pressing Button 3 (the right button on
many systems), pops up a menu over the text area. where you can save
your changes.  You must exit and restart EC for the changes to take 
effect.

The .servers file contains the user login name, host name, port
and password for each POP3 and SMTP server.  EC allows incoming
mail retrieval from multiple POP3 servers, but only allows one
SMTP server for sending outgoing mail.  The format of each line
is:

  <server-name> <port> <user-login-name> <password>

If you enter a hyphen, '-', in the password field, then EC
will prompt you for the server's password when the program
first logs on.

In standard configurations, POP3 servers use port 110, and the
single SMTP server uses port 25.

The .servers file must have only user read-write permissions
(0600), otherwise the program complains.  The correct permissions
can be set with the command:

  chmod 0600 .ec/.servers

You must be the file's owner, of course, in order to be able
to re-set the file's permissions.

The '.servers' file is not editable from the Help menu, for reasons
of security.

Note that these files, and the ~/.ec subdirectory, are not visible
in normal directory listings.  To view them, use the '-a' option
with ls.

If necessary, you can change the default names of these files by
editing their assignments in the first few lines of the ec program
itself.

=head2 Mail directories

EC can save messages in any number of user-configurable "folders," or
directories, and it can move messages between the directories with the
Message -> Move To submenu.  By default, the mail folders are 
subdirectories of the <maildir> setting, which is ~/Mail/ by default.
Thus, the subdirectory paths for the 'incoming' and 'trash' folders are
~/Mail/incoming/ and ~/Mail/trash/.  When saving messages elsewhere,
EC defaults to the ~/Mail/ directory.

The 'incoming' and 'trash' folders are required. These directories
must exist before using EC.  The program will not create them on its
own.

All other directories can be configured in the .ecconfig file,
using the 'folder' directive.  You must create the directories
before EC can move messages into them.

=head2 Filters

You can sort incoming mail by matching the text in an
incoming message with a specified pattern.  Each "filter" line
in the .ecconfig file is composed of a text pattern, a double
equals sign, and the folder the mail is to be saved in.  The
format of a filter line in the configuration file is:

  filter <text-pattern>==<folder-directory>

Because the text pattern is used "raw" by Perl, you can use
whatever metacharacters Perl recognizes (refer to the perlre
man page).  Pattern matches are not case sensitive, and the
folder that the pattern matches must exist.

You must 'quote' some characters that are common in E-mail addresses
which Perl recognizes as metacharacters, by preceding them with a
backslash.  These characters include '@', '['. ']', '<', and '>'.
Refer to the example filter definitions in the .ecconfig file.

=head2 MAIL DELIVERY AGENTS

For outgoing mail, EC supports direct connections to the ISP's SMTP
server, as well as delivery via sendmail if it is installed.  In the
.ecconfig file, the "usesendmail" option determines which method is
used.  If it is non-zero, then mail is routed through sendmail;
otherwise, the default is to send mail directly to the ISP's mail
server.  In most cases, either the local sendmail must be configured
to relay messages, or have a "smart host" defined.  Please refer to
the comments in the .ecconfig file, and to the sendmail documentation.

=head1 PRINTING THE DOCUMENTATION IN DIFFERENT FORMATS

It is possible produce this documentation in various formats
using Perl's POD formatting utilities:

  pod2html <ec >doc.html
  pod2latex <ec >doc.tex
  pod2man <ec >doc.man
  pod2text <ec >doc.txt
  pod2usage <ec >doc.msg

Refer to your system's manual pages for instructions of how
to use these utilities.

=head1 LICENSE

EC is freely distributable and modifiable under the terms of
the Perl Artistic License. Please see the file "Artistic" in the
distribution archive.

=head1 VERSION INFO

  $Id: ec,v 0.82 2001/04/14 00:34:06 kiesling Exp $

=head1 CREDITS

  Perl/Tk Version 800.022 by Nick Ing-Simmons.

  Tk::MListbox widget by Hans Jorgen Helgesen.

  The POP server interface is based on:
  POPMail Version 1.6 (RFC1081) Interface for Perl,
      Written by:
      Kevin Everets <flynn@engsoc.queensu.ca>
      Abhijit Kalamkar <abhijitk@india.com>
      Nathan Mahon <vaevictus@socket.net>
      Steve McCarthy <sjm@halcyon.com>
      Sven Neuhaus <sven@ping.de>
      Bill Reynolds <bill@goshawk.lanl.gov>
      Hongjiang Wang <whj@cs-air.com>

=cut
