view release on metacpan or  search on metacpan

lib/App/MathImage/Tk/Diagnostics.pm  view on Meta::CPAN

# Copyright 2011, 2012, 2013 Kevin Ryde

# This file is part of Math-Image.
#
# Math-Image is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-Image is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-Image.  If not, see <http://www.gnu.org/licenses/>.

package App::MathImage::Tk::Diagnostics;
use 5.008;
use strict;
use warnings;
use List::Util 'max';
use Tk;
use Tk::Balloon;
use Locale::TextDomain 1.19 ('App-MathImage');

# uncomment this to run the ### lines
#use Smart::Comments;

use base 'Tk::Derived', 'Tk::DialogBox';
Tk::Widget->Construct('AppMathImageTkDiagonostics');

our $VERSION = 110;

sub Populate {
  my ($self, $args) = @_;
  ### Diagnostics Populate() ...

  my $balloon = $self->Balloon;

  my $cname = __('Close');
  my $rname = __('Refresh');
  %$args = (-title => __('Math-Image: Diagnostics'),
            -buttons => [ $cname, $rname ],
            -cancel_button => $cname,
            %$args);
  $self->SUPER::Populate($args);

  {
    my $rbutton = $self->Subwidget("B_$rname");
    $rbutton->configure (-command => [ $self, 'refresh' ]);
  }
  {
    my $cbutton = $self->Subwidget("B_$cname");
    $cbutton->configure (-command => [ $self, 'withdraw' ]);
  }

  $self->Component('Label','label',
                   -text => __('Diagnostics'))
    ->pack;

  my $text = $self->Scrolled('Text',
                              -wrap   => 'word',
                              -width  => 60,
                              -height => 40);
  $self->Advertise (text => $text);
  $text->pack(-fill => 'both');
  $text->focus;

  #   # limit to 80% screen height
  #   my ($width, $height) = $self->get_default_size;
  #   $height = min ($height, 0.8 * $self->get_screen->get_height);
  #   $self->set_default_size ($width, $height);

  $self->refresh;
}

sub refresh {
  my ($self) = @_;
  ### Diagnostics refresh(): "$self"
  my $text = $self->Subwidget('text');

  $text->configure (-cursor => 'watch');
  $text->Contents ($self->str);
  $text->configure (-cursor => undef);
}

sub str {
  my ($class_or_self) = @_;
  my $self = ref $class_or_self ? $class_or_self : undef;