#!/pro/bin/perl

# perl/Tk interface to the perlbug database
# To be used for off-line Browsing of the perlbug database
# No updates supported (yet)

use strict;
use warnings;
our $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; 

use FindBin;
use lib "$FindBin::Bin/..";

use Getopt::Long qw(:config nopermute bundling bundling_override);

use Tk;
use Tk::Balloon;
use Tk::BrowseEntry;
use Tk::NoteBook;
use Tk::ROText;

use Perlbug::Interface::Tk;

$ENV{MYSQLDB} = "perlbug";

if ($Tk::VERSION >= 800.013) {
    Tk::CmdLine->LoadResources ();
    Tk::CmdLine->SetArguments ();
    }

my $opt_m = 0;	# Match direct (don't use regex matching)
my $opt_x = 0;
GetOptions (
    "x"    => \&$opt_x,
    "m"    => \&$opt_m,
    ) or usage ();

my @sel = qw(bugid admin
	     status category severity osname
	     fixed version
	     subject author body
	     note
	     );
my %sel;	# Legal options to choose from
my %pat;	# What we've selected to see
my %subs;
my %bug;
my @bug;	# Current selected set
my $bug_count;

my $top;
my %head;

$pat{bugid} = shift (@ARGV) || undef;

InitTU ();
SetList ();

MainLoop;

### ###########################################################################

sub usage
{
    print STDERR "usage: perlbug-db ...\n";
    exit 0;
    } # usage

sub to_background
{
    $^O eq "MSWin32" and return;
    my $pid = fork;
    if ($pid < 0) {
	print STDERR "Unable to run in the background, cannot fork: $!\n";
	exit $?;
	}
    $pid and exit 0;
    } # to_background

sub pat_reset ($)
{
    my $mask = $_[-1];

    if (length ($mask) > 2 and exists $pat{$mask}) {
	$pat{$mask} = "";
	$pat{prv}{$mask} = "?";
	}
    else {
	$mask = qr/^$mask/;

	"t" =~ $mask and $pat{bugid}    = "", $pat{prv}{bugid}    = "?";

	"a" =~ $mask and $pat{admin}    = "", $pat{prv}{admin}    = "?";

	"s" =~ $mask and $pat{status}   = "", $pat{prv}{status}   = "?";
	"c" =~ $mask and $pat{category} = "", $pat{prv}{category} = "?";
	"y" =~ $mask and $pat{severity} = "", $pat{prv}{severity} = "?";
	"o" =~ $mask and $pat{osname}   = "", $pat{prv}{osname}   = "?";

	"f" =~ $mask and $pat{fixed}    = "", $pat{prv}{fixed}    = "?";
	"v" =~ $mask and $pat{version}  = "", $pat{prv}{version}  = "?";

	"u" =~ $mask and $pat{author}   = "", $pat{prv}{author}   = "?";
	"j" =~ $mask and $pat{subject}  = "", $pat{prv}{subject}  = "?";
	"b" =~ $mask and $pat{body}     = "", $pat{prv}{body}     = "?";
	"n" =~ $mask and $pat{note}     = "", $pat{prv}{note}     = "?";
	}

    $pat{prv}{admin} = "refresh";
    (caller(1))[3] =~ m/::GetData$/ or DoOneEvent ();
    } # pat_reset

