Tk :: Stderr空文本subwidget

Question

我写过perl/tk gui。 stderr &标准输出写入一个弹出窗口，但当弹出窗口被销毁时（它实际上被撤销），我无法清除文本。我无法安装Tk :: Stderr，因此我将模块附加到脚本的末尾。以下是一个工作示例。

我已经添加了以下行打印子程序，却是矫枉过正：

$text->delete('0.0', 'end'); 

我怀疑是东西可以被添加到在填充子程序的下面一行：

$mw->protocol(WM_DELETE_WINDOW => [ $mw => 'withdraw']); 

但我不知道是什么。我将不胜感激任何帮助。

#!/usr/bin/perl 

use warnings; 
use strict; 
use Tk; 
# use Tk::Stderr; << ** pasted module after main ** - honyok 

# create main window 
my $mw = MainWindow->new; 
$mw->InitStderr; 
$mw->optionAdd("*font", "-*-calibri-normal-r-*-*-*-120-*-*-*-*-*-*"); 
$mw->protocol('WM_DELETE_WINDOW'=> sub{exit}); 
$mw->geometry("100x100"); 
$mw->resizable(0,0);# not resizable 
# create buttons 
my $button1=$mw->Button(-text=>'STDERR',-command=>[sub{print STDERR "Writing to STDERR\n";}])->pack; 
my $button2=$mw->Button(-text=>'STDOUT',-command=>[sub{print STDOUT "Writing to STDOUT\n";}])->pack; 

MainLoop; 
# =========================== end main ================================== 


##============================================================================== 
## Tk::Stderr - capture program standard error output 
##============================================================================== 
## $Id: Stderr.pm,v 1.2 2003/04/01 03:58:42 kevin Exp $ 
##============================================================================== 
#require 5.006; 
package Tk::Stderr; 
use strict; 
use warnings; 
use vars qw($VERSION @ISA); 
($VERSION) = q$Revision: 1.2 $ =~ /Revision:\s+(\S+)/ or $VERSION = "0.0"; 
use base qw(Tk::Derived Tk::MainWindow); 

use Tk::ROText; 
use Tk::Frame; 

##============================================================================== 
## Populate 
##============================================================================== 
sub Populate { 
    my ($mw, $args) = @_; 
    my $private = $mw->privateData; 
    $private->{ReferenceCount} = 0; 
    $private->{Enabled} = 0; 

    $mw->SUPER::Populate($args); 

    $mw->withdraw; 
    $mw->protocol(WM_DELETE_WINDOW => [ $mw => 'withdraw']); 
    my $f = $mw->Frame(
     Name => 'stderr_frame', 
    )->pack(-fill => 'both', -expand => 1); 

    my $text = $f->Scrolled(
     'ROText', 
     Name => 'stderr_text', 
     -scrollbars => 'se', 
     -label=>'Output/Errors', 
     -wrap => 'none' 
     #-background=>'slate grey' 
    )->pack(-fill => 'both', -expand => 1); 

    $mw->Advertise('text' => $text); 
    $mw->ConfigSpecs(
     '-title' => [ qw/METHOD title Title/, "truGrid" ], 
    ); 

    $mw->Redirect(1); 
    return $mw; 
} 

##============================================================================== 
## Redirect 
##============================================================================== 
sub Redirect { 

    my ($mw, $boolean) = @_; 
    my $private = $mw->privateData; 
    my $old = $private->{Enabled}; 

    if ($old && !$boolean) { 
     untie *STDOUT;# ** hacked this line ** - honyok 
     untie *STDERR; 
     $SIG{__WARN__} = 'DEFAULT'; 
    } elsif (!$old && $boolean) { 
     tie *STDOUT, 'Tk::Stderr::Handle', $mw;# ** hacked this line ** - honyok 
     tie *STDERR, 'Tk::Stderr::Handle', $mw; 
     $SIG{__WARN__} = sub { print STDOUT @_ };# ** hacked this line ** - honyok 
     $SIG{__WARN__} = sub { print STDERR @_ }; 
    } 
    $private->{Enabled} = $boolean; 
    return $old; 
} 


##============================================================================== 
## DecrementReferenceCount 
##============================================================================== 
sub DecrementReferenceCount { 
    my ($mw) = @_; 
    my $private = $mw->privateData; 

    if (--$private->{ReferenceCount} <= 0) { 
     $mw->destroy; 
    } 
} 

##============================================================================== 
## IncrementReferenceCount 
##============================================================================== 
sub IncrementReferenceCount { 
    my ($mw) = @_; 
    my $private = $mw->privateData; 

    ++$private->{ReferenceCount}; 
} 


package MainWindow; 
use strict; 
use warnings; 

my $error_window; 

##============================================================================== 
## InitStderr 
##============================================================================== 
sub InitStderr { 
    my ($mw, $title) = @_; 

    unless (defined $error_window) { 
     $error_window = Tk::Stderr->new; 
     $error_window->title($title) if defined $title; 
    } 
    $error_window->IncrementReferenceCount; 
    $mw->OnDestroy([ 'DecrementReferenceCount' => $error_window ]); 
    return $mw; 
} 

##============================================================================== 
## StderrWindow 
##============================================================================== 
sub StderrWindow { 
    return $error_window; 
} 

##============================================================================== 
## RedirectStderr 
##============================================================================== 
sub RedirectStderr { 
    my ($mw, $boolean) = @_; 

    unless (defined $error_window) { 
     $mw->InitStderr if $boolean; 
     return; 
    } 
    return $error_window->Redirect($boolean); 
} 


##============================================================================== 
## Define the handle that actually implements things. 
##============================================================================== 
BEGIN { 
    package Tk::Stderr::Handle; 
    use strict; 
    use warnings; 

    ##========================================================================== 
    ## TIEHANDLE 
    ##========================================================================== 
    sub TIEHANDLE { 
     my ($class, $window) = @_; 
     bless \$window, $class; 
    } 

    ##========================================================================== 
    ## PRINT 
    ##========================================================================== 
    sub PRINT { 
     my $window = shift; 
     my $text = $$window->Subwidget('text'); 
     $text->insert('end', $_) foreach (@_); 
     $text->see('end'); 
     $$window->deiconify; 
     $$window->raise; 
     $$window->focus; 
     $$window->update;# ** hacked this line ** - honyok 
    } 

    ##========================================================================== 
    ## PRINTF 
    ##========================================================================== 
    sub PRINTF { 
     my ($window, $format) = splice @_, 0, 2; 

     $window->PRINT(sprintf $format, @_); 
    } 
} 
1; 
##============================================================================== 
## $Log: Stderr.pm,v $ 
## Revision 1.2 2003/04/01 03:58:42 kevin 
## Add RedirectStderr method to allow redirection to be switched on and off. 
## 
## Revision 1.1 2003/03/26 21:48:43 kevin 
## Fix dependencies in Makefile.PL 
## 
## Revision 1.0 2003/03/26 19:11:32 kevin 
## Initial revision 
##============================================================================== 

Answer 1

（回答了另一个论坛。）

替换：

$mw->protocol(WM_DELETE_WINDOW => [ $mw => 'withdraw' ]); 

有：

$mw->protocol(WM_DELETE_WINDOW => [ $mw => 'OnWithdraw' ]); 

定义子程序：

sub OnWithdraw{ 
    my $window = shift; 
    my $text = $window->Subwidget('text'); 
    $text->delete('0.0', 'end'); 
    $window->withdraw; 
    return; 
} 

Answer 2

据我所看到的，在离开文本组件的内容的行为是正确的。 关闭弹出窗口时，窗口小部件不会被销毁，但会保持原样并附加任何新信息。