#!/usr/bin/perl
#################################################################Modules
use strict;
use warnings;
use Cwd;
use Fcntl;
use threads;
use Net::NNTP;
use Date::Parse;
use Date::Format;
use threads::shared;
use Convert::BulkDecoder;
use MLDBM qw(DB_File Storable);
$| = 1;
################################################################Log File
open ('STDERR', '>', 'NewsSurfer.log')                                  #<-todo, add clear log function and retain logs between launches
  or warn "Can not create a log file!\n$!";
############################################################Declarations
our $VERSION = 3.02;
my ($mw, $windowx, $windowy, %shash, %threads, $DEBUG, $RSS,);
#################################################################Threads
warn "Launching thread\n";
foreach my $l qw (
  rss article decode post list die return progress optionCSV
) {
  share($shash{1}{$l});
  $shash{1}{$l} = 0;
}
$threads{1} = threads->new(\&worker, 1);
warn "Thread 1 is active\n";
########################################################Optional Modules
if ($^O eq 'MSWin32') {
  eval    { require Win32::Console; Win32::Console::Free() };
  if ($@) { warn "Win32::Console is not installed.\n$@";   }
}
#RSS Modules
eval { require XML::FeedPP; require LWP::Simple; require Data::Dumper };
if   (! $@) { $RSS = 1; }
#############################################################GUI Modules
use Tk::ResizeButton;
use Tk::ProgressBar;
use Tk::ItemStyle;
use Tk::ROText;
use Tk::HList;
use Tk::Pod;
use Tk;
####################################################################Main
$DEBUG = $ARGV[0] || 0;
$mw = MainWindow->new(
  -title    => 'NewsSurfer',
  -relief   => 'groove',
  -colormap => 'new',
  -bd       => 2,
);