sub GetData ($)
{
    my $init = shift;

    if ($init) {
	pat_reset (".");
	}

    $init and print STDERR "Getting data .";
    {   my ($bugid, $subject, $sourceaddr);
	my $sth = prepex (
	    "select bugid,  subject,  sourceaddr",
	         \($bugid, $subject, $sourceaddr),
	    "from   pb_bug");
	while ($sth->fetch) {
	    $bugid =~ m/^\d+\.\d+$/ or next;
	    $bug{$bugid} = {
		bugid   => $bugid,
		subject => $subject,
		author  => $sourceaddr,
		};
	    }
	}

    {   no warnings 'syntax';
	foreach my $r ([qw( status   statusid,name   pb_status   )], 
		       [qw( category groupid,name    pb_group    )],
		       [qw( severity severityid,name pb_severity )],
		       [qw( version  versionid,name  pb_version  )],
		       [qw( fixed    changeid,name   pb_change   )],
		       [qw( admin    userid,name     pb_user     )],
		       [qw( osname   osnameid,name   pb_osname   )]) {
	    my ($base, $id, $val) = ($r->[0]);
	    $base ne "admin" and $sel{base}{$base}{v} = "";
	    my $sth = prepex ("select $r->[1]", \$id, \$val, "from $r->[2]");
	    while ($sth->fetch) {
		$sel{base}{$base}{$id} = $val;
		# presume 1:1 relation for base tables
		$sel{$base}{$val} = $id;
		# preserve for longest possible vec-match
		$id =~ m/^\d+$/ and vec ($sel{base}{$base}{v}, $id, 1) = 0;
		}
	    }
	}

    foreach my $bugid (keys %bug) {
	foreach my $sel (@sel) {
	    exists $sel{base}{$sel}{v} and
		$bug{$bugid}{$sel} = $sel{base}{$sel}{v};
	    }
	$bug{$bugid}{admin} = [];
	}

    foreach my $r ([qw( status   statusid   pb_bug_status   )],
		   [qw( category groupid    pb_bug_group    )],
		   [qw( severity severityid pb_bug_severity )],
		   [qw( version  versionid  pb_bug_version  )],
		   [qw( fixed    changeid   pb_bug_change   )],
		   [qw( admin    userid     pb_bug_user     )],
		   [qw( osname   osnameid   pb_bug_osname   )]) {
	my ($base, $bugid, $id) = ($r->[0]);
	my $sel = prepex (
	    "select bugid,  $r->[1]",
		  \$bugid, \$id,
	    "from  $r->[2]");
	while ($sel->fetch) {
	    exists $bug{$bugid} or next;
	    if ($base eq "admin") {
		push @{$bug{$bugid}{$base}}, $id;
		next;
		}
	    vec ($bug{$bugid}{$base}, $id, 1) = 1;
	    }
	}

    $bug{get_bug} = prepar (
	"select   header, body",
	 \@bug{qw{header  body}},
	"from     pb_bug",
	"where    bugid = ?");
    $bug{get_lst} = prepar (
	"select   messageid",
	    \$bug{messageid},
	"from     pb_bug_message",
	"where    bugid = ?",
	"order by created");
    $bug{get_msg} = prepar (
	"select   subject, sourceaddr, header, body",
	\@bug{qw(msubject  mauthor    mheader mbody)},
	"from     pb_message",
	"where    messageid = ?");

    $init and print STDERR "\n";
    } # GetData

# Promote for derived widget classes
sub Tk::bindDefKeys ($$)
{
    my $w = shift;

    $w->bind ("<Delete>"        => "Backspace");
#   $w->bind ("<Enter>"         => [ \&SetRealList ]);
    $w->bind ("<Return>"        => [ \&SetRealList ]);
#   $w->bind ("<Leave>"         => [ \&SetRealList ]);
    $w->bind ("<Control-Key-w>" => [ \&pat_reset, shift ]);
    $w->bind ("<Alt-Key-r>"     => [ \&pat_reset, "."   ]);
    $w;
    } # bindDefKeys

