view release on metacpan or  search on metacpan

lib/App/Chart/Gtk2/Diagnostics.pm  view on Meta::CPAN

# Copyright 2007, 2008, 2009, 2010, 2011, 2016 Kevin Ryde

# This file is part of Chart.
#
# Chart 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.
#
# Chart 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 Chart.  If not, see <http://www.gnu.org/licenses/>.


package App::Chart::Gtk2::Diagnostics;
use 5.010;
use strict;
use warnings;
use List::Util qw(min max);
use Scalar::Util;
use Gtk2;
use Locale::TextDomain ('App-Chart');

use Gtk2::Ex::Units;
use App::Chart;

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

use Glib::Object::Subclass 'Gtk2::Dialog';

sub popup {
  my ($class, $parent) = @_;
  require App::Chart::Gtk2::Ex::ToplevelBits;
  my $self = App::Chart::Gtk2::Ex::ToplevelBits::popup ($class,
                                                        screen => $parent);
  $self->refresh;
  return $self;
}

Gtk2::Rc->parse_string (<<'HERE');
style "Chart_fixed_width_font" {
  font_name = "Courier 12"
}
widget_class "App__Chart__Gtk2__Diagnostics.*.GtkTextView" style:gtk "Chart_fixed_width_font"
HERE

use constant RESPONSE_REFRESH => 0;

sub INIT_INSTANCE {
  my ($self) = @_;
  my $vbox = $self->vbox;

  $self->set_title (__('Chart: Diagnostics'));
  $self->add_buttons ('gtk-close'   => 'close',
                      'gtk-refresh' => RESPONSE_REFRESH);
  $self->signal_connect (response => \&_do_response);

  my $scrolled = Gtk2::ScrolledWindow->new;
  $scrolled->set_policy ('never', 'automatic');
  $vbox->pack_start ($scrolled, 1,1,0);

  my $textbuf = $self->{'textbuf'} = Gtk2::TextBuffer->new;
  $textbuf->set_text ('');

  my $textview = $self->{'textview'}
    = Gtk2::TextView->new_with_buffer ($textbuf);
  $textview->set (wrap_mode => 'char',
                  editable => 0);
  $scrolled->add ($textview);

  $vbox->show_all;

  # with a sensible rows and columns size for the TextView
  Gtk2::Ex::Units::set_default_size_with_subsizes
      ($self,
       [$textview, '60 ems', -1],
       [$scrolled, -1, '40 lines']);

  # 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);
}

sub _do_response {
  my ($self, $response) = @_;

  if ($response eq RESPONSE_REFRESH) {
    $self->refresh;

  } elsif ($response eq 'close') {
    # close signal as per a keyboard Esc close; it defaults to raising
    # 'delete-event', which in turn defaults to a destroy
    $self->signal_emit ('close');
  }
}

sub refresh {
  my ($self) = @_;
  ### refresh: "$self"
  my $textview = $self->{'textview'};

  # can be a bit slow counting the database the first time, so show busy
  require Gtk2::Ex::WidgetCursor;