# Copyright 2007, 2008, 2009, 2010 Kevin Ryde

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


package Gtk2::Ex::ErrorTextDialog;
use 5.008001; # for utf8::is_utf8()
use strict;
use warnings;
use Gtk2;
use List::Util 'max';
use Locale::TextDomain 1.16; # version 1.16 for bind_textdomain_filter()
use Locale::TextDomain ('Gtk2-Ex-ErrorTextDialog');
use Locale::Messages;
use POSIX ();
use Glib::Ex::ObjectBits;
use Gtk2::Ex::Units 14; # version 14 for char_width

our $VERSION = 8;

# set this to 1 for some diagnostic prints
use constant DEBUG => 0;

Locale::Messages::bind_textdomain_codeset ('Gtk2-Ex-ErrorTextDialog','UTF-8');
Locale::Messages::bind_textdomain_filter  ('Gtk2-Ex-ErrorTextDialog',
                                           \&Locale::Messages::turn_utf_8_on);

use Glib::Object::Subclass
  'Gtk2::MessageDialog',
  signals => { clear
               => { param_types => [],
                    return_type => undef,
                    class_closure => \&_do_clear,
                    flags => ['run-last','action'] },
               popup_save_dialog
               => { param_types => [],
                    return_type => undef,
                    class_closure => \&_do_popup_save_dialog,
                    flags => ['run-last','action'] },
               destroy => \&_do_destroy,
             },

  properties => [ Glib::ParamSpec->int
                  ('max-chars',
                   'max-chars',
                   'Maximum number of characters to retain, or -1 for unlimited.',
                   -1,                 # minimum
                   POSIX::INT_MAX(),   # maximum
                   200_000,            # default
                   Glib::G_PARAM_READWRITE) ];

use constant {
              # not yet documented
              _RESPONSE_CLEAR   => 0,
              _RESPONSE_SAVE    => 1,
              # _NEXT_RESPONSE    => 2,

              # not yet documented ...
              _MESSAGE_SEPARATOR => "--------\n",
             };

my $instance;
our @_instance_pending;

sub instance {
  my ($class) = @_;
  if (! $instance) {
    $instance = $class->new;
    $instance->signal_connect (delete_event=>\&Gtk2::Widget::hide_on_delete);
  }
  return $instance;
}