sub InitTU
{
    select ((select (STDERR), $| = 1)[0]);
    select ((select (STDOUT), $| = 1)[0]);

    GetData (1);

    to_background ();

    $top = MainWindow->new (
	-name   => "perlbug",
	-cursor => "top_left_arrow");
    $top->title ("Perl5 Bug database");

    my $ico = Tk::Toplevel->new ($top,
	-borderwidth => 0,
	-class       => 'Icon');
    $top->iconwindow ($ico);
    $top->iconname ("perlbug");

    $subs{SelBugs} = sub {};# SetList (); };

    my $bln = $top->Balloon (
	-foreground => "Blue4",
	-background => "LightYellow2");

    ########################### Basic layout ##################################

    # Set up some menubar here ...

    my %f = (
	search	=> $top->Frame (
			-relief  => "flat"  )->pack (
			    -side     => "top",
			    -expand   => 0,
			    -fill     => "x"),
	list	=> $top->Frame (
			-relief  => "sunken")->pack (
			    -side     => "left",
			    -expand   => 0,
			    -fill     => "y"),
	message	=> $top->Frame (
			-relief  => "sunken")->pack (
			    -side     => "left",
			    -expand   => 1,
			    -fill     => "both"),
	);

    my $NIndex = undef;
    my $NCurrent = sub {
	$NIndex || $bug{list}->index ("current");
	};

    ########################### Main search criteria ##########################

    my $f = $f{search}->Frame (-relief => "flat")->pack (qw(-side top -expand 0 fill x));

    foreach my $sel (qw(status category severity osname version fixed)) {
	#print STDERR "Preparing browse button for $sel\n";
	my $b = $f->BrowseEntry (
	    -relief             => "sunken",
	    -width              => 15,
	    -borderwidth        =>  1,
	    -highlightthickness =>  1,
	    -listwidth          => 50,
	    -variable           => \$pat{$sel},
	    -browsecmd          => $subs{SelBugs})->pack (
		-anchor => "w",
		-side   => "left")->bindDefKeys (substr ($sel, 0, 1));
	$bln->attach ($b, -msg => "Browse to select $sel");
	$b->insert ("end", undef);
	foreach my $s (sort keys %{$sel{$sel}}) {
	    $b->insert ("end", $s);
	    }
	}

    # -------------------------------------------------------------------------

    $f = $f{search}->Frame (-relief => "flat")->pack (qw(-side left  -expand 0 fill x));

    my $e = $f->Frame (-relief => "flat")->pack (qw(-side top expand 0 -fill x));
    foreach my $sel (qw(bugid admin)) {
	my $b = $e->BrowseEntry (
	    -relief             => "sunken",
	    -width              => 15,
	    -borderwidth        =>  1,
	    -highlightthickness =>  1,
	    -listwidth          => 50,
	    -variable           => \$pat{$sel},
	    -browsecmd          => $subs{SelBugs})->pack (
		-anchor => "w",
		-side   => "left")->bindDefKeys ($sel);
	$bln->attach ($b, -msg => "Browse to select $sel");
	$b->insert ("end", undef);
	foreach my $s (sort keys %{$sel{$sel}}) {
	    $b->insert ("end", $s);
	    }
	}
    $e->Label (
	-relief             => "flat",
	-width              => 8,
	-borderwidth        => 0,
	-highlightthickness => 0,
	-textvariable       => \$bug_count)->pack (
	    -anchor => "e",
	    -side   => "left");

    $f->Button (
	-text    => "search",
	-command => sub { SetList (); },
	)->pack (qw(-side left -expand 1 -fill both));
    $f->Button (
	-text    => "reset",
	-command => sub { pat_reset ("."); SetRealList (); },
	)->pack (qw(-side left -expand 1 -fill both));
    $f->Button (
	-text    => "quit",
	-command => \&exit,
	)->pack (qw(-side left -expand 1 -fill both));

    # -------------------------------------------------------------------------
    
    $f = $f{search}->Frame (-relief => "flat")->pack (qw(-side right -expand 0 fill x));

    foreach my $sel (qw(subject author body note)) {
$sel eq "note" and next;	# TEMP: NYI
	#print STDERR "Preparing selection button for $sel\n";
	my $e = $f->Frame (-relief => "flat")->pack (qw(-side top expand 0 -fill x));
	$e->Label (
	    -text       => ucfirst $sel,
	    -foreground => "Green4",
	    -anchor     => "c",
	    -width      => 8,
	    -relief     => "flat")->pack (
		-side => "left");
	my $b = $e->Entry (
	    -relief             => "sunken",
	    -width              => 60,
	    -borderwidth        =>  1,
	    -highlightthickness =>  1,
	    -textvariable       => \$pat{$sel})->pack (
		-anchor => "w",
		-side   => "left")->bindDefKeys ($sel);
	$bln->attach ($b, -msg => "Enter selection criterium for $sel");
	}

#   Optional stuff to remove the balloons etc. but the setup kinda needs them
#
#    $bln->attach (
#	$f->Checkbutton (
#	    -borderwidth        => 1,
#	    -highlightthickness => 0,
#	    -variable           => \$opt_m,
#	    -command            => [ \&pat_reset, "0" ])->pack (
#		-side => "left"),
#	-msg => "Klik hier om magic aan of uit te zetten in criteria");
#    my $rm_balloon;
#    $bln->attach (
#	$rm_balloon = $f->Checkbutton (
#	    -borderwidth        => 1,
#	    -highlightthickness => 0)->pack (
#		-side => "left"),
#	-msg => "Klik hier ballonnetjes te verwijderen");
#    $rm_balloon->configure (
#	-command => sub {
#	    # Change focus to remove current balloon
#	    $top->focusNext;
#	    $top->update;
#	    $top->after (10, sub {
#		$bln->destroy;
#		$rm_balloon->packForget;
#		});
#	    });
#    $opt_b and $top->after (100, sub { $rm_balloon->invoke });

    ########################### Main message window ###########################

    $f = $f{message}->Frame (-relief => "sunken")->pack (qw(-side top -expand 0 -fill x));
    foreach my $s (qw(status category severity osname version fixed admin)) {
	my $l = $f->Label (
	    -textvariable => \$bug{$s},
	    -foreground   => "Green4",
	    -anchor       => "c",
	    -width        => 12,
	    -relief       => "ridge")->pack (
		-side => "left");
	$bln->attach ($l, -msg => "This is the $s of the bug");
	$head{$s} = $l;
	}
    my $l = $f->Label (
	-textvariable => \$bug{msgcount},
	-foreground   => "Red4",
	-anchor       => "e",
	-width        => 6,
	-relief       => "flat")->pack (
	    -side => "left");
    $bln->attach ($l, -msg => "This is the message count of the bug");
    $head{msgcount} = $l;

    # -------------------------------------------------------------------------

    $f = $f{message}->Frame (-relief => "sunken")->pack (qw(-side top -expand 0 -fill x));

    $l = $f->Label (
	-textvariable => \$bug{bugid},
	-foreground   => "Red4",
	-anchor       => "c",
	-width        => 12,
	-relief       => "flat")->pack (
	    -side => "left");
    $bln->attach ($l, -msg => "This is the ID of the bug");
    $head{bugid} = $l;
    $l = $f->Label (
	-textvariable => \$bug{subject},
	-foreground   => "Blue4",
	-anchor       => "w",
	-width        => 8,
	-relief       => "sunken")->pack (
	    -expand => 1,
	    -fill   => "x",
	    -side   => "left");
    $bln->attach ($l, -msg => "This is the subject of the bug");
    $head{subject} = $l;
    $l = $f->Label (
	-text         => "author",
	-foreground   => "Blue4",
	-anchor       => "w",
	-width        => 15,
	-relief       => "sunken")->pack (
	    -expand => 0,
	    -fill   => "x",
	    -side   => "left");
    $bln->attach ($l, -msg => "This is the author of the bug");
    $head{author} = $l;

    # -------------------------------------------------------------------------

    my $nb = $f{message}->NoteBook ()->pack (qw(-side top -expand 1 -fill both));

    foreach my $page (0 .. 24) {
	$bug{message}[$page] = [ $nb, $nb->add ($page,
	    -label    => sprintf ("%2d", $page),
	    -state    => "disabled",
	    -raisecmd => sub {
		my $p = $nb->raised;
		$head{author}->configure (-text => $bug{message}[$p][2]);
		},
	    -anchor   => "nw")->Scrolled ("ROText",
		-scrollbars         => "osoe",
		-wrap               => "none",
		-borderwidth        =>  1,
		-highlightthickness =>  0,
		-width              => 70,
		-height             => 25)->pack (
		    -expand => 1,
		    -fill   => "both",
		    -side   => "top"), "author", "subject" ];
	}

    $bug{note} = $f{message}->Scrolled ("ROText",
	-scrollbars         => "osoe",
	-wrap               => "none",
	-borderwidth        =>  1,
	-highlightthickness =>  0,
	-width              => 70,
	-height             =>  5)->pack (
	    -expand => 1,
	    -fill   => "both",
	    -side   => "top");

    ########################################## Search results #################

    $f = $f{list};

    my $lastActive = "";

    my $NMotion = sub {
	my $e = $bug{list}->XEvent;
	my ($x, $y) = ($e->x, $e->y);
	my $newLine = $bug{list}->index ("\@$x,$y linestart");
	if ($newLine ne $lastActive) {
	    $bug{list}->tagRemove ("active", "1.0", "end");
	    $lastActive = $newLine;
	    $bug{list}->tagAdd ("active", $lastActive, "$lastActive lineend");

	    my $bugid = $bug[int ($lastActive) - 1];
	    @bug{qw(bugid subject author)} =
		@{$bug{$bugid}}{qw(bugid subject author)};
	    foreach my $s (qw(status category severity osname version fixed admin)) {
		no warnings;
		my $v = $bug{$bugid}{$s};
		if (ref $v) {
		    $bug{$s} = join ", ", @$v;
		    next;
		    }
		my $i = 0;
		$bug{$s} = join ", " => grep m/\S/ => map {
		    my $id = $_ * $i++;
		    $id ? $sel{base}{$s}{$id} : "";
		    } split m// => unpack "b*", $v;
		}

	    $bug{get_bug}->execute ($bugid);
	    $bug{get_bug}->fetch;
	    foreach my $page (0 .. 24) {
		$bug{message}[$page][0]->pageconfigure ($page, -state => "disabled");
		$bug{message}[$page][1]->delete ("0.0", "end");
		}
	    my $page = 0;
	    $bug{message}[$page][0]->pageconfigure ($page, -state => "normal");
	    $bug{message}[$page][2] = $bug{author};
	    $bug{message}[$page++][1]->insert ("end", $bug{body});

	    $bug{get_lst}->execute ($bugid);
	    while ($bug{get_lst}->fetch) {
		$bug{message}[$page][0]->pageconfigure ($page, -state => "normal");
		$bug{get_msg}->execute ($bug{messageid});
		$bug{get_msg}->fetch or
		    @bug{qw(msubject mauthor mheader mbody)} = ("?", "?", "ERROR");
		$bug{message}[$page][2] = $bug{mauthor};
		$bug{message}[$page][3] = $bug{msubject};
		$bug{message}[$page++][1]->insert ("end", $bug{mbody});
		}
	    $bug{msgcount} = $page;

	    $bug{message}[0][0]->raise (0);
	    $bug{author} = $bug{message}[0][2];
	    while (my ($k, $w) = each %head) {
		$w->configure (-text => $bug{$k});
		$w->update;
		}

#:	    $bug{note}->delete ("0.0", "end");
#:	    $bug{sql_notelist}->execute ($bugid);
#:	    while ($bug{sql_notelist}->fetch) {
#:		$bug{sql_notes}->execute ($bug{noteid});
#:		$bug{sql_notes}->fetch or
#:		    @bug{qw(noteauthor noteheader notebody)} = ("?", "?", "ERROR");
#:		$bug{note}->insert ("end",
#:		    sprintf "%5d %-20.20s %s\n", @bug{qw(noteid noteauthor notebody)});
#:		}
	    }
	};
    my $NLock = sub {
#	#$LblLock->configure (-text => "<1> Move");
#	$LblLock->configure (-fg => "Orange4");
	$bug{list}->tagBind ("all", "<Motion>" => sub {});
	$NIndex = $bug{list}->index ("current");
	};
    $subs{NUnlock} = sub {
#	#$LblLock->configure (-text => "<1> Lock");
#	$LblLock->configure (-fg => "Blue4");
	$bug{list}->tagBind ("all", "<Motion>" => $NMotion);
	$NIndex = undef;
	};

    $bug{list} = $f->Scrolled ("ROText",
	-scrollbars         => "osoe",
	-wrap               => "none",
	-borderwidth        =>  1,
	-highlightthickness =>  0,
	-width              => 13,
	-height             => 25)->pack (
	    -fill   => "both",
	    -expand => 1,
	    -side   => "top")->Subwidget ("scrolled");
    $bug{list}->bindDefKeys ("-");
    $bug{list}->tagConfigure ("active",
	-relief      => "raised",
	-borderwidth => 1);
    $bug{list}->tagBind ("all",
	"<Motion>" => $NMotion,
#	"<Key-Up>" => $NMotion	# Here I want to enable Up-Arrow and Down-Arrow
	);

#    ### Popup menu on <3> and other fun
#
#    my $Actions = $bug{list}->Menu;
#
#    my $NToggle = sub {
#	if (defined $NIndex) { &{$subs{NUnlock}} } else { &$NLock }
#	#&$NNotes;
#	&$NMotion;
#	};
#
#    $Actions->command (-label        => "~Desk",
#		       -command      => $NDesk);
#    $Actions->separator;
#    $Actions->command (-label        => "~Notes",    -accelerator => "  <1>",
#		       -command      => $NNotes);
#    $Actions->command (-label        => "~Address",  -accelerator => "S-<1>",
#		       -command      => $NAddr);
#    $Actions->separator;
##   $Actions->command (-label        => "~Hide",
##		       -command      => sub {
##			    # Change focus to remove current balloon
##			    $top->focusNext;
##			    $top->update;
##			    $top->after (10, sub {
##				$Actions->withdraw;
##				})
##			    });
#
#    $bug{list}->tagBind ("all", "<Button-1>"         => $NToggle);
#    $bug{list}->tagBind ("all", "<Button-2>"         => $NMach);
#    # As of 800.015, <3> is bound to default popup window (thanks Nick :-((
#    $bug{list}->bind ("Tk::ROText", "<Button-3>"     => sub {
#	$Actions->Popup (-popover   => "cursor",
#	                 -popanchor => "w");
#	$Actions->break;
#	});
#    $bug{list}->tagBind ("all", "<Shift-Button-1>"   => $NAddr);
#    $bug{list}->tagBind ("all", "<Shift-Button-2>"   => $NModem);
#    $bug{list}->tagBind ("all", "<Shift-Button-3>"   => $NCall);
#
#    $bug{list}->tagBind ("all", "<Control-Button-1>" => $NMail);
#    $bug{list}->tagBind ("all", "<Control-Button-3>" => $NAddr);
#    $bug{list}->tagBind ("all", "<Control-Button-3>" => $NCallFTP);
#
#    $top->update;
#    my $g = $top->geometry;
#    # Fit 10 lines + scrollbar or 11 lines
#    $g =~ m/x(\d+)/ and
#	$1 < 370 and
#	$g =~ s/x$1/x370/ and
#	$top->geometry ($g);
#
#    $opt_i and $top->iconify;
    } # InitTU

sub SetList
{
    $top->state eq "iconic" and return;

    local $" = "";	# "
    "@pat{@sel}" eq "@{$pat{prv}}{@sel}" and return;

#   &{$subs{NUnlock}};
    $bug{list}->DoWhenIdle (\&SetRealList);
    } # SetList

sub match ($$)
{
    my ($bugid, $sel) = @_;
    defined $pat{regex}{$sel} or return 1;
    exists $sel{base}{$sel}{v} and
	return (($bug{$bugid}{$sel} & $pat{v}{$sel}) ne $sel{base}{$sel}{v});

    my $p = $pat{regex}{$sel};
    $sel eq "admin" and
	return grep { $opt_m ? index $_, $p : $_ =~ $p } @{$bug{$bugid}{admin}};

    my $s = $sel eq "bugid" ? $bugid : $bug{$bugid}{$sel} or return 0;
    $opt_m ? index $s, $p : $s =~ $p;
    } # match

sub SetRealList
{
    $top->Busy;

    @{$pat{prv}}{@sel} = @pat{@sel};

    foreach my $sel (@sel) {
	my $p = $pat{$sel};
	unless (defined $p && $p ne "") {
	    $pat{regex}{$sel} = undef;
	    next;
	    }
	if ($opt_m) {
	    $pat{regex}{$sel} = uc $p;
	    }
	else {
	    do { # Invalid pattern (might be still incomplete)
		eval {'' =~ m/$p/};
		} while ($@ and chop $p);
	    $p = $pat{regex}{$sel} = qr/$p/i;
	    }
	$sel eq "bugid" and next;
	$sel eq "admin" and next;
	if (exists $sel{base}{$sel}) {
	    my $v = $sel{base}{$sel}{v};
	    foreach my $val (keys %{$sel{$sel}}) {
		$opt_m ? substr $val, $p : $val =~ $p and
		    vec ($v, $sel{$sel}{$val}, 1) = 1;
		}
	    $pat{v}{$sel} = $v;
	    }
	}

    @bug = reverse sort grep {
        m/^\d/                 and
    	match ($_, "bugid")    and
    	match ($_, "subject")  and
    	match ($_, "author")   and
    	match ($_, "admin")    and
    	match ($_, "status")   and
    	match ($_, "category") and
    	match ($_, "severity") and
    	match ($_, "osname")   and
    	match ($_, "fixed")    and
    	match ($_, "version")  and
    	# ? body
    	# ? note
	1
	} keys %bug;

    $bug{list}->delete ("1.0", "end");
    foreach my $tid (@bug) {
	my @tags = ("all");
	$bug{list}->insert ("end", "$tid\n", \@tags);
	}
    $bug_count = scalar @bug;

    $top->Unbusy;
    } # SetRealList
