view release on metacpan or  search on metacpan

lib/Log/Dispatch/TkText.pm  view on Meta::CPAN

package Log::Dispatch::TkText;

use strict;
use warnings;
use vars qw($VERSION);

use Tk;
use Tk::ROText ;
use Log::Dispatch::ToTk;
use base qw(Tk::Derived Tk::ROText);

$VERSION = '2.01';

Tk::Widget->Construct('LogText');

sub InitObject
  {
    my ($dw,$args) = @_ ;

    my %params ;
    foreach my $key (qw/name min_level max_level hide_label/)
      {
        $params{$key} = delete $args->{$key} if defined $args->{$key} ;
        $params{$key} = delete $args->{'-'.$key} if defined $args->{'-'.$key} ;
      }

    # 
    $dw->{logger} = Log::Dispatch::ToTk->new(%params, -widget => $dw) ;

    $dw->tagConfigure('label', 
                      -underline => 1,
                      -spacing1 => 3 , 
#                      -spacing3 => 3 ,
#                      -justify => 'center',
#                      -relief => 'raised' ,
#                      -borderwidth => 1
                     ) ;
    $dw->tagConfigure('message',
                      -spacing3 => 3 ,
                      -lmargin1 => 20 ,
                      -lmargin2 => 20
                     ) ;

    $dw->SUPER::InitObject($args) ;

  }

sub logger
  {
    my $dw = shift;
    return $dw->{logger} ;
  }

# Check "The perl/Tk widget extended mdethods" section in 
# "mastering Perl/Tk" for (some) explanations on Text menus

sub MenuLabels
  {
    my $dw = shift;
    return (qw[Fil~ter],$dw->SUPER::MenuLabels() ) ;
  }

sub FilterMenuItems
  {
     my ($dw) = @_;

     my @buttons ;

     #print "Tags are ",$dw->tagNames,"\n";