# return true if $class_or_self is the shared $instance
sub _is_instance {
  my ($class_or_self) = @_;
  return (! ref $class_or_self  # class name means the instance
          || ($instance && $class_or_self == $instance));
}

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

  {
    my $title = __('Errors');
    if (defined (my $appname = Glib::get_application_name())) {
      $title = "$appname: $title";
    }
    $self->set_title ($title);
  }
  $self->set (message_type => 'error',
              resizable => 1);

  {
    my $check = $self->{'popup_checkbutton'}
      = Gtk2::CheckButton->new_with_mnemonic (__('_Popup on Error'));
    $check->set_active (1);
    Glib::Ex::ObjectBits::set_property_maybe
        ($check,
         # tooltip-text new in Gtk 2.12
         tooltip_text => __('Whether to popup this dialog when an error occurs.
If errors are occurring repeatedly you might not want a popup every time.'));

    $self->add_action_widget ($check, 'none');
  }
  {
    my $button = $self->add_button ('gtk-save-as', _RESPONSE_SAVE);
    Glib::Ex::ObjectBits::set_property_maybe
        ($button,
         # tooltip-text new in Gtk 2.12
         tooltip_text => __('Save the error messages to a file, perhaps to include in a bug report.
(Cut and paste works too, but saving may be better for very long messages.)'));
  }
  $self->add_buttons ('gtk-clear' => _RESPONSE_CLEAR,
                      'gtk-close' => 'close');

  # connect to self instead of a class handler because as of Gtk2-Perl 1.220
  # a Gtk2::Dialog class handler for 'response' is called with response IDs
  # as numbers, not enum strings like 'close'
  $self->signal_connect (response => \&_do_response);

  my $vbox = $self->vbox;

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

  my $textbuf = $self->{'textbuf'} = Gtk2::TextBuffer->new;
  $textbuf->signal_connect ('changed', \&_do_textbuf_changed, $self);
  _do_textbuf_changed ($textbuf, $self);  # initial settings

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

  $vbox->show_all;
  $self->set_default_size_chars (70, 20);
}

# 'destroy' class closure
# this can be called more than once!
sub _do_destroy {
  my ($self) = @_;
  if (DEBUG) { print "ErrorTextDialog destroy $self\n"; }

  # Break circular reference from $textbuf 'changed' signal userdata $self.
  # Nothing for $self->{'save_dialog'} as it's destroy-with-parent already.
  delete $self->{'textbuf'};

  if ($self->_is_instance) {
    # ready for subsequence instance() call to make a new one
    undef $instance;
  }
  $self->signal_chain_from_overridden;
}

# 'changed' signal on the textbuf
sub _do_textbuf_changed {
  my ($textbuf, $self) = @_;
  if (DEBUG) { print "ErrorTextDialog textbuf changed\n"; }
  my $any_errors = ($textbuf->get_char_count != 0);
  _message_dialog_set_text ($self, $any_errors
                            ? __('An error has occurred')
                            : __('No errors'));
  $self->set_response_sensitive (_RESPONSE_CLEAR, $any_errors);
}

# set_default_size() based on desired size_request() with a sensible rows
# and columns size for the TextView.  This is just a default, the user can
# resize to smaller.  Must have 'resizable' turned on in INIT_INSTANCE above
# to make this work (the default from GtkMessageDialog is resizable false).
#
# not documented yet ...
sub set_default_size_chars {
  my ($self, $width_chars, $height_lines) = @_;
  my $textview = $self->{'textview'};
  my $scrolled = $textview->get_parent;

  # Width set on textview so the vertical scrollbar is added on top.  But
  # height set on the scrolled since its vertical scrollbar means any
  # desired height from the textview is ignored.
  #
  Gtk2::Ex::Units::set_default_size_with_subsizes
      ($self,
       [ $scrolled, -1, $height_lines*Gtk2::Ex::Units::line_height($textview)],
       [ $textview, "$width_chars chars", -1 ]);
}

#-----------------------------------------------------------------------------
# button/response actions

sub _do_response {
  my ($self, $response) = @_;
  if ($response eq _RESPONSE_CLEAR) {
    $self->clear;

  } elsif ($response eq _RESPONSE_SAVE) {
    $self->popup_save_dialog;

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

sub clear {
  my ($self) = @_;
  $self = $self->instance unless ref $self;
  $self->signal_emit ('clear');
}
sub _do_clear {
  my ($self) = @_;
  my $textbuf = $self->{'textbuf'};
  $textbuf->delete ($textbuf->get_start_iter, $textbuf->get_end_iter);
}

sub popup_save_dialog {
  my ($self) = @_;
  $self = $self->instance unless ref $self;
  $self->signal_emit ('popup-save-dialog');
}
sub _do_popup_save_dialog {
  my ($self) = @_;
  $self->_save_dialog->present;
}

# create and return the save dialog -- might make this public one day
sub _save_dialog {
  my ($self) = @_;
  return ($self->{'save_dialog'} ||= do {
    require Gtk2::Ex::ErrorTextDialog::SaveDialog;
    my $save_dialog = Gtk2::Ex::ErrorTextDialog::SaveDialog->new;
    # set_transient_for() is always available, whereas 'transient-for' as
    # property only since gtk 2.10
    $save_dialog->set_transient_for ($self);
    $save_dialog
  });
}

#-----------------------------------------------------------------------------
# messages

sub get_text {
  my ($self) = @_;
  return $self->{'textbuf'}->get('text');
}

sub add_message {
  my ($self, $msg) = @_;
  if (DEBUG) { print "add_message()\n"; }
  $self = $self->instance unless ref $self;

  require Gtk2::Ex::ErrorTextDialog::Handler;
  my $textbuf = $self->{'textbuf'};
  my @msgs;

  if ($self->_is_instance && @_instance_pending) {
    if (DEBUG) { print "  ", scalar(@_instance_pending), " pending\n"; }

    # copy the global in case some warning from the code here extending it,
    # making an infinite loop
    @msgs = @_instance_pending;
    @_instance_pending = ();

    foreach my $pending (@msgs) {
      $pending = Gtk2::Ex::ErrorTextDialog::Handler::_maybe_locale_bytes_to_wide ($pending);
      if ($pending !~ /\n$/) { $pending .= "\n"; }
    }

    # Various internal Perl_warn() and Perl_warner() calls have the warning
    # followed immediately by a second warn call with an extra remark about
    # what might be wrong.  The extras begin with a tab, join them up to the
    # initial warning instead of a separate message.  Do this after
    # bytes->wide crunch, just in case one is wide and the other bytes.
    #
    # The initial message and any continuations are always in
    # @_instance_pending together, because the idle handler deferring lets
    # the continuation go through $SIG{__WARN__} before the code here runs.
    #
    # die() gives similar tab continuations when "propagating" an error (see
    # L<perlfunc/die>), but in that case it's within a single string so
    # needs nothing special.
    #
    for (my $i = 0; $i < $#msgs; ) {
      if ($msgs[$i+1] =~ /^\t/) {
        $msgs[$i] .= splice @msgs, $i+1, 1;
      } else {
        $i++;
      }
    }
  }

  if (defined $msg) {
    $msg = Gtk2::Ex::ErrorTextDialog::Handler::_maybe_locale_bytes_to_wide ($msg);
    if ($msg !~ /\n$/) { $msg .= "\n"; }
    push @msgs, $msg;
  }

  # can have no messages here if the idle handler for @_instance_pending
  # runs after that array has been crunched by an explicit add_message()
  # call
  if (@msgs) {
    if ($textbuf->get_char_count) {
      unshift @msgs, ''; # want separator after existing textbuf text
    }
    my $text = join (_MESSAGE_SEPARATOR, @msgs);
    $textbuf->insert ($textbuf->get_end_iter, $text);
    _truncate ($self);
  }
}

sub _truncate {
  my ($self) = @_;
  my $max_chars = $self->get('max-chars');
  return if ($max_chars == -1);

  my $textbuf = $self->{'textbuf'};
  my $len = $textbuf->get_char_count;
  # extra 82 for $discard_message, possibly translated, and "\n\n"
  return if ($len <= $max_chars + 82);

  # TRANSLATORS: The code currently assumes this string is 80 chars or less.
  my $discard_message = __('[Older messages discarded]');

  $textbuf->delete ($textbuf->get_start_iter,
                    $textbuf->get_iter_at_offset ($len - $max_chars));
  $textbuf->insert ($textbuf->get_start_iter,
                    "$discard_message\n\n");
}

# not sure about this yet, an in particular which popup follows the
# popup-on-error checkbox and which is a programmatic always popup ...
#
# =item C<< Gtk2::Ex::ErrorTextDialog->popup_add_message ($str) >>
#
# =item C<< Gtk2::Ex::ErrorTextDialog->popup_add_message ($str, $parent) >>
#
# =item C<< $errordialog->popup_add_message ($str) >>
#
# =item C<< $errordialog->popup_add_message ($str, $parent) >>
#
# Add C<$str> to the error dialog with C<add_message> below, and popup the
# dialog so it's visible.
#
# Optional C<$parent> is a widget which the error relates to, or C<undef> for
# none.  C<$parent> may help the window manager position the error dialog when
# first displayed, but is not used after that.
#
# not documented yet ...
sub popup_add_message {
  my ($self, $msg, $parent) = @_;
  $self = $self->instance unless ref $self;

  if ($self->{'popup_checkbutton'}->get_active) {
    $self->popup ($parent);
  }
  $self->add_message ($msg);
}
# not documented yet ...
sub popup {
  my ($self, $parent) = @_;
  $self = $self->instance unless ref $self;

  if ($self->mapped) {
    $self->window->raise;
  } else {
    # allow for $parent a non-toplevel
    if ($parent) { $parent = $parent->get_toplevel; }
    $self->set_transient_for ($parent);
    $self->present;
    $self->set_transient_for (undef);
  }
}

# ENHANCE-ME: would prefer to show the same string as
# g_log_default_handler(), or even what gperl_log_handler() gives
sub _log_to_string {
  my ($log_domain, $log_level, $message) = @_;

  $log_level -= ['recursion','fatal'];
  $log_level = join('-', @$log_level) || 'LOG';

  return (($log_domain ? "$log_domain-" : "** ")
          . "\U$log_level\E: "
          . (defined $message ? $message : "(no message)"));
}

# probably not wanted ...
# sub popup_add_log {
#   my ($class_or_self, $log_domain, $log_level, $message, $parent) = @_;
#   $self->popup ($parent);
#   $self->add_log ($log_domain, $log_level, $message);
# }
# sub add_log {
#   my ($class_or_self, $log_domain, $log_level, $message) = @_;
#   $class_or_self->add_message
#     (_log_to_string ($log_domain, $log_level, $message));
# }

#-----------------------------------------------------------------------------
# generic helpers

# _message_dialog_set_text() sets the text part of a Gtk2::MessageDialog.
# Gtk 2.10 up has this as a 'text' property, or in past versions it's
# necessary to dig out the label child widget.
#
# It doesn't work to choose between the dialog or sub-widget and to make a
# set() or set_text() call on.  Gtk2::MessageDialog doesn't have a
# set_text() method, and Gtk2::Label doesn't have a 'text' property, so must
# have separate code for the old or new gtk.
#
# This is in a BEGIN block so the unused sub is garbage collected.
#
BEGIN {
  *_message_dialog_set_text = Gtk2::MessageDialog->find_property('text')
    ? sub {
      my ($dialog, $text) = @_;
      $dialog->set (text => $text);
    }
      : sub {
        my ($dialog, $text) = @_;
        my $label = ($dialog->{__PACKAGE__.'--text-widget'} ||= do {
          require List::Util;
          my $l;
          my @w = grep {$_->isa('Gtk2::HBox')} $dialog->vbox->get_children;
          for (;;) {
            if (! @w) {
              require Carp;
              Carp::croak ('_message_dialog_text_widget(): oops, label not found');
            }
            $l = List::Util::first (sub {ref $_ eq 'Gtk2::Label'}, @w)
              and last;
            @w = map {$_->isa('Gtk2::Box') ? $_->get_children : ()} @w;
          }
          $l
        });
        $label->set_text ($text);
      };
}

1;
__END__

# Unused stuff:

  #   {
  #     my $nopopup = $self->{'nopopup'}
  #       = Gtk2::CheckButton->new_with_mnemonic (__('_No Popup'));
  #     if ($nopopup->can('set_tooltip_text')) {
  #       # new style of Gtk 2.12
  #       $nopopup->set_tooltip_text
  #         (__('Check this to not popup automatically.
  # Messages are recorded, but the dialog is not popped up.
  # This is good to ignore a cascade of errors.'));
  #     }
  #     $self->action_area->pack_start ($nopopup, 0,0,0);
  #
  #     if ($nopopup->can('set_tooltip_text')) { # new in Gtk 2.12
  #       $nopopup->set_tooltip_text
  #         (__('Check this to not popup automatically.
  # Messages are recorded, but the dialog is not popped up.
  # This is good to ignore a cascade of errors.'));
  #     }
  #   }

# Truncating on a message boundary ...
#
#   my $str = $textbuf->get('text');
#   my $from = length($str) - $max_chars;
#
#   # if $from is in the middle or just after a separator then that's the
#   # place to truncate; step back by length(_MESSAGE_SEPARATOR) to allow that
#   # to match
#   my $pos = index ($str, _MESSAGE_SEPARATOR,
#                    max (0, $from - length(_MESSAGE_SEPARATOR)));
#   if ($pos < 0) {
#     # $from is somewhere within some huge last message in the buffer, search
#     # backwards to the separator preceding it
#     $pos = rindex ($str, _MESSAGE_SEPARATOR, max (0, $from));
#     return if $pos < 0;  # only one message
#   }
#
#   $pos += length(_MESSAGE_SEPARATOR);
#   $textbuf->delete ($textbuf->get_start_iter,
#                     $textbuf->get_iter_at_offset($pos));

# append a newline to $textbuf if it's non-empty and doesn't already end
# with a newline
# sub _textbuf_ensure_final_newline {
#   my ($textbuf) = @_;
#   my $len = $textbuf->get_char_count || return;  # nothing added if empty
#
#   my $end_iter = $textbuf->get_end_iter;
#   if ($textbuf->get_text ($textbuf->get_iter_at_offset($len-1),
#                           $end_iter,
#                           0) # without invisible text
#       ne "\n") {
#     $textbuf->insert ($end_iter, "\n");
#   }
# }

=for stopwords ErrorTextDialog Gtk2-Ex-ErrorTextDialog charset unicode Popup
filename Gtk Ryde

=head1 NAME

Gtk2::Ex::ErrorTextDialog -- display error messages in a dialog

=head1 SYNOPSIS

 # explicitly adding a message
 use Gtk2::Ex::ErrorTextDialog;
 Gtk2::Ex::ErrorTextDialog->add_message ("Something went wrong");

 # handler for all Glib exceptions
 use Gtk2::Ex::ErrorTextDialog::Handler;
 Glib->install_exception_handler
   (\&Gtk2::Ex::ErrorTextDialog::Handler::exception_handler);

=head1 WIDGET HIERARCHY

C<Gtk2::Ex::ErrorTextDialog> is a subclass of C<Gtk2::MessageDialog>.  But
for now don't rely on more than C<Gtk2::Dialog>.

    Gtk2::Widget
      Gtk2::Container
        Gtk2::Bin
          Gtk2::Window
            Gtk2::Dialog
              Gtk2::MessageDialog
                Gtk2::Ex::ErrorTextDialog

=head1 DESCRIPTION

An ErrorTextDialog presents text error messages to the user in a
L<C<Gtk2::TextView>|Gtk2::TextView>.  It's intended for technical things
like Perl errors and warnings, rather than results of normal user
operations.

    +------------------------------------+
    |   !!    An error has occurred      |
    | +--------------------------------+ |
    | | Something at foo.pl line 123   | |
    | | -----                          | |
    | | Cannot whatever at Bar.pm line | |
    | | 456                            | |
    | |                                | |
    | +--------------------------------+ |
    +------------------------------------+
    |              Clear  Save-As  Close |
    +------------------------------------+

See L<Gtk2::Ex::ErrorTextDialog::Handler> for functions hooking up Glib
exceptions and Perl warnings to display in an ErrorTextDialog.

ErrorTextDialog is good if there might be a long cascade of messages from
one problem, or errors repeated on every screen draw.  In that case the
dialog scrolls along but the app might still mostly work.

The Save-As button lets the user write the messages to a file, for example
for a bug report.  Cut-and-paste works in the usual way too.

=head1 FUNCTIONS

=head2 Creation

=over 4

=item C<< $errordialog = Gtk2::Ex::ErrorTextDialog->instance >>

Return an ErrorTextDialog object designed to be shared by all parts of the
program.  This object is used when the methods below are called as class
functions.

You can destroy this instance with C<< $errordialog->destroy >> in the usual
way if you want.  A subsequent call to C<instance> creates a new one.

=item C<< $errordialog = Gtk2::Ex::ErrorTextDialog->new (key=>value,...) >>

Create and return a new ErrorTextDialog.  Optional key/value pairs set
initial properties per C<< Glib::Object->new >>.  An ErrorTextDialog created
this way is separate from the C<instance()> one above.  But it's unusual to
want more than one error dialog.

=back

=head2 Messages

ErrorTextDialog works with string messages.  A horizontal separator line is
added between each message because it can be hard to tell one from the next
when long lines are wrapped.  Currently the separator is just some dashes,
but something slimmer might be possible.

=over 4

=item C<< Gtk2::Ex::ErrorTextDialog->add_message ($str) >>

=item C<< $errordialog->add_message ($str) >>

Add a message to the ErrorTextDialog.  C<$str> can be wide chars or raw
bytes and doesn't have to end with a newline.

If C<$str> is raw bytes it's assumed to be in the locale charset and is
converted to unicode for display.  Anything invalid in C<$str> is escaped,
currently just in C<PERLQQ> style so it will display, though not necessarily
very well (see L<Encode/Handling Malformed Data>).

=item C<< $str = Gtk2::Ex::ErrorTextDialog->get_text() >>

=item C<< $str = $errordialog->get_text() >>

Return a wide-char string of all the messages in the ErrorTextDialog.

=back

=head1 ACTION SIGNALS

The following are provided both as "action signals" for use from C<Gtk2::Rc>
key bindings and methods for use from program code.

=over 4

=item C<clear> action signal (no parameters)

Remove all messages from the dialog.  This is the "Clear" button action.

=item C<popup-save-dialog> action signal (no parameters)

Popup the Save dialog, which asks the user for a filename to save the error
messages to.  This is the "Save As" button action.

=item C<< Gtk2::Ex::ErrorTextDialog->clear() >>

=item C<< Gtk2::Ex::ErrorTextDialog->popup_save_dialog() >>

=item C<< $errordialog->clear() >>

=item C<< $errordialog->popup_save_dialog() >>

Emit the C<clear> or C<popup-save-dialog> signals, respectively.  The
default handler in those signals does the actual work of clearing or showing
the save dialog and as usual for action signals that's the place to override
or specialize in a subclass.

=back

=head2 Key Bindings

The stock Clear and Save-As button mnemonic keys invoke the clear and save
actions, but there's no further key bindings by default.  You can add keys
in the usual way from the C<Gtk2::Rc> mechanism.  The class is
C<Gtk2__Ex__ErrorTextDialog> so for example in your F<~/.gtkrc-2.0> file

    binding "my_error_keys" {
      bind "F5" { "popup-save-dialog" () }
    }
    class "Gtk2__Ex__ErrorTextDialog" binding:rc "my_error_keys"

See F<examples/keybindings.pl> in the sources for a complete program doing
this.

=head1 PROPERTIES

=over 4

=item C<max-chars> (integer, default 200000)

The maximum number of characters of message text to retain, or -1 for
unlimited.  If this size is exceeded old text is discarded, replaced by a
line

    [Older messages discarded]

The idea is to limit memory use if a program is spewing lots of warnings
etc.  An infinite or near-infinite stream probably still makes the program
unusable, but at least it won't consume ever more memory.

Currently truncation chops old text in the middle of a message.  This is
slightly unattractive but it's fastest and it means if there's a huge
message then at least part of it is retained.

=back

=head1 SEE ALSO

L<Gtk2::Ex::ErrorTextDialog::Handler>

L<Gtk2::Ex::Carp>, which presents messages one at a time.

=head1 HOME PAGE

L<http://user42.tuxfamily.org/gtk2-ex-errortextdialog/>

=head1 LICENSE

Gtk2-Ex-ErrorTextDialog is Copyright 2007, 2008, 2009, 2010 Kevin Ryde

Gtk2-Ex-ErrorTextDialog 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.

Gtk2-Ex-ErrorTextDialog 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 Gtk2-Ex-ErrorTextDialog.  If not, see L<http://www.gnu.org/licenses/>.

=cut