splash();
news_gui();
Tk::MainLoop();
####################################################################Exit
foreach my $k (sort keys %threads) {
  warn "Destroying Thread [$k]\n";
  $shash{$k}{'die'} = 1;
  sleep(1);
}
warn "Exiting..\n";
close STDERR;
exit;
#############################################################Subroutines
sub splash #------------------------------------------------------------
{
  $mw->gridPropagate(0);
  $mw->withdraw;
  
  my ($image, $splash, $canvas,);
  $windowx = $mw->screenwidth;
  $windowy = $mw->screenheight;
  my $x = ($windowx - 500) / 2;
  my $y = ($windowy - 288) / 2;
  my $geometry = '500x288+'.$x.'+'.$y;
  
  {
    my $imagedata = load_image(1);
    $image = $mw->Photo(
      -format => 'gif',
      -data   => $imagedata
    );
  }
  
  $splash = $mw->Toplevel(-takefocus => 1,);
  $splash->overrideredirect(1);
  $splash->geometry($geometry);
  $splash->resizable(0, 0);
  $canvas = $splash->Canvas()->pack(
    -fill   => 'both',
    -expand => 1,
  );
  $canvas->createImage(0,0,
    -image  => $image,
    -anchor => 'nw',
  );
  $splash->update;
  
  $mw->after(12000, sub {
    $splash->destroy;
    $mw->GeometryRequest($windowx,$windowy);
    $mw->Post(-5,-5);
    $mw->update;
  });
  return (1);
}
sub news_gui #----------------------------------------------------------
{
  #Widget Initialization
  our $sort_cnt = 3;
  our $msglimitOption;
  my $sys_bg = $mw->cget(-background);
  my $sys_fg = $mw->cget(-foreground);
  dbmopen(my %OPT, 'settings', '0640')
    || die "Cannot create settings.\n$!";
  unless ($OPT{Mail}) { $OPT{Mail} = 'NewsSurfer@domain.invalid';  }
  unless ($OPT{DDir}) { $OPT{DDir} = '.';                          }
  unless (-e $OPT{DDir} and -d $OPT{DDir}) { $OPT{DDir} = '.';     }
  dbmclose %OPT;
  
  $mw->gridRowconfigure(2,    -weight  => 1,);
  $mw->gridRowconfigure(4,    -minsize => 8,);
  $mw->gridColumnconfigure(1, -weight  => 1,);
  $mw->setPalette(
    background       => '#a1a1a1',
    activebackground => '#a1a1a1',
    activeforeground => '#000fff',
  );
  
  #create frames and panedwindow
  #my($pw1, $f1_main, $f2_main, $f3_main, $f2_tool,);
  my($pw1, $f1_main, $f2_main, $f3_main,);
  {
    $f1_main = $mw->Frame(
      -relief => 'flat',
      -bd     => 2,
    )->grid(
      -in     => $mw,    -column => '1', -padx => '8',
      -sticky => 'news', -row    => '1', -pady => '0',
    );
    $f1_main->gridColumnconfigure(2,  -minsize => 8,);
    $f1_main->gridColumnconfigure(7,  -minsize => 8,);
    $f1_main->gridColumnconfigure(11, -minsize => 8,);
    $f1_main->gridColumnconfigure(14, -weight  => 1,);
    $f2_main = $mw->Frame(
      -relief => 'groove',
      -bd     => 4,
    )->grid(
      -in     => $mw,    -column => '1', -padx => '8',
      -sticky => 'news', -row    => '2', -pady => '0',
    );
    $f2_main->gridRowconfigure(1,     -weight  => 1,);
    $f2_main->gridColumnconfigure(1,  -weight  => 1,);
    $f3_main = $mw->Frame(
      -relief => 'groove',
      -bd     => 2,
    )->grid(
      -in     => $mw,    -column => '1', -padx => '8',
      -sticky => 'news', -row    => '3', -pady => '0',
    );
    $f3_main->gridRowconfigure(1,     -weight  => 1,);
    $f3_main->gridColumnconfigure(1,  -weight  => 1,);
    $pw1 = $f2_main->Panedwindow(
      -orient => 'vertical',
      -relief => 'groove',
      -bd     => 2,
    )->grid(
      -in     => $f2_main, -row    => '1',
      -sticky => 'news',   -column => '1',
    );
  }
  
  #frame 1 (toolbar frame)
  my $logo;
  our @buttons;
  {
    $logo = $mw->Label(
      -text => 'NewsSurfer',
      -font => '{Courier New} 16',
    )->grid(
      -in     => $f1_main, -column => '14',
      -sticky => 'news',   -row    => '1',
    );
    
    my $c = 1;
    foreach my $l qw(
      scan grab read_message post browse group opt show_log help quit
    ) {
      my $sub = \&{ $l; };
      my $w = $f1_main->Button(
        -activebackground   => '#a1a1a1',
        -bd                 => 0,
        -highlightthickness => 0,
        -command            => sub {
          &$sub();
        },
      )->grid(
        -in     => $f1_main, -column => $c,
        -sticky => 'news',   -row    => '1',
      );
      push (@buttons, $w);
      if ($c =~ m/^(1|6|10)$/) { $c++; }
      $c++;
    }
  }
  
  #frame 2 (main display frame)
  #upper Function select
  our $lb1_grp;
  {
    $lb1_grp = $pw1->Scrolled(
      'HList',
      -highlightthickness => 1,
      -columns            => 3,
      -header             => 1,
      -height             => 3,
      -indicator          => 1,
      -indicatorcmd       => sub {},
      -font               => '{Ariel} 8',
      -highlightcolor     => '#000000',
      -scrollbars         => 'ose',
      -background         => '#ffffff',
      -foreground         => '#000000',
      -selectbackground   => '#000000',
      -selectforeground   => '#fff000',
      -selectmode         => 'single',
    );
    my $c = 0;
    foreach my $label ('Group', 'Last Scanned', '',) {
      my $w = $lb1_grp->ResizeButton(
        -widget           => \$lb1_grp,
        -column           => $c,
        -text             => "$label",
        -font             => '{Ariel} 8',
        -activebackground => '#a1a1a1',
        -activeforeground => '#000000',
        -relief           => 'flat',
        -anchor           => 'w',
        -borderwidth      => 0,
        -takefocus        => 0,
        -command          => sub {},
      );
      $lb1_grp->columnWidth($c, -char => '1');
      $lb1_grp->header(
        'create', $c,
        -itemtype         => 'window',
        -headerbackground => '#a1a1a1',
        -widget           => $w,
        -borderwidth      => 1,
      );
      $c++;
    }
    {
      my ($c, @colWidth,);
      if ($windowx >= 800) { @colWidth = (127, 25, ''); }
      else                 { @colWidth = (95, 25, '');  }
      $c = 0;
      foreach my $width (@colWidth) {
        $lb1_grp->columnWidth ($c, -char => $width);
        $c++;
      }
    }
  }
  
  #lower HList
  our($lb2_msg,);
  {
    $lb2_msg = $pw1->Scrolled(
      'HList',
      -highlightthickness => 1,
      -columns            => 6,
      -header             => 1,
      -indicator          => 1,
      -indicatorcmd       => sub {},
      -separator          => '^',
      -scrollbars         => 'ose',
      -highlightcolor     => '#000000',
      -background         => '#ffffff',
      -foreground         => '#000000',
      -selectbackground   => '#000000',
      -selectforeground   => '#fff000',
      -selectmode         => 'extended',
    );
    #lower HList column headers
    my $c = 0;
    foreach my $label (
      'Headers', 'From', 'Parts', 'Bytes', 'Date', ' ',
    ) {
      my $w = $lb2_msg->ResizeButton(
        -widget           => \$lb2_msg,
        -column           => $c,
        -text             => $label,
        -font             => '{Ariel} 8',
        -activebackground => '#a1a1a1',
        -activeforeground => '#000fff',
        -relief           => 'flat',
        -anchor           => 'w',
        -borderwidth      => 0,
        -takefocus        => 0,
        -command          => sub {
          lb2_msg_sort("$label")
      },);
      $lb2_msg->columnWidth($c, -char => '1');
      $lb2_msg->header(
        'create', $c,
        -itemtype         => 'window',
        -headerbackground => '#a1a1a1',
        -widget           => $w,
        -borderwidth      => 1,
      );
      $c++;
    }
    if ($windowx >= 800) {
      $lb2_msg->columnWidth (0, -char => '100');
    }
    else {
      $lb2_msg->columnWidth (0, -char => '68');
    }
    $lb2_msg->columnWidth (1, -char => '10');
    $lb2_msg->columnWidth (2, -char => '7');
    $lb2_msg->columnWidth (3, -char => '10');
    $lb2_msg->columnWidth (4, -char => '25');
    $lb2_msg->columnWidth (5, -char => '');
  }
  
  #frame 3 ('Statusbar frame')
  our($sb_lab,);
  our $sblabel = ' ';
  our $pb      = 0;
  {
    $sb_lab = $mw->Label(
      -text   => "  $sblabel",
      -anchor => 'w',
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $f3_main, -column => '1',
      -sticky => 'ew',     -row    => '1',
    );
    $mw->ProgressBar(
      -relief   => 'sunken',
      -bd       => 2,
      -length   => 270,
      -from     => 0,
      -to       => 100,
      -blocks   => 50,
      -colors   => [0, 'green'],
      -variable => \$pb,
    )->grid(
      -in     => $f3_main, -column => '2',
      -sticky => 'news',   -row    => '1',
    );
  }
  
  #log window
  our($tl1, $txt_log,);
  {
    $tl1 = $mw->Toplevel(
      -title  => 'View Log',
      -relief => 'groove',
      -bd     => 2,
    );
    $tl1->gridRowconfigure(1,    -minsize => 8, -weight => 1,);
    $tl1->gridColumnconfigure(1, -minsize => 8, -weight => 1,);
    $tl1->transient($mw);
    $tl1->withdraw;
    
    my $f = $tl1->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl1, -columnspan => '2',
      -column => '1',  -rowspan    => '1',
      -row    => '1',  -sticky     => 'news'
    );
    $f->gridRowconfigure(1,    -minsize => 8, -weight => 1,);
    $f->gridColumnconfigure(1, -minsize => 8, -weight => 1,);
    
    $txt_log = $f->Scrolled(
      'ROText',
      -scrollbars       => 'se',
      -foreground       => '#ffffff',
      -background       => '#000000',
      -selectforeground => '#fff000',
      -selectbackground => '#000000',
      -wrap             => 'none',
      -relief           => 'flat',
      -bd               => 0,
      -width            => 80,
      -height           => 30,
    )->grid(
      -in     => $f,  -columnspan => '1',
      -column => '1', -rowspan    => '1',
      -row    => '1', -sticky     => 'news'
    );
    $txt_log->tagConfigure('Red',    -foreground => '#ff0000');
    $txt_log->tagConfigure('Blue',   -foreground => '#000fff');
    $txt_log->tagConfigure('Yellow', -foreground => '#fff000');
    {
      my $menu = $txt_log->menu;
      $menu->configure(
        -bg               => $sys_bg,
        -fg               => $sys_fg,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
      );
      $menu->delete('File');
      $menu->delete('Search');
      $menu->delete('View');
    }
    my $c = 1;
    foreach my $label ('C l o s e', 'S a v e',) {
      my $s = 'w';
      if ($c > 1) { $s = 'e' };
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'log_'.lc($sublabel); };
      my $w = $tl1->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          &$sub();
        },
      )->grid(
        -in     => $tl1, -column => $c,
        -sticky => $s,   -row    => '4',
      );
      FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
  }
  
  #post message window
  our($tl2, $txt_post, @post_entries,);
  {
    $tl2 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl2->title('Post Message');
    $tl2->resizable(0, 0);
    $tl2->transient($mw);
    $tl2->withdraw;
    $tl2->gridColumnconfigure(3, -weight => 1,);
    
    my $c = 1;
    foreach my $label ('From:  ', 'Subject:  ',) {
      $tl2->Label(
        -text => $label,
      )->grid(
        -in     => $tl2, -column => '1',
        -sticky => 'e',  -row    => $c,
      );
      my $w = $tl2->Entry(
        -width        => 60,
        -background   => '#ffffff',
        -foreground   => '#000000',
      )->grid(
        -in     => $tl2, -columnspan => '2',
        -column => '2',  -rowspan    => '1',
        -row    => $c,   -sticky     => 'w'
      );
      $c++;
      push (@post_entries, $w);
    }
    
    my $f = $tl2->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl2, -columnspan => '4',
      -column => '1',  -rowspan    => '1',
      -row    => '3',  -sticky     => 'nws'
    );
    $txt_post = $f->Scrolled(
      'Text',
      -scrollbars       => 'se',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -selectforeground => '#fff000',
      -selectbackground => '#000000',
      -relief           => 'flat',
      -wrap             => 'none',
      -height           => 30,
      -width            => 80,
    )->grid(
      -in     => $f,    -column => '1',
      -sticky => 'nws', -row    => '1',
    );
    {
      my $post_menu = $txt_post->menu;
      $post_menu->delete('File');
      $post_menu->delete('Search');
      $post_menu->delete('View');
    }
    $c = 1;
    foreach my $label (
      'C a n c e l    ', 'P o s t    ', 'A t t a c h  a n d  P o s t',
    ) {
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'post_'.lc($sublabel); };
      my $w = $tl2->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub { &$sub(); },
      )->grid(
        -in     => $tl2, -column => $c,
        -sticky => 'w',  -row    => '4',
      );
      FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
  }
  
  #groups subscription window
  our ($tl3, $lb_grp, $grpSubSearch,);
  {
    $tl3 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl3->title('Groups');
    $tl3->geometry("+90+35");
    $tl3->resizable(0, 0);
    $tl3->transient($mw);
    $tl3->withdraw;
    $tl3->gridColumnconfigure(5, -weight => 1,);
    
    my $f = $tl3->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl3, -columnspan => '5',
      -column => '1',  -rowspan    => '1',
      -row    => '2',  -sticky     => 'news'
    );
    $lb_grp = $f->Scrolled(
      'HList',
      -scrollbars         => 'ose',
      -background         => '#000000',
      -foreground         => '#ffffff',
      -selectbackground   => '#fff000',
      -selectforeground   => '#000000',
      -highlightthickness => 0,
      -selectmode         => 'extended',
      -relief             => 'flat',
      -takefocus          => 0,
      -header             => 1,
      -columns            => 2,
      -indicator          => 1,
      -height             => 30,
      -width              => 96,
      -indicatorcmd       => sub {}, #do nothing
    )->grid(
      -in     => $f,     -column => '1',
      -sticky => 'news', -row    => '1',
    );
    $lb_grp ->columnWidth (0, -char => '70');
    $lb_grp ->columnWidth (1, -char => '20');
    $lb_grp ->headerCreate(0, -text => "Newsgroups",);
    $lb_grp ->headerCreate(1, -text => "Message Count",);
    
    $f = $tl3->Frame(
      -relief => 'flat',
    )->grid(
        -in     => $tl3, -column => '1', -columnspan => '5',
        -sticky => 'ew', -row    => '1', -rowspan    => '1',
    );
    $f->gridColumnconfigure(3, -weight => 1,);
    my $e = $tl3->Entry(
      -background   => '#ffffff',
      -foreground   => '#000000',
      -textvariable => \$grpSubSearch,
      -width        => 40,
    )->grid(
      -in     => $f,   -column => '1',
      -sticky => 'ew', -row    => '1',
    );
    $e->bind('<Return>' => sub {
      search($lb_grp, 'GROUP', 0);
    });
    
    my $c = 2;
    foreach my $label (
      'S e a r c h', 'S h o w   A l l   N e w s g r o u p s'
    ) {
      my ($w, $showAll,);
      if ($c > 2) {
        $showAll = 1;
      }
      else {
        $showAll = 0;
      }
      $w = $f->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          search($lb_grp, 'GROUP', $showAll);
        }
      )->grid(
        -in     => $f,   -column => $c,
        -sticky => 'ew', -row    => '1',
      );
      FlashButton($w, '#181830', $sys_fg);
      $c += 2;
    }
    
    $c = 1;
    foreach my $label (
      'C l o s e    ', 'U p d a t e    ', 'S u b s c r i b e    ',
      'U n S u b s c r i b e',
    ) {
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'grp_' . lc($sublabel); };
      my $w = $tl3->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          &$sub();
        },
      )->grid(
        -in     => $tl3, -column => $c,
        -sticky => 'n',  -row    => '3',
      );
      FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
  }
  
  #read message window
  our($tl4, $txt_read,);
  {
    $tl4 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl4->title('Read Message');
    $tl4->transient($mw);
    $tl4->withdraw;
    my $f = $tl4->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl4, -columnspan => '2',
      -column => '1',  -rowspan    => '1',
      -row    => '1',  -sticky     => 'news'
    );
    $txt_read = $f->Scrolled(
      'ROText',
      -scrollbars       => 'se',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -selectforeground => '#fff000',
      -selectbackground => '#000000',
      -wrap             => 'none',
      -relief           => 'flat',
      -width            => 80,
      -height           => 30,
    )->grid(
      -in     => $f,  -columnspan => '1',
      -column => '1', -rowspan    => '1',
      -row    => '1', -sticky     => 'news'
    );
    {
      my $read_menu = $txt_read->menu;
      $read_menu->configure(
        -bg               => $sys_bg,
        -fg               => $sys_fg,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
      );
      $read_menu->delete('File');
      $read_menu->delete('Search');
      $read_menu->delete('View');
    }
    my $c = 1;
    foreach my $label ('C l o s e', 'R e p l y',) {
      my $s = 'w';
      if ($c > 1) { $s = 'e' };
      my $sublabel = $label;
      $sublabel =~ s/
        \s+                         #remove any whitespace in the string
      //xg;
      my $sub = \&{ 'read_'.lc($sublabel); };
      my $w = $tl4->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          &$sub();
        },
      )->grid(
        -in     => $tl4, -column => $c,
        -sticky => $s,   -row    => '4',
      );
      FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
  }
  
  #options window
  our($tl5, $quoteSig, @OPT_widgets,);
  {
    $tl5 = $mw->Toplevel(
      -relief    => 'groove',
      -bd        => 2,
      -takefocus => 1,
    );
    $tl5->title('Options');
    $tl5->geometry("+105+70");
    $tl5->resizable(0, 0);
    $tl5->transient($mw);
    $tl5->withdraw;
    
    my $f = $tl5->Frame(
      -bd     => 3,
      -relief => 'sunken',
      -bg     => '#000000',
    )->grid(
      -in     => $tl5, -column => '1',
      -sticky => 'e',  -row    => '1',
    );
    $f->gridRowconfigure(5,    -minsize => 8,);
    $f->gridRowconfigure(9,    -minsize => 96, -weight => 1,);
    $f->gridColumnconfigure(3, -minsize => 96,);
    
    my $c = 1;
    foreach my $label ('NNTP Server:  ', 'Username:  ',
                       'Password:  ', 'Email:  ',) {
      $f->Label(
        -text       => $label,
        -background => '#000000',
        -foreground => '#ffffff',
        -anchor     => 'e',
        -width      => 15,
      )->grid(
        -in     => $f,   -column => '1',
        -sticky => 'e',  -row    => $c,
      );
      $c++;
    }
    $c = 6;
    foreach my $label ('Download Dir:  ', 'Signature File:  ',) {
      $label =~ m/\b(\w+)\b/;
      my $sub = \&{ 'opt_' . lc($1); };
      my $w = $f->Button(
        -text             => $label,
        -anchor           => 'e',
        -relief           => 'flat',
        -bg               => '#000000',
        -fg               => '#ffffff',
        -activeforeground => '#fff000',
        -activebackground => '#000000',
        -width            => 15,
        -command          => sub { &$sub(); },
      )->grid(
        -in     => $f,  -column => '1',
        -sticky => 'e', -row    => $c,
      );
      FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
    undef $c;
    foreach my $row qw(1 2 3 4 6 7) {
      my $w = $f->Entry(
        -width        => 32,
        -background   => '#ffffff',
        -foreground   => '#000000',
      )->grid(
        -in     => $f,  -column => '2',
        -sticky => 'w', -row    => $row,
      );
      if ($row >= 3) {
        if    ($row == 3) { $w->configure(-show => '*',); }
        elsif ($row >= 6) { $w->configure(-width => 64,); }
      }
      push (@OPT_widgets, $w);
    }
    
    my $w;
    $w = $f->Checkbutton(
      -foreground       => '#ffffff',
      -background       => '#000000',
      -activeforeground => '#ffffff',
      -activebackground => '#000000',
      -selectcolor      => '#000000',
      -variable         => \$quoteSig,
    )->grid(
      -in     => $f,   -column => 1,
      -sticky => 'e',  -row    => 8,
    );
    push (@OPT_widgets, $w);
    
    $w = $f->Label(
      -text => 'Quote signatures in reply message.',
      -background => '#000000',
      -foreground => '#ffffff',
    )->grid(
      -in     => $f,   -column => 2,
      -sticky => 'w',  -row    => 8,
    );
    $w = $tl5->Button(
      -text             => 'C l o s e  &  S a v e',
      -relief           => 'flat',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -command          => sub { opt_close(); }
    )->grid(
      -in     => $tl5, -column => '1',
      -sticky => 'w',  -row    => '2',
    );
    FlashButton($w, '#181830', $sys_fg);
  }
  
  #help window
  our($tl6, $txt_help,);
  {
    $tl6 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl6->title('Help');
    $tl6->geometry("+93+70");
    $tl6->resizable(0, 0);
    $tl6->transient($mw);
    $tl6->withdraw;
    $tl6->gridColumnconfigure(2, -weight => 1,);
    
    my $f = $tl6->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl6,   -column => '1', -columnspan => '3',
      -sticky => 'news', -row    => '1',
    );
    $txt_help = $f->Scrolled(
      'ROText',
      -scrollbars       => 'oe',
      -background       => '#000000',
      -foreground       => '#ffffff',
      -selectbackground => '#000000',
      -selectforeground => '#fff000',
      -wrap             => 'none',
      -relief           => 'flat',
      -width            => 80,
      -height           => 20,
    )->grid(
      -in     => $f,     -column => '1',
      -sticky => 'news', -row    => '1',
    );
    $txt_help->menu(undef);
    
    my $c = 1;
    foreach my $label ('C l o s e', 'A b o u t',) {
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'help_' . lc($sublabel); };
      my $w = $tl6->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub { &$sub(); }
      )->grid(
        -in     => $tl6, -column => $c,
        -sticky => 'n',  -row    => '2',
      );
      FlashButton($w, '#181830', $sys_fg);
      $c += 2;
    }
  }
  
  #group right click menu
  our($tl7,);
  {
    $tl7 = $mw->Toplevel(
      -title       => 'group_rc_menu',
      -relief      => 'raised',
      -borderwidth => 2.5,
    );
    $tl7->overrideredirect(1);
    $tl7->resizable(0, 0);
    $tl7->transient($mw);
    $tl7->withdraw;
    
    my $f = $tl7->Frame(
      -relief    => 'sunken',
      -bd        => '1.5',
      -takefocus => '1',
    )->grid(
      -in     => $tl7,   -column => '1',
      -sticky => 'news', -row    => '1',
    );
    $f->gridRowconfigure(3, -minsize => 2,);
    $f->gridRowconfigure(5, -minsize => 2,);
    $f->bind('<Leave>' => sub {
      $tl7->withdraw;
    });
    $f->Frame(
      -relief => 'groove',
      -bd     => 8,
    )->grid(
      -in     => $f,     -column => 1,
      -sticky => 'news', -row    => 3,
    );
    $f->Frame(
      -relief => 'groove',
      -bd     => 2,
    )->grid(
      -in     => $f,     -column => 1,
      -sticky => 'news', -row    => 5,
    );
    $f->Button(
      -text             => 'Scan',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        scan();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 1,
    );
    $f->Button(
      -text             => 'Load',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        message_load();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 2,
    );
    $f->Button(
      -text             => 'Search',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          =>  sub {
        search_popup();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 4,
    );
    $f->Button(
      -text             => 'Clear',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        message_clear();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 6,
    );
    $f->Button(
      -text             => 'Reset',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        $lb1_grp->focus;
        rset_cmd();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 7,
    );
    $f->Button(
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -text             => 'Remove',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
      $lb1_grp->focus;
      grp_unsubscribe('X');
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 8,
    );
  }
  
  #message right click menu
  our($tl8,);
  {
    $tl8 = $mw->Toplevel(
      -title       => 'message_rc_menu',
      -relief      => 'raised',
      -borderwidth => 2.5,
    );
    $tl8->overrideredirect(1);
    $tl8->resizable(0, 0);
    $tl8->transient($mw);
    $tl8->withdraw;
    
    my $f = $tl8->Frame(
      -relief    => 'sunken',
      -bd        => 1.5,
      -takefocus => 1,
    )->grid(
      -in     => $tl8,   -column => 1,
      -sticky => 'news', -row    => 1,
    );
    $f->bind('<Leave>' => sub {
      $tl8->withdraw;
    });
    $f->Button(
      -text             => 'Read',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        read_message();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 1,
    );
    $f->Button(
      -text             => 'Grab',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        grab();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 2,
    );
    $f->Button(
      -text             => 'Grab&Open',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        grab(1);
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 3,
    );
    $f->Button(
      -text             => 'SelectAll',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        lb2_msg_select_all();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 4,
    );
    $f->Button(
      -text             => 'Delete',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        $lb2_msg->focus;
        message_delete();
    })->grid(
      -in     => $f,  -column => 1,
      -sticky => 'n', -row    => 5,
    );
  }
  
  #message download window
  our($tl9, $l1_msgs, $e1_msgs, $dlnew,);
  {
    $tl9 = $mw->Toplevel(
      -relief    => 'groove',
      -bd        => 2,
    );
    $tl9->title('Download Messages');
    $tl9->geometry("+220+160");
    $tl9->resizable(0, 0);
    $tl9->transient($mw);
    $tl9->withdraw;
    $tl9->gridColumnconfigure(4, -minsize => 64, -weight => 1,);
    
    my $f = $tl9->Frame(
      -bg     => '#000000',
      -relief => 'sunken',
      -bd     => 3,
    )->grid(
      -in     => $tl9, -columnspan => 4,
      -column => 1,    -rowspan    => 1,
      -row    => 1,    -sticky     => 'w',
    );
    $f->gridRowconfigure(4,    -minsize => 100,);
    $f->gridColumnconfigure(4, -minsize => 32, -weight  => 1,);
    $l1_msgs = $f->Label(
      -text   => '',
      -bg     => '#000000',
      -fg     => '#ffffff',
    )->grid(
      -in     => $f,  -columnspan => 3,
      -column => 1,   -rowspan    => 1,
      -row    => 1,   -sticky     => 'w',
    );
    $f->Label(
      -text => 'Enter the number of messages to be downloaded:  ',
      -bg   => '#000000',
      -fg   => '#ffffff',
    )->grid(
      -in     => $f, -padx   => 0, -columnspan => 2,
      -column => 1,  -pady   => 8,
      -row    => 2,  -sticky => 'w',
    );
    $f->Label(
      -text => 'Newest messages only (mark the rest read).',
      -bg   => '#000000',
      -fg   => '#ffffff',
    )->grid(
      -in     => $f, -padx   => 0,
      -column => 2,  -pady   => 0,
      -row    => 4,  -sticky => 'nw',
    );
    $e1_msgs = $f->Entry(
      -bg               => '#ffffff',
      -fg               => '#000000',
      -selectbackground => '#000000',
      -selectforeground => '#fff000',
      -width            => 6,
    )->grid(
      -in     => $f,  -padx   => 0,
      -column => 3,   -pady   => 8,
      -row    => 2,   -sticky => 'w',
    );
    $f->Checkbutton(
      -variable         => \$dlnew,
      -activeforeground => '#000000',
      -activebackground => '#000000',
      -foreground       => '#000000',
      -background       => '#000000',
      -selectcolor      => '#ffffff',
    )->grid(
      -in     => $f,  -padx   => '0',
      -column => '1', -padx   => '0',
      -row    => '4', -sticky => 'ne',
    );
    my $c = 1; my $sticky = 'w';
    foreach my $label ('O k', 'C a n c e l',) {
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $w = $tl9->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          $msglimitOption = uc($sublabel);
        },
      )->grid(
        -in     => $tl9, -column => $c,
        -sticky => 'e',  -row    => '2',
      );
      FlashButton($w, '#181830', $sys_fg);
      $c += 3;
    }
  }
  
  #Search group popup
  our($tla,);
  {
    $tla = $mw->Toplevel();
    $tla->title('Search Group');
    $tla->geometry("+250+200");
    $tla->resizable(0, 0);
    $tla->transient($mw);
    $tla->withdraw;
    $tla->gridColumnconfigure(1, -weight  => 1,);
    
    my $f = $tla->Frame(
      -bd     => 3,
      -relief => 'sunken',
      -bg     => '#000000',
    )->grid(
      -in     => $tla,   -column => '1', -columnspan => '2',
      -sticky => 'news', -row    => '1', -rowspan    => '1',
    );
    $tla->Label(
      -text   => 'To clear previous search results, '.
                 'perform an empty search.'."\n\n\n\n",
      -bg     => '#000000',
      -fg     => '#ffffff',
    )->grid(
      -in     => $f,     -column => '1',
      -sticky => 'news', -row    => '1',
    );
    my $e = $tla->Entry(
      #$grpSubSearch is shared with the groups window
      -textvariable => \$grpSubSearch,
      -bg           => '#ffffff',
      -fg           => '#000000',
      -relief       => 'sunken',
      -bd           => 2,
    )->grid(
      -in     => $tla,   -column => '1',
      -sticky => 'news', -row    => '2',
    );
    $e->bind('<Return>' => sub {
      search($lb2_msg);
    });
    my $w = $tla->Button(
      -text             => 'S e a r c h',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -command => sub {
        search($lb2_msg);
      }
    )->grid(
      -in     => $tla, -column => '2',
      -sticky => '',   -row    => '2',
    );
    FlashButton($w, '#181830', $sys_fg);
  }
  #$pw1->add($f2_tool, $lb2_msg,);
  $pw1->add($lb1_grp, $lb2_msg,);
  
  #Bindings
  $tl2->protocol(WM_DELETE_WINDOW => \&post_cancel);
  $tl3->protocol(WM_DELETE_WINDOW => \&grp_close);
  $tl4->protocol(WM_DELETE_WINDOW => \&read_close);
  $tl9->protocol(WM_DELETE_WINDOW => \&dlmsgs_cancel);
  $tl1->protocol(WM_DELETE_WINDOW => sub {$tl1->withdraw;});
  $tl5->protocol(WM_DELETE_WINDOW => sub {$tl5->withdraw;});
  $tl6->protocol(WM_DELETE_WINDOW => sub {$tl6->withdraw;});
  $tla->protocol(WM_DELETE_WINDOW => sub {$tla->withdraw;});
  $logo->bind('<ButtonPress-1>'   => sub {
    $logo->configure(-text=>'');$mw->update;$mw->after(200);
    $logo->configure(-text=>'N');$mw->update;$mw->after(180);
    $logo->configure(-text=>'Ne');$mw->update;$mw->after(130);
    $logo->configure(-text=>'New');$mw->update;$mw->after(120);
    $logo->configure(-text=>'News');$mw->update;$mw->after(160);
    $logo->configure(-text=>'NewsS');$mw->update;$mw->after(130);
    $logo->configure(-text=>'NewsSu');$mw->update;$mw->after(100);
    $logo->configure(-text=>'NewsSur');$mw->update;$mw->after(120);
    $logo->configure(-text=>'NewsSurf');$mw->update;$mw->after(130);
    $logo->configure(-text=>'NewsSurfe');$mw->update;$mw->after(110);
    $logo->configure(-text=>'NewsSurfer');$mw->update;$mw->after(100);
  });
  $lb1_grp ->bind('<ButtonPress-3>' => sub {
    raise_rc_menu($tl7);
  });
  $lb1_grp->bind('<Delete>'=> sub {
    b4_grp_unsubscribe('X');
  });
  $lb2_msg ->bind('<ButtonPress-3>' => sub {
    my @sel = $lb2_msg->selectionGet;
    if ($sel[1]) {
      raise_rc_menu($tl8);
    }
    else {
      $lb2_msg->Tk::HList::ButtonRelease_1;
      raise_rc_menu($tl8, $lb2_msg);
    }
  });
  $lb2_msg ->bind('<Control-Return>' => sub {
    b2_grab_cmd(1);
  });
  $lb2_msg->bind('<Double-ButtonPress-1>' => \&read_message);
  $lb1_grp->bind('<Double-ButtonPress-1>' => \&message_load);
  $lb1_grp->bind('<Return>'               => \&scan);
  $lb1_grp->bind('<Control-c>'            => \&message_clear);
  $lb1_grp->bind('<Control-C>'            => \&message_clear);
  $lb1_grp->bind('<Control-x>'            => \&rset_cmd);
  $lb1_grp->bind('<Control-X>'            => \&rset_cmd);
  $lb2_msg->bind('<Delete>'               => \&message_delete);
  $lb2_msg->bind('<Return>'               => \&read_message);
  $lb2_msg->bind('<Control-a>'            => \&lb2_msg_select_all);
  $lb2_msg->bind('<Control-A>'            => \&lb2_msg_select_all);
  $lb2_msg->bind('<Shift-End>'            => \&lb2_msg_select_end);
  $lb2_msg->bind('<Shift-Home>'           => \&lb2_msg_select_hom);
  $lb2_msg->bind('<Control-d>'            => \&message_delete);
  $lb2_msg->bind('<Control-D>'            => \&message_delete);
  {
    my $c = 10;
    foreach my $b (@buttons) {
      #bind images onto buttons
      MainButtons($b, $c);
      $c++
    }
  }
  
  #Defaults
  foreach my $p (glob 'part*.pt') {                                     #todo - recovery
    unlink $_ || warn "Unable to delete part:  [$p]\n$!";
  }
  warn 'Warning - NewsSurfer has started.  (' . localtime() . "}\n";
  $sblabel = 'Ready';
  $msglimitOption = 0;
  display_groups();
  $lb1_grp->focus();
  
  #Callbacks
  #sub toolBar #---------------------------------------------------------
  #{
  #  #'Email', 'Newsgroups', 'RSS',
  #  my $cmd = uc ($_[0]) || return (0);
  #  my ($c, @lb1_headers,);
  #  
  #  if ($cmd eq 'NEWSGROUPS') {
  #    #Newsgroup mode
  #    @lb1_headers = ('Group', 'Last Scanned', '',);
  #    #Display NNTP subscriptions
  #    display_groups();
  #    $lb1_grp->focus();
  #  }
  #  elsif ($cmd eq 'RSS') {
  #    #RSS mode
  #    $mw->Busy(-recurse => 1);
  #    @lb1_headers = ('URL', 'Last Updated', '',);
  #    #Display RSS URL's
  #    display_rss();
  #    $mw->Unbusy;
  #  }
  #  else {
  #    #Error
  #    return (0);
  #  }
  #  $c = 0;
  #  foreach my $label (@lb1_headers) {
  #    my $w = $lb1_grp->ResizeButton(
  #      -widget           => \$lb1_grp,
  #      -column           => $c,
  #      -text             => "$label",
  #      -font             => '{Ariel} 8',
  #      -activebackground => '#a1a1a1',
  #      -activeforeground => '#000000',
  #      -relief           => 'flat',
  #      -anchor           => 'w',
  #      -borderwidth      => 0,
  #      -takefocus        => 0,
  #      -command          => sub {},
  #    );
  #    $lb1_grp->columnWidth($c, -char => '1');
  #    $lb1_grp->header(
  #      'create', $c,
  #      -itemtype         => 'window',
  #      -headerbackground => '#a1a1a1',
  #      -widget           => $w,
  #      -borderwidth      => 1,
  #    );
  #    $c++;
  #  }
  #  {
  #    my ($c, @colWidth,);
  #    if ($windowx >= 800) {
  #      @colWidth = (115, 25, '');
  #    }
  #    else {
  #      @colWidth = (95, 25, '');
  #    }
  #    $c = 0;
  #    foreach my $width (@colWidth) {
  #      $lb1_grp->columnWidth ($c, -char => $width);
  #      $c++;
  #    }
  #  }
  #  return (1);
  #}
  #sub display_rss #-----------------------------------------------------
  #{
  #  my ($URLs, $lb1_k1, $lb1_k2, $lb1_r1, $c,);
  #  
  #  $lb1_grp->delete('all');
  #  $lb1_k1 = $lb1_grp->ItemStyle('text',
  #    -anchor           => 'w',
  #    -selectforeground => '#fff000',
  #    -background       => '#ffffff',
  #    -foreground       => '#000000',
  #    -font             => '{Arial} 8',
  #  );
  #  $lb1_r1 = $lb1_grp->ItemStyle('text',
  #    -anchor           => 'w',
  #    -selectforeground => '#fff000',
  #    -background       => '#ffffff',
  #    -foreground       => '#f01010',
  #    -font             => '{Arial} 8',
  #  );
  #  $lb1_k2 = $lb1_grp->ItemStyle('text',
  #    -anchor           => 'e',
  #    -selectforeground => '#fff000',
  #    -background       => '#ffffff',
  #    -foreground       => '#000000',
  #    -font             => '{Arial} 8',
  #  );
  #  
  #  open (FH, '<', 'NewsSurfer_RSS.ini')
  #    or die "Cannot open NewsSurfer_RSS.ini\n$!";
  #  while (my $url = (<FH>)) {
  #    if ($url =~ m/^$/ || $url =~ m/^#/) {
  #      next;
  #    }
  #    else {
  #      chomp ($url);
  #      $c++;
  #    }
  #    $lb1_grp->add($c);
  #    if (fetchRSS($url)) {
  #      $lb1_grp->itemCreate($c, 0,
  #        -text  => $url,
  #        -style => $lb1_k1,
  #      );
  #    }
  #    else {
  #      $lb1_grp->itemCreate($c, 0,
  #        -text  => $url . ' (unreachable)',
  #        -style => $lb1_r1,
  #      );
  #    }
  #    $lb1_grp->itemCreate($c, 1,
  #      -text  => 'todo',
  #      -style => $lb1_k2,
  #    );
  #    $mw->update;
  #  }
  #  close FH or die "Cannot close NewsSurfer_RSS.ini\n$!";
  #  return (1);
  #}
  #sub fetchRSS #--------------------------------------------------------
  #{
  #  my $url = $_[0] || return (0);
  #  my ($xml, $rssContent,);
  #  my $lb2_b1 = $lb2_msg->ItemStyle('text',
  #    -anchor           => 'e',
  #    -selectforeground => '#fff000',
  #    -background       => '#ffffff',
  #    -foreground       => '#0000ff',
  #    -font             => '{Arial} 8',
  #  );
  #  my $lb2_b2 = $lb2_msg->ItemStyle('text',
  #    -anchor           => 'w',
  #    -selectforeground => '#fff000',
  #    -background       => '#ffffff',
  #    -foreground       => '#0000ff',
  #    -font             => '{Arial} 8',
  #  );
  #  
  #  #Get RSS URL
  #  if ($rssContent = get($url)) {
  #    #Parse RSS
  #    eval { $xml = XML::FeedPP->new($rssContent) };
  #    if (! $@) {
  #      my (%file, $tmp, $c,);
  #      tie %file, 'RSSDB', "rssfile", O_CREAT|O_RDWR, '0640'
  #        or error('RSSDB', 'DIE',);
  #      
  #      #Save RSS header to DB
  #      $tmp = $file{RSSDB};
  #      $tmp->{$url} = $xml;
  #      $file{RSSDB} = $tmp;
  #      undef $tmp;
  #      untie %file;
  #      
  #      #Display RSS header
  #      $c = 0;
  #      foreach my $rssHeader ( $xml->get_item() ) {
  #        $lb2_msg->add($c);
  #        my $counter = 0;
  #        foreach my $tag qw(title pubDate link) {
  #          my $output = $rssHeader->$tag() || '-';
  #          if ($counter == 2) { $counter = 0; }
  #          else               { $counter++;   }
  #          $lb2_msg->itemCreate($c, $counter,
  #            -itemtype => 'text',
  #            -style    => $lb2_b2,
  #            -text     => $output,
  #          );
  #          $c++;
  #        }
  #        if ($DEBUG) {
  #          print "\n" . '-'x79 . "\nXMLDATA:\n";
  #          print Dumper ($rssHeader);
  #          print "\n";
  #        }
  #        $mw->update;
  #      }
  #    }
  #    else {
  #      warn "Error processing URL: [$url]\n$!";
  #      return (0);
  #    }
  #  }
  #  else {
  #    warn "Error downloading URL: [$url]\n$!";
  #    return (0);
  #  }
  #  return (1);
  #}
  sub nntpconnect #-----------------------------------------------------
  {
    #Called whenever a connection to the server needs to be established
    my($nntp, $serv, $user, $pass,);
    eval {
      dbmopen(my %OPT, 'settings', '0640')
        || die "Cannot create settings.\n$!";
      $serv = $OPT{Serv};
      $user = $OPT{User};
      $pass = $OPT{Pass};
      dbmclose %OPT
    };
    if (! $@) {
      #db access ok, try to connect
      foreach my $c (1..3) {
        warn "Connection attempt: [$c of 3]\n";
        
        undef $nntp;
        $nntp = Net::NNTP->new(
          $serv,
          Debug   => 1,
          Timeout => 5,
        );
        if (! $nntp) {
          if ($c > 2) {
            #could not connect
            warn "Error - Can't connect to server: [" . $serv . "]\n";
            error('login');
            return (0);
          }
          else {
            #wait 1 second and then try again (up to 3 retries)
            my $a = $c + 1;
            warn "Error - Can't connect to server: [" . $serv . "]\n";
            warn "Connection attempt: [$a of 3]\n";
            update_status("Connection attempt: [$a of 3]");
            $mw->after(1000);
            next;
          }
        }
        else {
          #connected
          last;
        }
      }
    }
    else {
      #error accessing db, not connected
      warn "DB error: [$@]\n";
      return (0);
    }
    #connection ok, authenticate user
    if (! defined $user) {
      $user = 'anonymous';
    }
    if (! defined $pass) {
      $pass = "\n";
    }
    eval { $nntp->authinfo($user, $pass) };
    if ($@) {
      error('login');
      return (0);
    }
    elsif (! $nntp) {
      error('login');
      return (0);
    }
    #authenticated, return a reference to the nntp object
    return (\$nntp);
  }
  sub scan #------------------------------------------------------------
  {
    #called from a button pressed in the main window or rc menu
    my (@sel,);
    
    #clear old newsgroup's display
    $mw->Busy(-recurse => 1);
    $lb2_msg->focus;
    $lb2_msg->delete('all');
    $mw->update;
    
    #determine which newsgroup to scan
    @sel = $lb1_grp->selectionGet;
    if (defined $sel[0]) {
      my ($group, $nntpRef,);
      $group = $lb1_grp->itemCget($sel[0], 0, -text);
      
      #connect to nntp server
      update_status('Connecting to NNTP server...');
      update_status('4', 'PROGRESSBAR');
      $nntpRef = nntpconnect();
      
      if($nntpRef) {
        #determine article number range available on the server
        my($dlmsg, $totmsgs, $rng, @nfo,);
        update_status('Scanning newsgroup...');
        update_status('4', 'PROGRESSBAR');
        @nfo = $$nntpRef->group($group);
        if ($nfo[1]) {
          shift @nfo;
          pop   @nfo;
          $totmsgs = $nfo[1] - $nfo[0]; $totmsgs++;
          $dlmsg   = $nfo[1] - $nfo[0]; $dlmsg++;
          
          #load group db and determine which headers to download next.
          if (-e "$group.grp") {
            update_status('Removing expired articles...');
            update_status('4', 'PROGRESSBAR');
            tie my %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
              or error('MLDBM', 'DIE',);
            
            #remove expired articles
            my $tmp = $file{HEADERDB};
            while (my $k = each %$tmp) {
              #k is a message number of a previously downloaded message
              #remove messages that are no longer on the server
              if ($k < $nfo[0]) {
                delete $tmp->{$k};
              }
            }
            
            #determine the new article range
            my(@keys, $last,);
            update_status('4', 'PROGRESSBAR');
            @keys = (keys %$tmp);
            @keys = sort {$b <=> $a} @keys;
            $last = $keys[0] || 0;
            warn "last messageID downloaded is:  [$last]\n";
            warn "first new messageID is:        [$nfo[1]]\n";
            $last++;
            
            #save to db
            $file{HEADERDB} = $tmp;
            undef $tmp;
            untie %file;
            
            #check for new messages
            if ($last <= $nfo[1]) {
              #there are new messages in the newsgroup
              undef $rng;
              unless($last == 1) {
                shift @nfo;
                unshift (@nfo, "$last");
              }
              $totmsgs = $nfo[1] - $nfo[0]; $totmsgs++;
              $dlmsg   = $nfo[1] - $nfo[0]; $dlmsg++;
              warn "There are $totmsgs new messages on the server\n";
              
              #enforce maximum message download limit
              unless($totmsgs < 5000) {
                my $r = msglimit($totmsgs);
                if ($r == 0) {
                  $$nntpRef->quit();
                  $dlmsg = 0;
                }
                elsif ($dlnew == 1) {
                  $nfo[0] = $nfo[1] - $r;
                  $dlmsg = $nfo[1] - $nfo[0];
                }
                else {
                  $nfo[1] = $nfo[0] + $r;
                  $dlmsg = $nfo[1] - $nfo[0];
                }
              }
            }
            else {
              #there are no new messages on the newsgroup
              warn "No new messages...\n";
              update_status('No new messages...');
              undef $dlmsg;
              #load old messages
              displayheaders('OLD');
            }
          }
          else {
            #Newly subscribed or reset group; create a new db.
            warn "Creating a new db for $group\n";
            update_status('Initializing newsgroup...');
            update_status('4', 'PROGRESSBAR');
            unless($totmsgs < 5000) {
              #popup d/l messages
              my $r = msglimit($totmsgs);
              warn "Message download limit set to:  [$r]\n";
              if ($r == 0)        { $dlmsg = 0;             }
              elsif ($dlnew == 1) { $nfo[0] = $nfo[1] - $r; }
              else                { $nfo[1] = $nfo[0] + $r; }
              $dlmsg = $nfo[1] - $nfo[0];
            }
          }
          if ($dlmsg) {
            $rng = \@nfo;
            
            #download xover into %xover, then disconnect
            update_status("Downloading $dlmsg of $totmsgs new headers");
            update_status('16', 'PROGRESSBAR');
            my($href, %xover);
            $href = $$nntpRef->xover($rng);                             #<-blocks
            if ($href) {
              %xover = %$href;
              undef $href;
              #(%xover is a HoA) $_ is msgnum
              #$xover{$_}[0] #subject #$xover{$_}[4] #references
              #$xover{$_}[1] #from    #$xover{$_}[5] #bytes
              #$xover{$_}[2] #date    #$xover{$_}[6] #lines *parts*
              #$xover{$_}[3] #msg-id  #$xover{$_}[7] #xref:full *read*
            }
            else {
              #try to reconnect
              warn "Warning - retrying header download...\n";
              update_status('retrying header download...');
              eval { $$nntpRef->quit };
              $nntpRef = nntpconnect();
              if ($$nntpRef) {
                $$nntpRef->group($group);
                $href = $$nntpRef->xover($rng);                         #<-blocks
                if (defined $href) {
                  %xover = %$href;
                  undef $href;
                }
                else {
                  error('connect');
                }
              }
              else {
                error('connect');
              }
            }
            if (keys %xover) {
              #handle multipart messages
              update_status('Preparing messages...');
              my (%file, $tmp,);
              my $subj_sav = ' ';
              my $c = 0;
              tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
                || error('MLDBM', 'DIE',);
              $tmp = $file{MULTIPARTDB};
              while (my $k = each %xover) {
                if ($pb >= 100) {$pb = 0;                              }
                if ($c   > 500) {for(1..1){$pb++; $c = 0; $mw->update;}}
                else            {$c++;                                 }
                if ($xover{$k}[0] =~ m/
                  (\p{Any}+) #the main subject $1
                  [\(\[\{]+? #followed by a ( or [ or {
                  (\d+)      #followed by a digit $2
                  [\/\-]+?   #followed by a foward slash or dash
                  (\d+)      #followed by a digit $3
                  [\)\]\}]+? #followed by a ) or ] or }
                  (\p{Any}*) #additional subject text $4
                             #$1 = sub, $2 = pt, $3 = tot, $4 = more sub
                  /gx) {
                  #it is a multipart message
                  my $newsubj;
                  $newsubj = $1.$4;
                  $newsubj =~ s/ #validate subject
                    ~::~/        #replace this
                    ____         #with this
                  /x;
                  
                  #record multipart message ids
                  $tmp->{$newsubj}{$2} = $xover{$k}[3];
                  
                  #combine parts for display, update subject
                  if ($1 ne $subj_sav) {
                    $subj_sav     = $1;       #it is a new subject
                    $xover{$k}[6] = $3;       #parts total
                    $xover{$k}[0] = $newsubj; #edited subject
                  }
                  else {
                    #seen this subject already
                    delete $xover{$k};
                  }
                }
                else {
                  #not a multipart message
                  $xover{$k}[6] = 1;
                }
              }
              $file{MULTIPARTDB} = $tmp;
              undef $tmp;
              
              #remove multipart duplicates and log new message ids
              update_status('Combining parts...');
              update_status('16', 'PROGRESSBAR');
              my %seen;
              while (my $k = each %xover) {
                if ($xover{$k}) {
                  if ($xover{$k}[6] != 1) {
                    my $l;
                    $l = $xover{$k}[0] . $xover{$k}[1] . $xover{$k}[6];
                    #    subject         from            parts
                    if (defined $seen{$l}) {
                      delete $xover{$k};
                    }
                    $seen{$l} = 1;
                  }
                }
              }
              undef %seen;
              
              #count headers, format the time/date, remove old headers
              update_status('Formatting Time/Date...');
              update_status('16', 'PROGRESSBAR');
              while (my $k = each %xover) {
                my $now   = time;
                my $epoch = str2time($xover{$k}[2]);
                my $age   = $now - $epoch;
                if ($age < 2592000 or $k == $nfo [1]) {
                  chomp($xover{$k}[2] = ctime($epoch));
                }
                else {
                  delete $xover{$k}
                }
              }
              
              #save new headers to group header db
              my $newheadercount = 0;
              update_status('Saving Group...');
              update_status('16', 'PROGRESSBAR');
              $tmp = $file{HEADERDB};
              while (my $messagenumber = each %xover) {
                for my $c (0..7) {
                  $tmp->{$messagenumber}[$c] = $xover{$messagenumber}[$c];
                }
                $newheadercount++;
              }
              $file{HEADERDB} = $tmp;
              undef $tmp;
              untie %file;
              
              #display messages
              warn "Displaying [$newheadercount] new messages\n";
              update_status('Displaying messages...');
              update_status('4', 'PROGRESSBAR');
              displayheaders('NEW', $newheadercount);
              
              #update last scanned time
              dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
                || die "Cannot create sbscribe.\n$!";
              my $stime;
              chomp ($stime = ctime(time));
              $SBSCRIBE{"$group"} = "$stime";
              dbmclose %SBSCRIBE;
            }
          }
        }
        else {
          #unable to get group information from server
        }
        $$nntpRef->quit();
      }
      else {
        #could not connect to server
      }
    }
    else {
      #no group selected to scan
      error('scan_1');
    }
    
    #cleanup gui
    display_groups();
    $lb2_msg->focus;
    if ($sel[0]) { $lb1_grp->selectionSet($sel[0]) };
    ready();
    return (1);
  }
  sub msglimit #--------------------------------------------------------
  {
    #called from sub scan
    my $totmsgs = $_[0] || 'NULL';
    $dlnew = 0;
    
    my $ret;
    $ret = dlmsgs('PROMPT', $totmsgs);
    $ret = dlmsgs($ret, $totmsgs);
    #return number of messages to be downloaded to the scan subroutine
    return ($ret);
  }
  sub dlmsgs #----------------------------------------------------------
  {
    #called from sub msglimit
    my $opt     = uc($_[0])     || 'NULL';
    my $totmsgs = $_[1]         || 'NULL';
    my $maxdl   = $e1_msgs->get || '5000';
    $e1_msgs->delete(0, 'end');
    $e1_msgs->insert(0, $maxdl);
    
    if ($opt eq 'PROMPT') {
      $l1_msgs->configure(-text => "There are more than $totmsgs ".
                                   'unread messages in this group.');
      $tl9->Popup;
      $e1_msgs->focus;
      $mw->update;
      $mw->Unbusy;
      $mw->waitVariable(\$msglimitOption);                #wait for user
      $mw->Busy(-recurse => 1);
      return ($msglimitOption);
    }
    elsif ($opt eq 'OK') {
      if ($maxdl =~ m/\D/)      { $maxdl = 0;        }
      elsif ($maxdl > $totmsgs) { $maxdl = $totmsgs; }
      $tl9->withdraw;
    }
    elsif ($opt eq 'CANCEL') {
      $maxdl = 0;
      $tl9->withdraw;
    }
    else {
      warn "ERROR - Invalid dlmsgs option:  [$opt]\n$!";
      $mw->destroy;
    }
    return ($maxdl);
  }
  sub displayheaders #--------------------------------------------------
  {
    #called from subs scan and message_load
    #when opt1 is set to 'NEW' then opt2 should specify # of new msgs
    my $opt1 = uc($_[0]) || 'OLD';
    my $opt2 = $_[1]     || 0;
    my(%file, $lb2_k1, $lb2_k2, $lb2_b1, $lb2_b2, $chek, $group, @sel);
    
    #determine which newsgroup is selected
    @sel = $lb1_grp->selectionGet;
    if (defined $sel[0]) {
      $group = $lb1_grp->itemCget($sel[0], 0, -text);
    }
    else {
      warn "Warning - No valid group selected for header display\n";
      return (0);
    }
    
    #prepare display
    {
      my $imagedata = load_image(2);
      $chek = $mw->Photo(
        -format => 'bmp',
        -data   => $imagedata
      );
    }
    $lb2_b1 = $lb2_msg->ItemStyle('text',
      -anchor           => 'e',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#0000ff',
      -font             => '{Arial} 8',
    );
    $lb2_b2 = $lb2_msg->ItemStyle('text',
      -anchor           => 'w',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#0000ff',
      -font             => '{Arial} 8',
    );
    $lb2_k1 = $lb2_msg->ItemStyle('text',
      -anchor           => 'e',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -font             => '{Arial} 8',
    );
    $lb2_k2 = $lb2_msg->ItemStyle('text',
      -anchor           => 'w',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -font             => '{Arial} 8',
    );
    
    #load group db
    tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
      or error('MLDBM', 'DIE',);
    my $tmp = $file{HEADERDB};
    
    #display headers                                                    #TODO -
    my $cnt = my $c = 0;                                                #discussion threads
    for (1..10) { $pb++; $mw->update; }
    foreach my $k (reverse sort keys %$tmp) {
      if ($pb >= 100) { $pb = 0;                                   }
      if ($c  > 100)  { for(1..10) { $pb++; $mw->update; $c = 0; } }
      else            { $c++;                                      }
      $cnt++;
      if ($opt1 eq 'NEW' && $cnt <= $opt2) {
        $lb2_msg->add($k);
        my $counter = 0;
        foreach my $headerportion (0, 1, 6, 5, 2,) {
          if ($counter < 2) {
            $lb2_msg->itemCreate($k, $counter,
              -itemtype => 'text',
              -style    => $lb2_b2,
              -text     => $tmp->{$k}[$headerportion],
            );
          }
          else {
            $lb2_msg->itemCreate($k, $counter,
              -itemtype => 'text',
              -style    => $lb2_b1,
              -text     => $tmp->{$k}[$headerportion],
            );
          }
          $counter++;
        }
      }
      else {
        $lb2_msg->add($k);
        my $counter = 0;
        foreach my $headerportion (0, 1, 6, 5, 2,) {
          if ($counter < 2) {
            $lb2_msg->itemCreate($k, $counter,
              -itemtype => 'text',
              -style    => $lb2_k2,
              -text     => $tmp->{$k}[$headerportion],
            );
          }
          else {
            $lb2_msg->itemCreate($k, $counter,
              -itemtype => 'text',
              -style    => $lb2_k1,
              -text     => $tmp->{$k}[$headerportion],
            );
          }
          $counter++;
        }
        #mark message as old
        $tmp->{$k}[8] = 1;
      }
      if ($tmp->{$k}[7] eq 'read') {
        $lb2_msg->indicator('create', $k,
          -itemtype => 'image',
          -image    => $chek
        );
      }
      ##mark message as old
      #$tmp->{$k}[8] = 1;
    }
    $file{HEADERDB} = $tmp;
    undef $tmp;
    untie %file;
    return (1);
  }
  sub message_load #----------------------------------------------------
  {
    #called from the main window, rc menu, or sub message_clear
    my($group, $return,);
    update_status('Loading newsgroup...');
    $mw->Busy(-recurse => 1);
    $lb2_msg->focus;
    $mw->update;
    
    #load messages
    $lb2_msg->delete('all');
    for (1..10) { $pb++; $mw->update; }
    my $ret = displayheaders('OLD');
    if ($ret) { $return = 1; }
    else      { $return = 0; }
    
    ready();
    $lb2_msg->focus;
    $mw->update;
    return ($return);
  }
  sub message_clear #---------------------------------------------------
  {
    #called from the rc menu
    my ($group, @sel, @paths, %file,);
    update_status('Clearing previously scanned messages from group...');
    $mw->Busy(-recurse => 1);
    $mw->update;
    
    #get a list of paths for the message hlist
    lb2_msg_select_all();
    @paths = $lb2_msg->infoSelection;
    unless ($paths[0]) {
      my $ret = displayheaders('OLD');
      if ($ret) {
        lb2_msg_select_all();
        @paths = $lb2_msg->infoSelection;
      }
      else {
        warn "Error - Unable to clear group\n";
        ready();
        $mw->Unbusy;
        return (0);
      }
    }
    
    #determine group
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected to clear.\n";
      ready();
      return (0);
    }
    
    #open the selected groups' DB file
    if (-e "$group.grp") {
      tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
        or error('MLDBM', 'DIE',);
      
      #select this groups HEADERDB table
      my $tmp = $file{HEADERDB};
      
      #clear the selected group, and update it's HEADERDB
      my $c = 1;
      foreach my $path (@paths) {
        unless ($path == $paths[0]) {
          $lb2_msg->delete('entry', $path);
          delete $tmp->{$path};
          if ($c == 100) {
            $mw->update;
            undef $c;
          }
          $c++;
        }
      }
      $file{HEADERDB} = $tmp;
      
      #delete this groups' MULTIPARTDB
      delete $file{MULTIPARTDB};
    }
    
    #close the DB file and finish up
    untie %file;
    ready();
    return (1);
  }
  sub lb2_msg_sort #----------------------------------------------------
  {
    #called from a button pressed in the main window
    my $caller = uc($_[0]) || ' ';
    my(@sel, $group, @y, $imagedata, $chek, %file, $c, $col, $opt,);
    
    if ($caller eq ' ')          { return (1);          }
    elsif ($caller eq 'HEADERS') { $col = 0; $opt = 1; }
    elsif ($caller eq 'FROM')    { $col = 1; $opt = 1; }
    elsif ($caller eq 'PARTS')   { $col = 6; $opt = 2; }
    elsif ($caller eq 'BYTES')   { $col = 5; $opt = 2; }
    elsif ($caller eq 'DATE')    { $col = 2; $opt = 3; }
    else {
      warn "Error - Invalid sort option:  [$caller]\n";
      return (0);
    }
    
    $sort_cnt++;
    $mw->Busy(-recurse => 1,);
    $lb2_msg->delete('all');
    update_status ('Sorting...');
    $imagedata = load_image(2);
    $chek = $mw->Photo(
      -format => 'bmp',
      -data   => $imagedata
    );
    undef $imagedata;
    
    #load group header db
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for sort.\n";
      $mw->Unbusy;
      return (0);
    }
    tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
      or error('MLDBM', 'DIE',);
    my $tmp = $file{HEADERDB};
    
    #sort
    if ($sort_cnt % 2) {
      if ($opt == 1) {
        @y = sort{
          $tmp->{$b}[$col] cmp $tmp->{$a}[$col]
        }keys %$tmp;
      }
      elsif ($opt == 2) {
        @y = sort{
          $tmp->{$b}[$col] <=> $tmp->{$a}[$col]
        }keys %$tmp;
      }
      else {
        @y = sort{
          str2time($tmp->{$b}[$col]) <=> str2time($tmp->{$a}[$col])
        }keys %$tmp;
      }
    }
    else {
      if ($opt == 1) {
        @y = sort{
          $tmp->{$a}[$col] cmp $tmp->{$b}[$col]
        }keys %$tmp;
      }
      elsif ($opt == 2) {
        @y = sort{
          $tmp->{$a}[$col] <=> $tmp->{$b}[$col]
        }keys %$tmp;
      }
      else {
        @y = sort{
          str2time($tmp->{$a}[$col]) <=> str2time($tmp->{$b}[$col])
        }keys %$tmp;
      }
    }
    
    #re-populate
    my $blackEast = $lb2_msg->ItemStyle(
      'text',
      -selectforeground => '#fff000',
      -bg               => '#ffffff',
      -fg               => 'black',
      -anchor           => 'e',
      -font             => '{Arial} 8',
    );
    my $blackWest = $lb2_msg->ItemStyle(
      'text',
      -selectforeground => '#fff000',
      -bg               => '#ffffff',
      -fg               => 'black',
      -anchor           => 'w',
      -font             => '{Arial} 8',
    );
    my $blueEast = $lb2_msg->ItemStyle(
      'text',
      -selectforeground => '#fff000',
      -bg               => '#ffffff',
      -fg               => 'blue',
      -anchor           => 'e',
      -font             => '{Arial} 8',
    );
    my $blueWest = $lb2_msg->ItemStyle(
      'text',
      -selectforeground => '#fff000',
      -bg               => '#ffffff',
      -fg               => 'blue',
      -anchor           => 'w',
      -font             => '{Arial} 8',
    );
    
    $c = 0;
    foreach my $k (@y) {
      if ($c > 100) { $mw->update; $c = 0; }
      else          { $c++ }
      
      my($lb2_k1, $lb2_k2,);
      if ($tmp->{$k}[8]) {
        $lb2_k1 = $blackEast;
        $lb2_k2 = $blackWest;
      }
      else {
        $lb2_k1 = $blueEast;
        $lb2_k2 = $blueWest;
      }
      
      $lb2_msg->add($k);
      $lb2_msg->itemCreate($k, 0,
        -itemtype => 'text',
        -style    => $lb2_k2,
        -text     => $tmp->{$k}[0]
      );
      $lb2_msg->itemCreate($k, 1,
        -itemtype => 'text',
        -style    => $lb2_k2,
        -text     => $tmp->{$k}[1]
      );
      $lb2_msg->itemCreate($k, 2,
        -itemtype => 'text',
        -style    => $lb2_k1,
        -text     => $tmp->{$k}[6]
      );
      $lb2_msg->itemCreate($k, 3,
        -itemtype => 'text',
        -style    => $lb2_k1,
        -text     => $tmp->{$k}[5]
      );
      $lb2_msg->itemCreate($k, 4,
        -itemtype => 'text',
        -style    => $lb2_k1,
        -text     => $tmp->{$k}[2]
      );
      if ($tmp->{$k}[7] eq 'read') {
        $lb2_msg->indicator('create', $k,
        -itemtype => 'image',
        -image    => $chek
        );
      }
    }
    
    untie %file;
    ready();
    return (1);
  }
  sub grab #------------------------------------------------------------
  {
    #called from a button in the main window or the rc menu
    my $open = $_[0] || '0';
    my (%file, @sel, @grabs, $group,);
    $mw->Busy(-recurse => 1);
    $pb = 0;
    
    #grab what?
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for grab.\n";
      ready();
      return (0);
    }
    $lb2_msg->focus;
    @grabs = $lb2_msg->selectionGet;
    unless ($group and @grabs) {
      warn "Selection error\n";
      $mw->Unbusy;
      ready();
      return (0);
    }
    
    #load group multipart db (%multi is a HoHoA) subj->part = msg id
    tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
      or error('MLDBM', 'DIE',);
    
    #get selection(s)
    foreach my $article (@grabs) {
      my($subje, $parts, @art, $aref, $treturn,);
      for(1..4) { $pb++; $mw->update; }
      $mw->after(500);
      
      #read subject
      $subje = $lb2_msg->itemCget($article, 0, -text);
      $parts = $lb2_msg->itemCget($article, 2, -text);
      
      #lookup subject
      if (defined $parts && $parts > 1) {
        #Multipart message
        my $tmp     = $file{MULTIPARTDB}{$subje};
        my $parttot = keys %$tmp;
        my @parts   = sort(keys %$tmp);
        my $msgIDs;
        my $partNum;
        
        #fixes: part 0 nfo files in messages
        if ($parttot == $parts + 1) { $partNum = 0; }
        else                        { $partNum ++;  }
        
        #prepare options to provide to the thread
        my $msgID = ' ';
        foreach my $msgID (@parts) {
          $msgIDs .= $tmp->{$msgID} . ',';
        }
        $msgID = substr ($msgID, 1);
        
        #launch thread, download parts
        $shash{1}{optionCSV} = '0,' . $partNum . ',' . $msgIDs;
        $shash{1}{progress}  = 1;
        $shash{1}{article}   = 1;
        $mw->after(500);
        while ($shash{1}{article} == 1) {
          #wait for the thread, update gui
          update_status(
            "Downloading... ($shash{1}{progress} of $parttot)"
          );
          if ($pb >= 100) { $pb  = 0;   }
          else            { $pb += .01; }
          $mw->update;
        }
        $treturn = $shash{1}{return};
      }
      else {
        #singlepart message
        my @a = ($article);
        for(1..5) { $pb += 5; $mw->update; }
        update_status('Downloading message...');
        
        #Launch thread
        $shash{1}{optionCSV} = $group . ",1,@a";
        $shash{1}{article}   = 1;
        while ($shash{1}{article} == 1) {
          if ($pb >= 100) { $pb  = 0;   }
          else            { $pb += .01; }
          $mw->update;
        }
        $treturn = $shash{1}{return};
      }
      
      #If the message was downloaded ok, then start up the decoder
      if ($treturn) {
        my ($res, $cvt, $ret,);
        $mw->after(500);
        update_status('Decoding attachment...');
        warn "Decoding attachment(s)\n";
        $pb++;
        
        #launch thread
        $shash{1}{decode} = 1;
        while ($shash{1}{decode} == 1) {
          if ($pb >= 100) { $pb  = 0;   }
          else            { $pb += .01; }
          $mw->update;
        }
        $ret = $shash{1}{return};
        
        if ($ret) {
          #mark read; load and update group header db
          my($tmp, $chek,);
          $tmp = $file{HEADERDB};
          $tmp->{$article}[7] = 'read';
          $file{HEADERDB} = $tmp;
          {
            my $imagedata = load_image(2);
            $chek = $mw->Photo(
              -format => 'bmp',
              -data   => $imagedata
            );
          }
          $lb2_msg->indicator(
            'create', $article,
            -itemtype => 'image',
            -image    => $chek
          );
          $mw->update;
          
          #open it?
          if ($open == 1) {
            my $cwd = cwd;
            my($dir, $file) = split('\*', $ret);
            if ($^O eq 'MSWin32') {
              chdir ($dir);
              system('start', '/B', $file);
              chdir ($cwd);
            }
            else {
              chdir ($dir);
              system($file);
              chdir ($cwd);
            }
          }
        }
        else {
          #Could not decode attachment, try the next message
          warn "Could not decode attachment\n$!";
        }
      }
      else {
        #Missing some or all parts, try the next message
        warn "Will not be able to decode this attachment\n";
        warn "The message is missing some or all of it's parts\n$!";
      }
    }
    untie %file;
    ready();
    return (1);
  }
  sub message_delete #--------------------------------------------------
  {
    #called from the rc menu
    my($group, @sel, %file,);
    $mw->Busy(-recurse => 1,);
    update_status('Deleting selected messages...');
    
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for message delete.\n";
      ready();
      $mw->Unbusy;
      return (0);
    }
    
    $lb2_msg->focus;
    @sel = $lb2_msg->selectionGet;
    unless ($sel[0]) {
      ready();
      $mw->Unbusy;
      return (0);
    }
    
    #load group header db
    if (-e "$group.grp") {
      tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
        or error('MLDBM', 'DIE',);
    }
    else {
      ready();
      $mw->Unbusy;
      return (0);
    }
    
    my $tmp = $file{HEADERDB};
    #delete selected messages from screen and group header db
    foreach my $msgnum (@sel) {
      $lb2_msg->hide('entry', $msgnum);
      delete $tmp->{$msgnum};
    }
    $file{HEADERDB} = $tmp;
    $lb2_msg->selectionClear;
    $mw->update;
    
    untie %file;
    ready();
    return (1);
  }
  sub read_message #----------------------------------------------------
  {
    #called from a button pressed in the main window or the rc menu
    my (@sel, $group,);
    $mw->Busy(-recurse => 1,);
    update_status('Connecting to server...');
    
    #determine which group
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for message read.\n";
      ready();
      return (0);
    }
    
    #determine which article
    @sel = $lb2_msg->selectionGet;
    $lb2_msg->focus;
    if (! $group || ! $sel[0]) {
      ready();
      return (0);
    }
    else {
      #Connect to server
      my ($nntpRef, $msg,);
      $nntpRef = nntpconnect();
      if (! $nntpRef) {
        warn "Retrying connection...\n";
        $nntpRef = nntpconnect();
        if (! $nntpRef) {
          warn "Error - Unable to connect to server, try again\n";
          ready();
          return (0);
        }
      }
      #download message
      update_status('Downloading message...');
      
      #launch thread, download article                                  #<-test
      $shash{1}{optionCSV} = $group . ',1,' . $sel[0];
      $shash{1}{article}   = 1;
      update_status('Downloading message');
      while ($shash{1}{article} == 1) {
        #wait for the thread, update gui
        if ($pb >= 100) { $pb  = 0;   }
        else            { $pb += .01; }
        $mw->update;
      }
      
      #check return, read and display downloaded message file
      my $treturn = $shash{1}{return};
      if ($treturn) {
        #read message header and determine encoding (max 128 lines)
        my ($headerLineCount, $blankLineAt, $encoding, $qp,);
        open (FH, '<', 'part1.pt') || warn "Can't open part1.pt\n$!";
        while (my $l = (<FH>)) {
          #determine if we are still in the header
          $headerLineCount++;
          if ($l =~ m/^$/) {
            #this line is blank
            $blankLineAt = $headerLineCount;
            if ($blankLineAt = $headerLineCount - 1) {
              #the last line was blank also (indicates end of header)
              last;
            }
          }
          #determine encoding used for this message
          if ($l =~ m/Content-Transfer-Encoding:\s+(.+)/) {
            #record specified encoding
            $encoding = $1;
            if ($encoding eq 'quoted-printable') { $qp = 1; }
            last;
          }
          elsif ($headerLineCount > 128) {
            #extra long header? (sanity check)
            last;
          }
        }
        if (!defined $encoding) { $encoding = 'UNKNOWN'; }
        warn "DEBUG - $encoding encoding detected\n";
        close FH || warn "Can't close part1.pt";
        
        #read message
        open (FH, '<', 'part1.pt') || warn "Can't open part1.pt\n$!";
        while (my $l = (<FH>)) {
          #check if quoted printable encoding was detected
          if ($qp) {
            #decode quoted printable
            #The following is borrowed from the module
            #MIME::QuotedPrint::Perl created by: Gisle Aas
            $l =~ s/\r\n/\n/g;     # normalize newlines
            $l =~ s/[ \t]+\n/\n/g; # rule #3 (trailing space deleted)
            $l =~ s/=\n//g;        # rule #5 (soft line breaks)
            if (ord('A') == 193) {                # EBCDIC style machine
              if (ord('[') == 173) {
                $l =~ s/=([\da-fA-F]{2})/Encode::encode('cp1047',
                Encode::decode('iso-8859-1',pack("C", hex($1))))/gex;
              }
              elsif (ord('[') == 187) {
                $l =~ s/=([\da-fA-F]{2})/Encode::encode('posix-bc',
                Encode::decode('iso-8859-1',pack("C", hex($1))))/gex;
              }
              elsif (ord('[') == 186) {
                $l =~ s/=([\da-fA-F]{2})/Encode::encode('cp37',
                Encode::decode('iso-8859-1',pack("C", hex($1))))/gex;
              }
            }
            else {                                 # ASCII style machine
              $l =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
            }
          }
          elsif ($l =~ s/[A-F]\<(.*)\>/$1/) {
            #handle (remove for now) odd 'tin-like' formatting tags     <-todo
          }
          
          #display message
          $txt_read->insert('end', $l);
          $mw->update;
        }
        close FH || warn "Can't close part1.pt";
      }
      else {
        #error downloading message
        update_status('Could not download article from server');
        warn "Could not download the article\n";
        $mw->update;
        $mw->after(1000);
        ready();
        return (0);
      }
    }
    
    #mark message as read, load and update group header db, update gui
    {
      my ($tmp, %file, $imagedata, $chek,);
      tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
        or error('MLDBM', 'DIE',);
      $tmp = $file{HEADERDB};
      $tmp->{$sel[0]}[7] = 'read';
      $file{HEADERDB} = $tmp;
      untie %file;
      
      $txt_read->focus;
      $tl4->update;
      $tl4->deiconify();
      $tl4->raise();
      $mw->update;
      $imagedata = load_image(2);
      $chek = $mw->Photo(
        -format => 'bmp',
        -data   => $imagedata
      );
      undef $imagedata;
      $lb2_msg->indicator('create', $sel[0],
        -itemtype => 'image',
        -image    => $chek
      );
    }
    ready();
    return (1);
  }
  sub read_close #------------------------------------------------------
  {
    #called from a button pressed in the read window
    $txt_read->delete("1.0", 'end');
    $tl4->withdraw;
    $tl4->configure(-title => 'Read Message');
    $mw->update;
    return (1);
  }
  sub read_reply #------------------------------------------------------
  {
    #called from a button pressed in the read window
    my($c, $txt, @tmp, $refs, $mid, $subj);
    $mw->Busy(-recurse => 1);
    
    #read message
    $txt = $txt_read->get('1.0', 'end');
    @tmp = split('\n', $txt);
    undef $txt;
    $txt_read->delete("1.0", 'end');
    $tl4->withdraw;
    
    dbmopen(my %OPT, 'settings', '0640')
      || die "Cannot create settings.\n$!";
    my $QSig = $OPT{QSig};
    dbmclose %OPT;
    
    #process header, and quote message
    $c = 0;
    foreach my $line (@tmp) {
      #look for blank lines (delimits header)
      unless ($line =~ m/(.+)/) {
        $c++;
      }
      if ($c >= 1) {
        #found blank lines, start quoting everything from here
        if ($line =~ m/^--\s*$/) {
          #found signature
          if ($QSig) {
            $txt .= '> '.$line."\n";
          }
          else {
            last;
          }
        }
        else {
          #quote message line
          $txt .= '> '.$line."\n";
        }
      }
      else {
        #process header
        if ($line =~ m/^References:\s+(.+)/) {
          $refs   = $1;
          #warn "gotref, refs is $refs\n";
        }
        elsif ($line =~ m/^Message-ID:\s+(.+)/) {
          $mid = $1;
          #warn "gotmid, mid is $mid\n";
        }
        elsif ($line =~ m/^Subject:\s+(.+)/) {
          my $a    = $1;
          if ($a =~ m/[Rr][Ee]:.*/) { $subj = $a;       }
          else                      { $subj = "Re: $a"; }
          #warn "gotsubj, subj is $subj\n";
        }
      }
    }
    if ($mid) {
      $refs .= $mid
    };
    
    #save references, so the send function can craft the header
    dbmopen(%OPT, 'settings', '0640') ||
      die "Cannot create settings.\n$!";
    $OPT{Refs} = $refs;
    $post_entries[0]->delete('0', 'end');
    $post_entries[1]->delete('0', 'end');
    $post_entries[0]->insert('end', $OPT{Mail});
    $post_entries[1]->insert('end', $subj);
    dbmclose %OPT;
    
    #populate then display the reply window
    my $typed;
    my @sel = $lb2_msg->selectionGet;
    $typed  = $lb2_msg->itemCget($sel[0], 1, -text);
    $typed .= " wrote in message-id:  $mid\n";
    $txt_post->insert('end', "$typed\n");
    $txt_post->insert('end', "$txt");
    $mw->Unbusy;
    post();
    return (1);
  }
  sub post #------------------------------------------------------------
  {
    #called from a main button, rc menu, or read_reply
    my($from,);
    my @sel = $lb1_grp->selectionGet;
    my $group;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for message post.\n";
      return (0);
    }
    {
      dbmopen(my %OPT, 'settings', '0640')
        || die "Cannot read settings.\n$!";
      $from = $OPT{Mail};
      dbmclose %OPT
    }
    $post_entries[0]->delete('0', 'end');
    $post_entries[0]->insert('end', $from);
    
    $tl2->deiconify();
    $tl2->raise();
    $txt_post->focus;
    $mw->update;
    return (1);
  }
  sub post_post #-------------------------------------------------------
  {
    #called from a button pressed in the post window or sub post_attach
    my $atch     = $_[0] || 0;
    my $cur      = $_[1] || 1;
    my $tot      = $_[2] || 1;
    my $filename = $_[3] || ' ';
    my (@sel, $msg, $hdr, $bdy, $subj, $from, $refs, $sign, $group,);
    
    #determine group
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for posting to.\n";
      return (0);
    }
    $mw->update;
    $mw->Busy(-recurse => 1,);
    update_status('Formatting message...');
    for (1..4) { $pb++; $mw->update; }
    
    #gather message information, update subject header
    #subject should not contain (#/#), it should look like below
    #[Comment1] "filename" yEnc (partnum/numparts) [size] [Comment2]
    $subj = $post_entries[1]->get();
    $from = $post_entries[0]->get();
    $subj =~ s/\(\d+\/\d+\)//g;
    {
      dbmopen(my %OPT, 'settings', '0640')
        || die "Cannot read settings.\n$!";
      unless ($sign)      { $sign = 0;                   }
      unless ($subj)      { $subj = 'No Subject';        }
      unless ($OPT{Refs}) { $OPT{Refs} = 0;              }
      if ($atch)          { $subj .= ' "'.$filename.'" '.
                                     "yEnc ($cur/$tot)"; }
      $refs = $OPT{Refs};
      $sign = $OPT{Sig};
      $OPT{Refs} = 0;                                                   #<-test
      dbmclose %OPT;
    }
    
    #create header
    if ($refs) {
      $hdr = 'From: '."$from\n".
             'Newsgroups: '."$group\n".
             'Distribution: '."world\n".
             'References: '."$refs\n".
             'X-NNTPclient: '."NewsSurfer v3.01\n".
             'X-CreatedBy: '." Just another Perl hacker, \n".
             'Subject: '."$subj\n\n";
    }
    else {
      $hdr = 'From: '."$from\n".
             'Newsgroups: '."$group\n".
             'Distribution: '."world\n".
             'X-NNTPclient: '."NewsSurfer v3.01\n".
             'X-CreatedBy: '." Just another Perl hacker, \n".
             'Subject: '."$subj\n\n";
    }
    $msg = $hdr."\n";
    
    #attach body and signature to first article only
    if ($cur == 1) {
      $bdy  = $txt_post->get("1.0", 'end');
      if ($sign) {
        #attach signature to body
        my (@sig,);
        if (open ('FH', '<', $sign)) {
          @sig = (<FH>);
          close FH;
          $bdy .= "\n--\n";
          #'four lines after the double dash space'
          foreach my $line (@sig) {
            chomp $line;
            $bdy .= "$line\n";
          }
        }
        else {
          error('sig1')
        }
      }
      $msg .= $bdy."\n";
    }
    if ($atch) {
      #attach file part to article
      $msg .= $atch."\n";
    }
    
    #connect, post message, and disconnect
    update_status('Posting message...');
    for (1..4) { $pb += 4; $mw->update; }
    my $nntpRef = nntpconnect();
    if($nntpRef) {
      my $bool = $$nntpRef->post([$msg]);                               #<-blocks
      unless ($bool) {
        warn "Error - Unable to post message, could not post.\n";
      }
    }
    else {
      warn "Error - Unable to post message, could not connect\n";
    }
    $$nntpRef->quit;
    
    #finish up
    ready();
    if ($cur == $tot) {
      post_cancel();
    }
    return (1);
  }
  sub post_yenc #-------------------------------------------------------
  {
    my $aref = $_[0] || return (0);
    my (@in, @out, $linesize,);
    update_status('Encoding attachment...');
    for (1..4) { $pb++; $mw->update; }
    @in = @$aref;
    undef $aref;
    
    $linesize = 0;
    while (defined(my $byte = shift @in)) {
      my $yenc = ($byte + 42) % 256;
      if ($linesize >= 128) {
        #enforce line size, insert a CRLF pair
        push @out, 0x0D;
        push @out, 0x0A;
        $linesize = 0;
      }
      if ($linesize == 0 || $linesize == 127) {
        #escape a tab or space in the first or last column of a line
        if ($yenc == 0x09 || $yenc == 0x20) {
          $yenc = ( $byte + 64 ) % 256;
          push @out, 0x3D;
          push @out, $yenc;
          $linesize += 2;
          next;
        }
      }
      if ($yenc==0x00 || $yenc==0x0A || $yenc==0x0D || $yenc==0x3D ){
        #found a critical character, escape it with 0x3D (=)
        push @out, 0x3D;
        $yenc = ( $byte + 64 ) % 256;
        $linesize++;
      }
      push @out, $yenc;
      $linesize++;
    }
    my $ydata = join '', map { chr $_ } @out;
    return ($ydata);
  }
  sub post_attachandpost #----------------------------------------------
  {
    #called from a button pressed in the post window
    my $file = $mw->getOpenFile();
    $mw->Busy(-recurse => 1);
    
    if (defined $file) {
      #Open the file, or return early
      unless (open ('ATCH', '< :raw', $file)) {
        error('post_atch_1');
        return (0);
      }
      
      #deterimine filename and remove leading and trailing whitespace
      update_status('Creating attachment...');
      for (1..4) { $pb += 4; $mw->update; }
      my $file_name = $file;
      $file_name =~ s/
        .*\/                   #0 or more of anything until foward slash
        (.+)                   #capture 1 or more of anything
        /$1                    #replace those with capture variable 1
      /x;
      $file_name =~ s/
        ^\s+                   #remove any space at the beginning
      //x;
      $file_name =~ s/
        \s+$                   #remove any space at the end
      //x;
      
      #truncate filenames longer than 254 characters
      my $file_name_len = length $file_name;
      if ($file_name_len >= 255) {
        for (255..$file_name_len) {
          chop $file_name;
        }
      }
      
      #how large is the file in bytes
      my($file_bytes, $file_kbytes,);
      $file_bytes = -s $file;
      
      #Split files that are larger than the posting limit (400k)        <-research
      if ($file_bytes > 409600) {
        #how many parts will this be?
        my($totalparts, $currentpart,);
        $totalparts = 1 + (int($file_bytes / 409600));
        
        #read 400k chunks of the file into a string
        $currentpart = 1;
        while (my $size = read(ATCH, my $buf, 409600)) {
          
          #yEncode data
          my @data  = map { ord $_ } split(//, $buf);
          my $ydata = post_yenc(\@data);
          my $begin = 1 + (($currentpart * 409600) - 409600);
          my $end;
          if ($size == 409600) {
            $end = $currentpart * $size;
          }
          else {
            $end = (($currentpart - 1) * 409600) + $size;
          }
          
          #Encapsulate data in yENC headers
          my $crlf  = "\015\012";
          my $yhead = "=ybegin ".
                      "part=$currentpart ".
                      "total=$totalparts ".
                      "line=128 ".
                      "size=$file_bytes ".
                      "name=$file_name";
          my $ypart = "=ypart ".
                      "begin=$begin ".
                      "end=$end";
          my $ytail = "=yend ".
                      "size=$size ".
                      "part=$currentpart";
          my $atch  = $crlf.$yhead.$crlf.$ypart.
                      $crlf.$ydata.$crlf.$ytail.$crlf;
          
          #Send the message
          my $ret = post_post(
            $atch, $currentpart, $totalparts, $file_name
          );
          if ($ret) {
            $currentpart++;
          }
          else {
            warn "Error - Unable to attach file\n";
            last;
          }
          $mw->update;
        }
        close ATCH;
      }
      else {
        #Create single part message attachement
        my $line;
        while (<ATCH>) { $line .= $_; }
        close ATCH;
        
        #yEncode data
        my @data  = map { ord $_ } split(//, $line);
        my $ydata = post_yenc(\@data);
        
        #Encapsulate data in yENC headers
        my $crlf  = "\015\012";
        my $yhead = "=ybegin ".
                    "line=128 ".
                    "size=$file_bytes ".
                    "name=$file_name";
        my $ytail = "=yend ".
                    "size=$file_bytes";
        my $atch  = $crlf.$yhead.$crlf.$ydata.$crlf.$ytail.$crlf;
        
        #send the message
        my $ret = post_post($atch, 1, 1, $file_name);
        unless ($ret) {
          warn "Error - Unable to attach file\n";
        }
      }
    }
    else {
      warn "Warning - No file selected for attachment\n";
    }
    $mw->Unbusy;
    return (1);
  }
  sub post_cancel #-----------------------------------------------------
  {
    #called from a button pressed in the post window
    $txt_post->delete('1.0', 'end');
    $tl2->Unbusy;
    $tl2->withdraw();
    $mw->update;
    return (1);
  }
  sub browse #----------------------------------------------------------
  {
    #called from a button pressed in the main window                    <-test
    $mw->Busy(-recurse => 1);
    dbmopen(my %OPT, 'settings', '0640')
      || die "Cannot create settings.\n$!";
    
    if ($^O eq 'MSWin32') {
      my ($dir,);
      $dir = $OPT{DDir};
      $dir =~ s/
        \/                            #swap foward slash for a backslash
      /\\/xg;
      system('explorer.exe', $dir);
    }
    else {
      system('ls', $OPT{DDir});
    }
    dbmclose %OPT;
    $mw->Unbusy;
    $mw->update;
    return (1);
  }
  sub rset_cmd #--------------------------------------------------------
  {
    #called from the rc menu
    my ($sel, $rem,);
    $mw->Busy(-recurse => 1);
    $sel = $lb1_grp->selectionGet;
    $rem = $lb1_grp->itemCget($sel, 0, -text);
    unless ($sel && $rem) {
      warn "Warning - No valid groups selected for reset.\n";
      return (0);
    }
    $lb2_msg->delete('all');
    
    if (-e "$rem.grp") {
      unless (unlink  "$rem.grp") {
        error('rset_1');
        return (0);
      }
    }
    dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
      || die "Cannot create sbscribe.\a\n$!";
    $SBSCRIBE{$rem} = 'Never';
    dbmclose %SBSCRIBE;
    $mw->after(500);
    display_groups();
    $mw->Unbusy;
    return (1);
  }
  sub group #-----------------------------------------------------------
  {
    #called from a button pressed in the main window
    my($lb_grp_s1, $imagedata, $chek,);
    $mw->Busy(-recurse => 1);
    $tl3->Popup;
    $lb_grp->focus;
    foreach my $b (@buttons) {
      $b->configure(-state => 'disabled');
    }
    $mw->Unbusy;
    $mw->update;
    return (1);
  }
  sub grp_search #------------------------------------------------------
  {
    search($lb_grp, 'GROUP');
    return (1);
  }
  sub grp_shownewsgroups #----------------------------------------------
  {
    my $opt1 = uc ($_[0]) || 'ALL';
    my($chek, $lb_grp_s1,);
    
    $mw->Busy(-recurse => 1,);
    update_status('Loading groups...');
    {
      my $imagedata = load_image(3);
      $chek = $mw->Photo(-format => 'bmp', -data => $imagedata);
      for (1..4) { $pb++; $mw->update; }
      undef $imagedata;
    }
    $lb_grp_s1 = $lb_grp->ItemStyle(
      'text',
      -selectforeground => '#000000',
      -selectbackground => '#fff000',
      -bg               => '#000000',
      -fg               => '#ffffff',
      -font             => '{Arial} 8',
      -anchor           => 'w',
    );
    $lb_grp->delete('all');
    $mw->update;
    
    if (-e 'groups') {
      my(%groups, $counter, $c,);
      tie %groups, 'MLDBM', 'groups', O_CREAT|O_RDWR, '0640' or die $!;
      dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
        || die "Cannot create sbscribe.\n$!";
      
      $counter = $c = 0;
      foreach my $k (sort(keys(%groups))) {
        my $found;
        if ($opt1 eq 'SEARCH') {
          #search action specified
          if ($k =~ m/$grpSubSearch/) {
            $found++;
          }
        }
        if ($opt1 eq 'SEARCH' && !defined $found) {
          #item does not match search
          next;
        }
        else {
          #display the item
          my $v = $groups{$k};
          $lb_grp->add($counter);
          $lb_grp->itemCreate($counter, 0,
            -text  => $k,
            -style => $lb_grp_s1
          );
          $lb_grp->itemCreate($counter, 1,
            -text  => $v,
            -style => $lb_grp_s1
          );
          if ($SBSCRIBE{$k}) {
            $lb_grp->indicator('create', $counter,
              -itemtype => 'image',
              -image    => $chek
            );
          }
        }
        if ($pb >= 100) { $pb  = 0; $mw->update;                     }
        if ($c  > 1000) { for (1..5) { $pb++; $mw->update; } $c = 0; }
        else            { $c++;                                      }
        $counter++;
      }
      untie %groups;
      dbmclose %SBSCRIBE;
    }
    else {
      $lb_grp->add(0);
      $lb_grp->itemCreate(0,0,
        -text => 'Press the Update button to retrieve groups '.
                 'from server.'
      );
    }
    
    ready();
    return (1);
  }
  sub grp_update #------------------------------------------------------
  {
    #called from a button pressed in the group window
    $tl3->Busy(-recurse => 1,);
    update_status('Downloading groups...');
    $lb_grp->delete('all');
    $pb++;
    $mw->update;
    
    $shash{1}{list} = 1;
    while ($shash{1}{list} == 1) {
      if ($pb >= 100) { $pb = 0; }
      else            { $pb++;   }
      $mw->after(100);
      $mw->update;
    }
    
    $tl3->Unbusy;
    grp_close();
    group();
    grp_shownewsgroups();
    ready();
    return (1);
  }
  sub grp_subscribe #---------------------------------------------------
  {
    #called from a button pressed in the group window
    my ($imagedata, $chek, @sel,);
    $imagedata = load_image(3);
    $chek = $mw->Photo(
      -format => 'bmp',
      -data   => $imagedata
    );
    undef $imagedata;
    dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
      || die "Cannot create sbscribe.\a\n$!";
    
    @sel = $lb_grp->selectionGet;
    foreach (@sel) {
      my $a = $lb_grp->itemCget($_, 0, -text);
      $lb_grp->indicator('create', $_,
        -itemtype => 'image',
        -image    => $chek
      );
      $SBSCRIBE{$a} = 'Never';
    }
    dbmclose %SBSCRIBE;
    display_groups();
    return (1);
  }
  sub grp_unsubscribe #-------------------------------------------------
  {
    #called from a button pressed in the group or main window
    my $opt = $_[0];
    dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
      || die "Cannot create sbscribe.\a\n$!";
    if ($opt) {
      #unsubscribe from main screen
      my($sel, $a,);
      $sel = $lb1_grp->selectionGet;
      unless ($sel) {
        warn "Warning - No valid group selected to remove.\n";
        return (0);
      }
      $a = $lb1_grp->itemCget($sel, 0, -text);
      warn "Warning - Removing newsgroup:  [$a.grp].\n";
      delete $SBSCRIBE{$a};
      if  (-e "$a.grp") {
        unlink "$a.grp" || error('grp_unsub_1', "$a");
      }
      $lb2_msg->delete('all');
    }
    else {
      #unsubscribe from groups screen
      my (@sel,);
      @sel = $lb_grp->selectionGet;
      unless (@sel) {
        warn "Warning - No valid group selected to remove.\n";
        return (0);
      }
      foreach (@sel) {
        my $a = $lb_grp->itemCget($_, 0, -text);
        $lb_grp->indicator('delete', $_,);
        warn "Warning - Removing newsgroup:  [$a.grp].\n";
        delete $SBSCRIBE{$a};
        if (-e "$a.grp") {
          unlink "$a.grp" || error('grp_unsub_1', "$a");
        }
      }
    }
    dbmclose %SBSCRIBE;
    display_groups();
    return (1);
  }
  sub grp_close #-------------------------------------------------------
  {
    #called from a button pressed in the group window
    $mw->Busy(-recurse => 1);
    $mw->update;
    $lb_grp->delete('all');
    $tl3->withdraw;
    foreach my $b (@buttons) {
      $b->configure(-state => 'normal',);
    }
    $mw->update;
    $mw->Unbusy;
    return (1);
  }
  sub display_groups #--------------------------------------------------
  {
    #called from subs: group_subscribe, group_unsubscribe
    my ($lb1_k1, $lb1_k2,);
    
    $lb1_grp->delete('all');
    $lb1_k1 = $lb1_grp->ItemStyle('text',
      -anchor           => 'w',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -font             => '{Arial} 8',
    );
    $lb1_k2 = $lb1_grp->ItemStyle('text',
      -anchor           => 'e',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -font             => '{Arial} 8',
    );
    
    my $counter = 1;
    dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
      || die "Cannot create sbscribe.\n$!";
    for my $k (sort keys %SBSCRIBE) {
      $lb1_grp->add($counter);
      $lb1_grp->itemCreate($counter, 0,
        -text  => "$k",
        -style => $lb1_k1,
      );
      $lb1_grp->itemCreate($counter, 1,
        -text  => "$SBSCRIBE{$k}",
        -style => $lb1_k2,
      );
      $counter++;
    }
    dbmclose %SBSCRIBE;
    return (1);
  }
  sub search_popup #----------------------------------------------------
  {
    #called from rc menu
    my ($group, @sel,);
    #make sure the group clicked has been loaded or scanned.
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      print STDERR 'No valid group selected to search.'.
                   "\nEval: $@\n";
    }
    
    #raise popup
    $tla->Popup;
    $tla->focus;
    $mw->update;
    return (1);
  }
  sub search #----------------------------------------------------------
  {
    #works for HLists only
    #called from button pressed in group window or search_popup window
    #Todo - add search within results option                            #<--Todo
    my $w    = $_[0]      || return (0);
    my $opt1 = uc ($_[1]) || 0;
    my $opt2 = $_[2]      || 0;
    my (@paths, $c,);
    
    #show all requested
    if ($opt1 eq 'GROUP' && $opt2 == 1) {
      #show all available newsgroups
      grp_shownewsgroups('ALL');
      return (1);
    }
    
    #start searching
    $w->focus;
    $mw->Busy(-recurse => 1,);
    update_status('Searching groups...');
    $mw->update;
    
    if (defined $grpSubSearch) {
      #escape any regex metachars found within search string
      #$grpSubSearch = qr/$grpSubSearch/;
      $grpSubSearch =~ s/
        ([\/\+\*\.\?\^\$]+)          #quietly escape any regex metachars
        /\\$1/xg;
    }
    else {
      #Default search regex (all but newline regex metachar)
      $grpSubSearch = '.';
    }
    for (1..4) { $pb++; $mw->update; }
    $tla->withdraw;
    $c = 0;
    
    @paths = $w->infoChildren;
    if ($paths[0]) {
      #Widget is populated, show only entries which match search term
      foreach my $path (@paths) {
        my $item  = $w->itemCget($path, 0, -text);
        if ($item =~ m/$grpSubSearch/i) { $w->show('entry', $path); }
        else                            { $w->hide('entry', $path); }
        if ($c >= 1000) {
          if ($pb >= 100) { $pb = 0; }
          else            { $pb++;   }
          $c = 0;
          $mw->update;
          next;
        }
        $c++;
      }
    }
    else {
      #searching an empty widget, see if it is the groups window
      if ($opt1 eq 'GROUP') {
        #call a more specific search subroutine
        grp_shownewsgroups('SEARCH');
      }
    }
    
    ready();
    return (1);
  }
  sub opt #-------------------------------------------------------------
  {
    #called from button pressed in the main window
    dbmopen(my %OPT, 'settings', '0640')
      || die "Cannot create settings.\n$!";
      
    my $c = 0;
    foreach my $k qw(Serv User Pass Mail DDir Sig) {
      $OPT_widgets[$c]->delete(0, 'end');
      $OPT_widgets[$c]->insert('end', $OPT{$k});
      $mw->update;
      $c++
    }
    if ($OPT{QSig}) {
      $OPT_widgets[$c]->select;
    }
    dbmclose %OPT;
    
    $tl5->Popup;
    $tl5->focus;
    $mw->update;
    return (1);
  }
  sub opt_close #-------------------------------------------------------
  {
    #called from button pressed in the option window
    my($serv, $user, $pass, $email, $ddir, $sig,);
    
    dbmopen(my %OPT, 'settings', '0640')
      || die "Cannot create settings.\n$!";
    $serv  = $OPT_widgets[0]->get();
    $user  = $OPT_widgets[1]->get();
    $pass  = $OPT_widgets[2]->get();
    $email = $OPT_widgets[3]->get();
    $ddir  = $OPT_widgets[4]->get();
    $sig   = $OPT_widgets[5]->get();
    $OPT{Serv} = $serv;
    $OPT{User} = $user;
    $OPT{Pass} = $pass;
    $OPT{Mail} = $email;
    $OPT{DDir} = $ddir;
    $OPT{Sig}  = $sig;
    $OPT{QSig} = $quoteSig;
    dbmclose %OPT;
    
    $tl5->withdraw;
    $mw->update;
    return (1);
  }
  sub opt_download #----------------------------------------------------
  {
    #called from button pressed in the option window
    my ($dir,);
    $OPT_widgets[4]->delete(0, 'end');
    
    eval {
      $dir = $tl5->chooseDirectory(
        -title      => 'Choose a download directory.',
        -initialdir => '.',
        -mustexist  => 1,
      )
    };
    if ($@) {
      #error
      error('conf_browse1');
    }
    else {
      if ($dir) {
        #user defined directory
        $OPT_widgets[4]->insert('end', "$dir");
      }
      else {
        #default directory
        $OPT_widgets[4]->insert('end', ".");
      }
    }
    $mw->update;
    return (1);
  }
  sub opt_signature #---------------------------------------------------
  {
    #called from button pressed in the option window
    my ($sig, $ofile,);
    $OPT_widgets[5]->delete(0, 'end');
    
    $ofile = $tl5->getOpenFile(
      -title      => 'Choose Signature File',
      -initialdir => '.',
    );
    if ($ofile) {
      $OPT_widgets[5]->insert('end', "$ofile");
      $mw->update;
      return (1);
    }
    return (0);
  }
  sub show_log #--------------------------------------------------------
  {
    #called from button pressed in the main window
    my (@log,);
    $tl1->deiconify();
    $tl1->raise();
    $txt_log->focus;
    $txt_log->delete('1.0', 'end');
    $mw->update;
    $mw->Busy(-recurse => 1);
    
    close STDERR;
    open ('FH', '<', 'NewsSurfer.log')
      || warn "Error - Cannot open NewsSurfer.log\n$!";
    @log = (<FH>);
    close FH;
    open STDERR, '>>', 'NewsSurfer.log'
      || warn "Error - Cannot open NewsSurfer.log\n$!";
    
    foreach my $line (@log) {
      chomp $line;
      unless (defined $line) { $line = '#'; }
      $line =~ s/
        ^Net         #the word 'Net' at the beginning of the string
        .*\)         #followed by everything up to a right parenthesis
        (<|>.*)      #capture left or right bracket followed by anything
                     #replace those with capture 1
      /$1/x;
      if ($line =~ m/
        ^>>>.*                #three right brackets followed by anything
      /x) {
        $txt_log->insert('end', $line . "\n", 'Blue');
      }
      elsif ($line =~ m/
        ^Error          #the word 'error' at the beginning of the string
        \s*             #followed by some optional whitespace
        -.+             #followed by a dash and 1 or more of anything
      /xi) {
        $txt_log->insert('end', $line . "\n", 'Red');
      }
      elsif ($line =~ m/
        ^Warning      #the word 'warning' at the beginning of the string
        \s*           #followed by some optional whitespace
        -.+           #followed by a dash and 1 or more of anything
      /xi) {
        $txt_log->insert('end', $line . "\n", 'Yellow');
      }
      else {
        $txt_log->insert('end', $line . "\n");
      }
      $mw->update;
    }
    $mw->Unbusy;
    return (1);
  }
  sub log_close #-------------------------------------------------------
  {
    #called from button pressed in the log window
    $tl1->withdraw;
    $mw->update;
    return (1);
  }
  sub log_save #--------------------------------------------------------
  {
    #called from button pressed in the log window
    my (@log, $sf,);
    $sf  = $tl1->getSaveFile(-title => 'Save Log',);
    
    if ($sf) {
      warn "Warning - A logfile has been saved.\n";
      $mw->Busy(-recurse => 1);
      open ('FH', '<', 'NewsSurfer.log')
        || warn "Error - Cannot open NewsSurfer.log\n";
      @log = (<FH>);
      close FH;
      open ('FH', '>', $sf)
        || warn "Error - Can not save log.\n$!";
      foreach my $line (@log) {
        chomp $line;
        print FH "$line\n";
      }
      close FH;
      $mw->Unbusy;
      return (1);
    }
  }
  sub help #------------------------------------------------------------
  {
    #called from button pressed in the main window
    $tl6->Popup;
    $txt_help->focus;
    $txt_help->delete("1.0", 'end');
    $txt_help->insert('end',
      'NewsSurfer can download binaries and read messages on '.
      "usenet newsgroups.\n".
      "You can use NewsSurfer to post messages and atachments.\n"
    );
    $mw->update;
    return (1);
  }
  sub help_about #------------------------------------------------------
  {
    #called from button pressed in the help window
    my($pod,);
    $pod = $mw->Pod(-tree => 0,);
    $pod->configure(-file => $0);
    return (1);
  }
  sub help_close #------------------------------------------------------
  {
    #called from button pressed in the help window
    $tl6->withdraw;
    $mw->update;
    return (1);
  }
  sub quit #------------------------------------------------------------
  {
    #called from button pressed in the main window
    $mw->Busy(-recurse => 1,);
    $mw->update;
    warn 'NewsSurfer has closed.  (' . localtime() . ")\n";
    $mw->destroy;
    return (1);
  }
  sub raise_rc_menu #---------------------------------------------------
  {
    #called from right-clicking in the main window
    my $toplevelwidget = $_[0] || 'NULL'; #required
    my $listbox        = $_[1];           #optional
    my($x, $y) = $mw->pointerxy;
    my $height;
    
    $mw->Busy(-recurse => 1,);
    if ($listbox && Exists($listbox) && Exists($toplevelwidget)) {
      #a listbox was supplied
      my($selected,);
      
      #verify widget is a listbox
      eval { $selected = $listbox->nearest($y - $listbox->rooty) };
      if (! $@) {
        #it's a listbox, make selection at xy if there is a entry
        if ($selected) {
          $listbox->selectionClear();
          $listbox->selectionSet($selected);
        }
      }
      $height = $toplevelwidget->height;
      $y -= $height;
    }
    if (Exists($toplevelwidget)) {
      $toplevelwidget->geometry('+'."$x".'+'."$y");
      $toplevelwidget->deiconify();
      $toplevelwidget->raise();
      $toplevelwidget->focus();
      $mw->update;
    }
    $mw->Unbusy;
    return (1);
  }
  sub lb2_msg_select_all #----------------------------------------------
  {
    #called from the rc menu or key binding
    my (@paths, $count, $home, $end,);
    $mw->Busy(-recurse => 1);
    
    @paths = $lb2_msg->infoChildren;
    if (@paths) {
      $count = $#paths;
      $home  = $paths[0];
      $end   = $paths[$count];
      $lb2_msg->focus;
      $lb2_msg->selectionSet("$home", "$end");
    }
    $mw->update;
    $mw->Unbusy;
    return (1);
  }
  sub lb2_msg_select_end #----------------------------------------------
  {
    #called from the rc menu or key binding
    my ($sel, @paths, $count, $end,);
    $sel   = $lb2_msg->selectionGet;
    @paths = $lb2_msg->infoChildren;
    $count = $#paths;
    $end   = $paths[$count];
    $lb2_msg->selectionSet($sel, "$end");
    $mw->update;
    return (1);
  }
  sub lb2_msg_select_hom #----------------------------------------------
  {
    #called from the rc menu or key binding
    my ($sel, @paths, $home,);
    $sel   = $lb2_msg->selectionGet;
    @paths = $lb2_msg->infoChildren;
    $home  = $paths[0];
    $lb2_msg->selectionSet($sel, "$home");
    $mw->update;
    return (1);
  }
  sub FlashButton #-----------------------------------------------------
  {
    #called during widget creation
    my $w = $_[0]; my $c1 = $_[1]; my $c2 = $_[2];
    unless($w and $c1 and $c2) {
      return (0);
    }
    $w->bind('<ButtonPress-1>' => sub {
      $w->configure(-relief  => 'flat',);
      $w->configure(-fg      => $c1); $w->flash; $w->flash;
      $w->configure(-fg      => $c2);
    });
    return (1);
  }
  sub MainButtons #-----------------------------------------------------
  {
    #called during widget creation
    my $w = $_[0]; my $o1 = $_[1];
    my ($id1, $id2, $i1, $i2, $i3,);
    my $o2 = $o1.'1';
    
    $id1 = load_image($o1);
    $id2 = load_image($o2);
    
    $i1 = $mw->Photo(
      -data    => $id1,
      -format  => 'bmp',
      -palette => '256',
    );
    $i2 = $mw->Photo(
      -data    => $id1,
      -format  => 'bmp',
      -palette => '64/64/64',
    );
    $i3 = $mw->Photo(
      -data   => $id2,
      -format => 'bmp',
    );
    undef $id1;
    undef $id2;
    
    my $width  = $mw->screenwidth;
    if ($width > 800) {
      $i1->copy($i1, -zoom => 1.9,1,);
      $i2->copy($i2, -zoom => 1.9,1,);
      $i3->copy($i3, -zoom => 1.9,1,);
    }
    
    $w->configure(-relief => 'flat', -image => $i1);
    
    $w->bind('<Leave>' => sub { $w->configure(-image => $i1); });
    $w->bind('<Enter>' => sub { $w->configure(-image => $i2); });
    $w->bind('<ButtonPress-1>' => sub {
      $w->configure(
        -relief => 'flat',
        -image  => $i3
      );
    });
    $w->bind('<ButtonRelease-1>' => sub {
      $w->configure(
        -relief => 'flat',
        -image  => $i1
      );
    });
    $mw->update;
    return (1);
  }
  sub ready #-----------------------------------------------------------
  {
    while ($pb > 100) {
      $pb++;
      if ($pb % 2) { $mw->update };
    }
    $pb = 0;
    update_status('Ready');
    $mw->Unbusy;
    $mw->update;
    return (1);
  }
  sub error #-----------------------------------------------------------
  {
    #called from various subroutines
    my $error = $_[0] || 'NULL';
    my $opt1  = $_[1] || 0;
    my(@sel, $group,);
    
    my $msg   = "\nError - ";
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected.\n";
    }
    
    $mw->Busy(-recurse => 1);
    if ($error eq 'connect') {
      $msg .= "Could not connect, try again.\n";
    }
    elsif ($error =~ m/
      ^grab.*    #'grab' followed by anything at the beginning of string
    /xig) {
      if ($error eq 'grab_1') {
        $msg .= "Cannot open $group.dat\n$!";
      }
      elsif ($error eq 'grab_2a') {
        $msg .= "Cant decode attachment.\n"."File already exists.\n";
      }
      elsif ($error eq 'grab_2b') {
        $msg .= "Cant decode attachment.  Decoder error.\n$!";
      }
      elsif ($error eq 'grab_3') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'grab_4') {
        $msg .= "Error downloading article from server\n$!";
      }
      elsif ($error eq 'grab_4a') {
        $msg .= "Article does not exist on server\n$!";
      }
    }
    elsif ($error =~ m/
      ^scan.*    #'scan' followed by anything at the beginning of string
    /xig) {
      if ($error eq 'scan_1') {
        $msg .= "Must select a group to scan.\n";
      }
      elsif ($error eq 'scan_2') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'scan_3') {
        $msg .= "Cannot create $group.grp\n$!";
      }
    }
    elsif ($error =~ m/
      ^grp.*      #'grp' followed by anything at the beginning of string
    /xig) {
      if ($error eq 'grp_1') {
        $msg .= "Cannot open groups.\n$!";
      }
      elsif ($error eq 'grp_update_1') {
        $msg .= "Can't create local groups.\n$!";
      }
      elsif ($error eq 'grp_unsub_1') {
        $msg .= "Unable to delete $_[1].grp\n$!";
      }
      elsif ($error eq 'grp_unsub_2') {
        $msg .= "Unable to delete $_[1].dat\n$!";
      }
      elsif ($error eq 'grp_search_1') {
        $msg .= "Must enter a search term.\n";
      }
    }
    elsif ($error =~ m/
      ^post.*    #'post' followed by anything at the beginning of string
    /xig) {
      if ($error eq 'post_1') {
        $msg .= "Must scan a group to post to.\n";
      }
      elsif ($error eq 'post_atch_1') {
        $msg .= "Cannot open file\n$!";
      }
      elsif ($error eq 'post_attach_tobig') {
        $msg .= "Can't post file attachments larger than 1Mb.\n";
      }
    }
    else {
      if ($error eq 'login') {
        $msg .= "Cannot login\n$!";
      }
      elsif ($error eq 'MLDBM') {
        $msg .= "Error opening .grp database file\n$!";
      }
      elsif ($error eq 'conf_browse1') {
        $msg .= 'Manually enter path or upgrade perl/Tk.';
      }
      elsif ($error eq 'msg_del_1') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'read_1') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'rset_1') {
        $msg .= "Unable to delete file.\n$!";
      }
      elsif ($error eq 'sort_1') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'sig1') {
        $msg .= "Can't load signature.\n$!";
      }
    }
    #display error
    chomp ($msg);
    warn "$msg\n";
    update_status($msg);
    $mw->after(2000);
    
    #check if die was requested
    if ($opt1) { $mw->destroy;        }
    else       { ready(); return (1); }
    return (0);
  }
  sub update_status #---------------------------------------------------<-redo interface
  {
    #called from various subroutines
    #called with either a status message in $txt
    #or a number followed by PROGRESSBAR (triggers progressbar update)
    #or a word followed by PROGRESSBAR (triggers progress complete)
    my $txt = $_[0] || 'NULL';
    my $opt = $_[1] || 'NULL';
    
    if ($opt eq 'PROGRESSBAR') {
      if ($txt =~ m/(^\d+)/) {
        #update status of progressbar
        for (1..$1) { $pb++; $mw->update; $mw->after(64); }
      }
      else {
        #complete and reset the progress bar
        while ($pb < 100) { $pb++; $mw->update; }
        $pb = 0;
      }
    }
    elsif ($txt ne 'NULL' && $opt ne 'PROGRESSBAR') {
      $sb_lab->configure(-text => "  $txt");
      $mw->update;
    }
    else {
      warn "Error - update_status error\ntxt [$txt]\nopt [$opt]\n$!";
      $mw->destroy;
    }
    return (1);
  }
  return (1);
}
#***********************************************************************END news_gui
sub load_image #--------------------------------------------------------
{
  #called from various subroutines, returns imagedata
  my $opt = $_[0]; my $imagedata;
  if ($opt == 2) {
    $imagedata =
    'Qk1YAgAAAAAAADYAAAAoAAAACgAAABEAAAABABgAAAAAAAAAAAASCwAAEgsAAA'.
    'AAAAAAAAAA////////////////////////////////////////AAD4+Pj/////'.
    '//////////////////////////////8AAP////////////////////////////'.
    '39/f39/fj4+AAA////////////////////////////////////////AAD/////'.
    '///+/v7+/v79/f39/f3+/v7///////////8AAGZHumlKvUYvi4p0xotyzVhEkm'.
    'BFp1w8sP38/v///wAAdlfK////////9fL79fP8+vj//fz/i3LN+vn9////AABm'.
    'R7r49//4+/9JTFsXGCGvr7b///9sU7X////9/f8AAGZHuvHu/sPG1RYZKBobKx'.
    'AQFGFedGFHrPz8/f79/wAAa0+6/Pv/Xl5mAAAIq6yyJygrAAASZE6i+/v9/v7/'.
    'AAByWLv49f/R0NfLy9Dw8PStrrUHBhBRP4P///////8AAHNVv/v6/fXy+vj3/P'.
    'Lv+vHv+RcSJgUDCO/v7////wAAgGTGeV3AlX3RhGjLi3LNi3LNdlrAIiElDQsT'.
    '7+/vAAD///3///7+/f/////////////9/fz39/clJyPQ0NAAAP////////////'.
    '///////////////////////////wAA/v7+////////////////////////+/v7'.
    '////+Pj5AAD////////+/v7+/v7+/v7////////////////7/PsAAAAA';
  }
  elsif ($opt == 3) {
    $imagedata =
    'Qk1YAgAAAAAAADYAAAAoAAAACgAAABEAAAABABgAAAAAAAAAAAASCwAAEgsAAA'.
    'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHBwcAAAAA'.
    'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'.
    'ICAgICAgcHBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'.
    'AAARDSABAQEBAQEAAAAAAAANCRgAAAAAAAAAAGZHunZXymtQtmZHumlYmHNfqm'.
    'tRsWxSsAgHDQAAAAAAdlfKAAAAAAAACg0ECgwDBQcAAgMAZke6HBYuAAAAAABm'.
    'R7oHCAAHBAC2s6To595QUEkAAABtWKgZES0BAQAAAGZHug4RATw5Kunm1+Xk1O'.
    '/v656hi3JepREMHQAAAAAAa0+6AwQAoaGZ///3VFNN2NfU///taUy1GRIsAQEA'.
    'AAByWLsHCgAjIx4qKiYODgpSUUr4+e9sUrQYESwAAAAAAHNVvwoJDg0KFRwUMB'.
    'wYKBQTEdDO0/r89xAQEAAAAAAAbU69Zke6ZkytZ0uzaVSgZke6Zke63d7a8vTs'.
    'EBAQAAAAAAIAAAEBAgAAAAAAAAAAAAACAgMICAja2NwvLy8AAAAAAAAAAAAAAA'.
    'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQEBAAAAAAAAAAAAAAAAAAAAAAAABAQE'.
    'AAAABwcGAAAAAAAAAAABAQEBAQEBAQEAAAAAAAAAAAAAAAAEAwQAAAAA';
  }
  elsif ($opt == 10) {
$imagedata =
'Qk2mDgAAAAAAADYAAAAoAAAAOAAAABYAAAABABgAAAAAAHAOAAAmDgAAJg4AAAAAAAAAAAAAoaGh
oaGhoKCgoKCgoKCgnJyckJCQiIiIh4eHh4eHhYWFhYWFhISEhISEhISEg4ODg4ODg4ODg4ODgoKC
goKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCg4ODg4ODg4ODhISEhISEhISEhYWFhYWFhoaGhoaG
hoaGh4eHh4eHh4eHh4eHh4eHiIiIiIiIiIiIjIyMlJSUnp6eoaGhoaGhoaGhoaGhoaGhoaGhoaGh
oKCgoKCgkpKSj4+Purq61NTU29vb2dnZ2tra2dnZ2NjY1tbW1tbW1dXV1dXV1dXV1NTU1NTU1NTU
09PT09PT09PT09PT09PT09PT09PT1NTU1dXV1dXV1dXV1tbW1tbW2NjY2dnZ2tra29vb3Nzc3Nzc
3Nzc3d3d3d3d3t7e3t7e39/f39/f39/f0dHRsrKyioqKlJSUoaGhoaGhoaGhoaGhoaGhoaGhoKCg
jo6OoqKi6enp/Pz8+/v7+vr6+fn5+Pj49vb29fX19PT08/Pz8vLy8fHx8fHx8PDw7+/v7+/v7+/v
7+/v7+/v7u7u7+/v7+/v7+/v8PDw8PDw8fHx8vLy8/Pz9PT09fX19/f3+Pj4+fn5+vr6+/v7/Pz8
/f39/f39/v7+/v7+////////////////////5ubmoaGhjo6OoaGhoaGhoaGhoaGhoKCgkZGRoKCg
+fn5/Pz8+/v7+vr6+fn5+Pj49vb29fX18/Pz8vLy8fHx8PDw7+/v7u7u7u7u7e3t7Ozs7Ozs7Ozs
7Ozs7Ozs7Ozs7Ozs7Ozs7u7u7u7u7+/v8PDw8fHx8vLy8/Pz9fX19/f3+Pj4+fn5+vr6+/v7/Pz8
/f39/v7+/v7+/v7+/////////////////////Pz8qqqqj4+PoaGhoaGhoaGhmZmZi4uL5+fn9vb2
9fX19PT08/Pz8vLy8fHx7+/v7e3t6+vr6urq6enp6Ojo5ubm5ubm5eXl5OTk5OTk5OTk5OTk5OTk
5OTk5OTk5OTk5OTk5eXl5ubm5ubm6Ojo6enp6urq7Ozs7u7u7+/v8fHx8/Pz9PT09fX19vb29/f3
9/f3+Pj4+Pj4+fn5+fn5+fn5+fn5+fn5+fn58/PznJyck5OToaGhoaGhjIyMxcXF7+/v7u7u7e3t
7Ozs6+vr6enp6Ojo5ubm5eXl4+Pj4eHh39/f3t7e3d3d3Nzc3Nzc29vb29vb2tra2tra2tra2tra
2tra2tra29vb3Nzc3d3d3d3d39/f4eHh4uLi4+Pj5eXl5+fn6Ojo6urq6+vr7e3t7u7u7u7u7+/v
8PDw8PDw8fHx8fHx8fHx8fHx8fHx8fHx8fHx4ODgh4eHn5+fnJycjo6O4uLi5eXl5OTk4+Pj4uLi
4eHh39/f3d3d29vb2dnZ2NjY1tbW1NTU09PT0tLS0dHR0NDQ0NDQz8/Pz8/Pz8/Pz8/Pz8/Pz8/P
z8/P0NDQ0dHR0tLS09PT1NTU1dXV19fX2dnZ2tra3Nzc3t7e4ODg4uLi4uLi4+Pj5OTk5eXl5ubm
5ubm5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fnp6enlZWVlJSUpKSk29vb2tra2dnZ2NjY19fX1dXV
09PT0tLS0NDQzs7OzMzMy8vLycnJyMjIx8fHxsbGxsbGxcXFxMTExMTExMTEw8PDw8PDxMTExMTE
xcXFxsbGxsbGx8fHycnJysrKzMzMzc3Nz8/P0dHR09PT1dXV1tbW2NjY2dnZ2dnZ2tra29vb29vb
3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3NzcxMTEiYmJjIyMsrKyzs7Ozs7Ozc3NzMzMy8vLycnJyMjI
xsbGxcXFw8PDwcHBv7+/vr6+vLy8vLy8u7u7urq6ubm5ubm5uLi4uLi4uLi4uLi4uLi4ubm5ubm5
u7u7vLy8vLy8vb29v7+/wMDAwsLCxMTExcXFx8fHycnJysrKzMzMzc3Nzs7Ozs7Oz8/Pz8/P0NDQ
0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQy8vLgoKChoaGt7e3wsLCwsLCwcHBwMDAv7+/v7+/vr6+vb29
vLy8u7u7uLi4t7e3tbW1vaem32Vf8kI48kI46lBH0Xp1sbGxsbGx1nNt7kk/8kI45VdOsrKy419W
8kI45lhP8kI4419XuLi48kI45GBYvb295WFZ8kI4wcHBwsLCw8PDxMTExMTExcXFxcXFxsbGxcXF
xcXFxMTExMTExMTExMTExMTEwMDAgoKCg4ODs7OzuLi4t7e3tra2tra2urq6u7u7u7u7urq6ubm5
t7e3tbW1tLS0s7OzwpqX6FxTyY2JwZiW1Hp08FBGyIyI0IF78FBG1Hp0wJiW1Hp0wZiW8FBG3W9o
xpSQ8FBG4WpitbW18FBG4mtjurq642tk8FBGvb29vr6+v7+/wMDAwcHBwcHBwcHBwsLCwsLCwMDA
vLy8ubm5ubm5ubm5ubm5tra2goKCgoKCq6urrq6urq6urKyssrKyurq6u7u7urq6ubm5t7e3t7e3
tra2tLS0tLS0t66us7Ozs7Ozwp2b3Xhy8F5V0IiE4HNt8F5VsbGxsrKysrKyt62t7GRb6Glh0omF
8F5V4XRttra28F5V4nRuubm54nVv8F5VvLy8vb29vb29vr6+v7+/v7+/v7+/v7+/v7+/v7+/u7u7
srKyr6+vr6+vr6+vrKysgoKCg4ODoqKipqampqamp6entbW1vr6+vr6+vb29vLy8u7u7urq6urq6
ubm5uLi4t7e305SQ7XRt8HBo8HBo7XRtva2s3oaB8HBovq6tt7e3vq6ut7e3u7OyyqKf1JSR8HBo
4oJ8urq68HBo44N9vLy85IN+8HBov7+/v7+/wMDAwcHBwcHBwcHBwcHBwcHBwcHBwcHBwMDAs7Oz
qKiop6enp6enpaWlgoKCh4eHmZmZoKCgoKCgp6envb29xMTExMTEw8PDw8PDwcHBwcHBwcHBwMDA
wMDAybSy8oN974eB252a0qimwbu6vr6+yLSy74eB74eB5ZKN8oN9vr6+4paS5ZKN6I+J8oN93J6b
wcHB8oN974eB5pOO8oN97IuGxMTExMTExcXFxsbGxsbGxsbGxsbGxsbGxsbGxsbGxsbGurq6paWl
oaGhoaGhn5+fgoKCjY2Nk5OToKCgoKCgrq6uysrKz8/Pzs7Ozs7Ozs7Ozc3NzMzMzMzMzMzMy8vL
08LB9JmT56ily8vLzcfH2ri20sHAysrK0MTD3bWy37Kv2Lu5y8vL08LB4LKw4LKw27m2zMzMzMzM
18C+1cPC18C/4bSx08jHz8/Pz8/Pz8/P0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQx8fHq6uroaGh
oaGhn5+fgoKClZWVi4uLoKCgoKCgtLS01NTU2dnZ2dnZ2NjY2NjY19fX19fX19fX19fX1tbW1tbW
6MC99q6p9q6p9q6p9q6p3M7N1tbW1tbW1tbW1tbW1tbW1tbW1tbW19fX19fX19fX19fX19fX19fX
2NjY2NjY2NjY2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2tra2tra2tra2tra2tra0dHRr6+voaGhoaGh
l5eXioqKnp6eg4ODnp6eoKCgsLCw2NjY4uLi4uLi4uLi4uLi4uLi4eHh4eHh4eHh4eHh4eHh4eHh
4t/f59nY59nY4eHh4ODg4ODg4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4uLi
4uLi4uLi4uLi4uLi4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj0tLSq6uroaGhoaGhioqK
l5eXoaGhkJCQkJCQoKCgqamp1tbW6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6urq6urq
6urq6urq6urq6urq6urq6urq6urq6urq6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr
6+vr6+vr6+vr7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs6+vry8vLpaWloaGhmZmZgYGBoKCg
oaGhnZ2dgYGBmZmZoqKixsbG7u7u8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz
8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz
8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz9PT09PT09PT09PT09PT05+fnubm5oaGhnZ2dhYWFlZWVoaGhoaGh
oaGhlJSUhYWFnZ2dsbGx4eHh+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6
+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6
+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr68/Pzzs7Op6ennp6eiIiIkZGRoaGhoaGhoaGhoaGh
oaGhkJCQhISEmpqavLy84ODg8vLy9/f39/f3+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5
+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5
+fn5+fn5+fn5+fn5+fn5+fn58/Pz5eXly8vLrKyslpaWhYWFkJCQoaGhoaGhoaGhoaGhoaGhoaGh
oaGhlpaWgYGBjIyMoaGhsrKyurq6vb29wMDAwcHBwcHBwMDAwMDAwMDAwMDAwMDAwMDAwMDAwcHB
wcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB
wcHBwcHBwcHBwcHBwMDAtra2pqamlpaWioqKgICAmZmZoaGhoaGhoaGhoaGh';
  }
  elsif ($opt == 101) {
$imagedata =
'Qk2mDgAAAAAAADYAAAAoAAAAOAAAABYAAAABABgAAAAAAHAOAAAmDgAAJg4AAAAAAAAAAAAAoaGh
oaGhoKCgoKCgoKCgnJyckJCQiIiIh4eHh4eHhYWFhYWFhISEhISEhISEg4ODg4ODg4ODg4ODgoKC
goKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCg4ODg4ODg4ODhISEhISEhISEhYWFhYWFhoaGhoaG
hoaGh4eHh4eHh4eHh4eHh4eHiIiIiIiIiIiIjIyMlJSUnp6eoaGhoaGhoaGhoaGhoaGhoaGhoaGh
oKCgoKCgkpKShoaGmpqapaWlqampqKioqKiop6enp6enpaWlpaWlpaWlpKSkpKSko6Ojo6Ojo6Oj
o6Ojo6Ojo6Ojo6Ojo6Ojo6Ojo6Ojo6OjpKSkpKSkpaWlpaWlpaWlp6enp6enqKioqampqampqqqq
qqqqq6urq6urq6urq6urrKysrKysrKyspqaml5eXhYWFlJSUoaGhoaGhoaGhoaGhoaGhoaGhoKCg
jo6Oj4+PsLCwubm5uLi4t7e3t7e3tra2tLS0tLS0s7OzsrKysbGxsbGxsbGxsLCwr6+vr6+vr6+v
r6+vr6+vr6+vr6+vr6+vr6+vsLCwsLCwsbGxsbGxsrKys7OztLS0tbW1tra2t7e3t7e3uLi4ubm5
urq6urq6urq6urq6u7u7u7u7u7u7u7u7u7u7r6+vkJCQjo6OoaGhoaGhoaGhoaGhoKCgkZGRj4+P
uLi4ubm5uLi4t7e3t7e3tra2tLS0tLS0srKysbGxsbGxsLCwr6+vr6+vr6+vrq6ura2tra2tra2t
ra2tra2tra2tra2tra2tr6+vr6+vr6+vsLCwsbGxsbGxsrKytLS0tbW1tra2t7e3t7e3uLi4ubm5
urq6urq6urq6urq6u7u7u7u7u7u7u7u7u7u7urq6lJSUj4+PoaGhoaGhoaGhmZmZhISEsLCwtra2
tbW1tLS0tLS0s7OzsrKysbGxr6+vrq6ura2trKysrKysqqqqqqqqqqqqqampqampqampqKioqKio
qKioqKioqampqampqqqqqqqqqqqqrKysrKysra2tr6+vsLCwsbGxsrKytLS0tLS0tbW1tra2t7e3
t7e3t7e3t7e3uLi4uLi4uLi4uLi4uLi4uLi4tbW1jY2Nk5OToaGhoaGhjIyMnp6esrKysbGxsLCw
r6+vr6+vra2trKysq6urqqqqqKiop6enpqampaWlpKSkpKSkpKSko6Ojo6OjoqKioqKioqKioqKi
oqKioqKio6OjpKSkpKSkpKSkpqamp6enqKioqKioqqqqq6urra2trq6ur6+vsLCwsbGxsbGxsrKy
srKysrKys7Ozs7Ozs7Ozs7Ozs7Ozs7