view release on metacpan or  search on metacpan

lib/Gtk2/Ex/Splash.pm  view on Meta::CPAN

#
# You should have received a copy of the GNU General Public License along
# with Gtk2-Ex-Splash.  If not, see <http://www.gnu.org/licenses/>.


package Gtk2::Ex::Splash;
use 5.008;
use strict;
use warnings;
use Gtk2;
use List::Util 'max';
use Scalar::Util;

our $VERSION = 53;

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

use Glib::Object::Subclass 'Gtk2::Window',
  signals => { realize      => \&_do_realize,
               map          => \&_do_map,
               unmap        => \&_do_flush,
               unrealize    => \&_do_flush,
               expose_event => \&_do_expose_event },

  properties =>
  [ Glib::ParamSpec->object ('pixmap',
                             (do {
                               my $str = 'Pixmap';
                               eval { require Locale::Messages;
                                      Locale::Messages::dgettext('gtk20-properties',$str)
                                      } || $str }),
                             'Blurb.',
                             'Gtk2::Gdk::Pixmap',
                             Glib::G_PARAM_READWRITE),

    Glib::ParamSpec->object ('pixbuf',
                             (do {
                               my $str = 'Pixbuf';
                               eval { require Locale::Messages;
                                      Locale::Messages::dgettext('gtk20-properties',$str)
                                      } || $str }),
                             'Blurb.',
                             'Gtk2::Gdk::Pixbuf',
                             Glib::G_PARAM_READWRITE),

    Glib::ParamSpec->scalar ('filename',
                             (do {
                               # as from GtkFileSelection and
                               # GtkRecentManager
                               my $str = 'Filename';
                               eval { require Locale::Messages;
                                      Locale::Messages::dgettext('gtk20-properties',$str)
                                      } || $str }),
                             'Blurb.',
                             Glib::G_PARAM_READWRITE),
  ];

sub new {
  my $class = shift;
  return $class->SUPER::new (type => 'popup', @_);
}

my %instances;

sub INIT_INSTANCE {
  my ($self) = @_;
  ### Splash INIT_INSTANCE()
  $self->set_app_paintable (0);
  $self->set_double_buffered(0);
  $self->can_focus (0);
  Scalar::Util::weaken ($instances{Scalar::Util::refaddr($self)} = $self);
}
sub FINALIZE_INSTANCE {
  my ($self) = @_;
  delete $instances{Scalar::Util::refaddr($self)};
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  ### Splash SET_PROPERTY: $pname

  if ($pname eq 'filename' && defined $newval) {
    # stringize to copy possible object passed in instead of plain string
    $newval = "$newval";
  }
  $self->{$pname} = $newval;
  _update_pixmap ($self);
  if ($self->mapped) {
    _flush($self);
  }
}

sub _do_expose_event {
  # my $self = shift;
  ### Splash _do_expose(), no chain to default

  # don't chain as don't want the GtkWindow expose handler
  # gtk_window_expose() to draw the style background colour ...
}

sub _do_realize {
  my $self = shift;
  ### Splash _do_realize()

  $self->signal_chain_from_overridden();
  my $window = $self->window;
  $window->set_override_redirect (1);
  if ($window->can('set_type_hint')) { # new in Gtk 2.10
    $window->set_type_hint ('splashscreen');
  }
  ### xwininfo: do { $self->get_display->flush; $self->window && system "xwininfo -events -id ".$self->window->XID }

  _update_pixmap ($self);

  ### Splash _do_realize() finished
}

my $unmap_id;