Question

我写了一个perl / tk gui。 stderr＆amp; stdout写入弹出窗口，但是弹出窗口被销毁时我无法清除文本（实际上它已被撤销）。我无法安装Tk :: Stderr所以我将模块附加到我的脚本的末尾。以下是一个工作示例。

我已将以下行添加到Print子例程中，但它有点过分：

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

我怀疑是可以将某些内容添加到Populate子例程中的以下行：

$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

据我所知，保留文本小部件内容的行为是正确的。关闭弹出窗口时，窗口小部件不会被销毁，但会保持不变并附加任何新信息。

Tk :: Stderr空文本子小部件

2 个答案: