File Coverage

blib/lib/Gtk2/Ex/ComboBox/PixbufType.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

# Copyright 2010, 2011 Kevin Ryde

# This file is part of Gtk2-Ex-ComboBoxBits.
#
# Gtk2-Ex-ComboBoxBits 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-ComboBoxBits 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-ComboBoxBits.  If not, see .



# for-pixbuf-save ?
# insensitive or omit ?
#                   Glib::ParamSpec->object
#                   ('for-pixbuf-save',
#                    'for-pixbuf-save',
#                    'Blurb.',
#                    'Gtk2::Gdk::Pixbuf',
#                    Glib::G_PARAM_READWRITE),
#   if ($pname eq 'for_pixbuf_save') {
#     Scalar::Util::weaken ($self->{$pname});
#   }
#     my $pixbuf = $self->{'for_pixbuf_save'};
# ,
#              ($pixbuf ? ($pixbuf->get_width, $pixbuf->get_height) : ())

# writable =>
# exclude_read_only =>
# include-read-only ?

# always-select ?

# set_active_from_filename

# alphabetical ?

# type or active-type ?
# active-format ?

# $ptypecombo->order_first ('png', 'jpeg')
# $ptypecombo->order_last ('ico')


package Gtk2::Ex::ComboBox::PixbufType;
use 5.008;
use strict;
use warnings;
use Carp;
use Gtk2;
use Scalar::Util;
use List::Util qw(max);
use POSIX ();
use Gtk2::Ex::ComboBoxBits;
use Gtk2::Ex::PixbufBits 38;  # v.38 for type_supports_size()

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

our $VERSION = 32;

if (0) {
  # These are the type names as of Gtk 2.20, extend if there's more and
  # want to translate their names.
  #
  # TRANSLATORS: These format names are localized in case a non-Latin script
  # ought to be shown instead, or as well.  Latin script languages will
  # probably leave all unchanged as that should make them easiest for the
  # user identify, even if a literal translation would result in a different
  # abbreviation.
  __('ANI');
  __('BMP');
  __('GIF');
  __('ICNS');
  __('ICO');
  __('JPEG');
  __('JPEG2000');
  __('PCX');
  __('PNG');
  __('PNM');
  __('QTIF');
  __('RAS');
  __('SVG');
  __('TGA');
  __('TIFF');
  __('WBMP');
  __('WMF');
  __('XBM');
  __('XPM');
}

use Glib::Object::Subclass
  'Gtk2::ComboBox',
  signals => { notify => \&_do_notify },
  properties => [ Glib::ParamSpec->string
                  ('active-type',
                   'Active pixbuf type',
                   'Gdk Pixbuf file save format, such as "png".',
                   (eval {Glib->VERSION(1.240);1}
                    ? undef # default
                    : ''),  # no undef/NULL before Perl-Glib 1.240
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->int
                  ('for-width',
                   'for-width',
                   'Only show file formats which support this width.',
                   0, POSIX::INT_MAX(),
                   0,
                   Glib::G_PARAM_READWRITE),
                  Glib::ParamSpec->int
                  ('for-height',
                   'for-height',
                   'Only show file formats which support this height.',
                   0, POSIX::INT_MAX(),
                   0,
                   Glib::G_PARAM_READWRITE),

                ];

use constant { _COLUMN_TYPE    => 0,   # arg string for gdk_pixbuf_save()
               _COLUMN_DISPLAY => 1,   # translated display string
             };

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

  my $renderer = Gtk2::CellRendererText->new;
  $renderer->set (ypad => 0);
  $self->pack_start ($renderer, 1);
  $self->set_attributes ($renderer, text => _COLUMN_DISPLAY);

  $self->set_model (Gtk2::ListStore->new ('Glib::String', 'Glib::String'));
  _update_model($self);
}

sub GET_PROPERTY {
  my ($self, $pspec) = @_;
  my $pname = $pspec->get_name;
  ### ComboBox-PixbufType GET_PROPERTY: $pname

  if ($pname eq 'active_type') {
    my $iter;
    return (($iter = $self->get_active_iter)
            && $self->get_model->get_value ($iter, _COLUMN_TYPE));
  }
  # $pname eq 'for_width' or 'for_height' integers
  return $self->{$pname} || 0;
}

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

  if ($pname eq 'active_type') {
    # because _COLUMN_TYPE==0
    Gtk2::Ex::ComboBoxBits::set_active_text ($self, $newval);
    ### active num now: $self->get_active
  } else {
    $self->{$pname} = $newval;
    _update_model($self);
  }
}

# 'notify' class closure
sub _do_notify {
  my ($self, $pspec) = @_;
  if ($pspec->get_name eq 'active') {
    $self->notify ('active-type');
  }
}

# Gtk2::Gdk::Pixbuf->$get_formats_method
# being either get_formats() or a fallback enough for the formats
# examinations below.  The fallback includes an 'is_writable' to use the
# smaller _is_writable().
#
my $get_formats_method
  = (Gtk2::Gdk::Pixbuf->can('get_formats') # new in Gtk 2.2
     ? 'get_formats'
     : sub { return ({ name => 'png',
                       is_writable => 1},
                     { name => 'jpeg',
                       is_writable => 1 }) });

# _is_writable($format) returning bool
#
*_is_writable =
  (exists((Gtk2::Gdk::Pixbuf->$get_formats_method)[0]->{'is_writable'})
   ?
   # 'is_writable' field, new in Perl-Gtk 1.240
   sub {
     my ($format) = @_;
       ### _is_writable() using field
       ### $format
     return $format->{'is_writable'};
   }
   : do {
     # Perl-Gtk 1.222 and earlier hard coded
     #
     my %is_writable = (png  => 1, # Gtk 2.0 and 2.2
                        jpeg => 1,

                        (Gtk2->check_version(2,4,0)  # 2.4.0 for ico saving
                         ? () : (ico => 1)),

                        (Gtk2->check_version(2,8,0)  # 2.8.0 for bmp saving
                         ? () : (bmp => 1)),

                        (Gtk2->check_version(2,10,0) # 2.10.0 for tiff saving
                         ? () : (tiff =>  1)),
                       );
     sub {
       my ($format) = @_;
       ### _is_writable() using fallback
       ### $format
       return $is_writable{$format->{'name'}};
     }
   });

sub _update_model {
  my ($self) = @_;
  ### PixbufType _update_model()

  my $for_width  = max (1, $self->get('for-width'));
  my $for_height = max (1, $self->get('for-height'));
  my @types =
    grep {Gtk2::Ex::PixbufBits::type_supports_size($_,$for_width,$for_height)}
      map {$_->{'name'}}
        grep {_is_writable($_)}
          Gtk2::Gdk::Pixbuf->$get_formats_method;

  # eg. 'png' => 'PNG'
  my %display = map { $_ => uc($_) } @types;

  # translated descriptions
  if (eval { require Locale::Messages }) {
    foreach my $type (@types) {
      $display{$type} = Locale::Messages::dgettext ('Gtk2-Ex-ComboBoxBits',
                                                    uc($display{$type}));
    }
  }

  # alphabetical by translated description
  @types = sort { $display{$a} cmp $display{$b} } @types;

  my $type = $self->get('active-type');
  my $model = $self->get_model;
  $model->clear;
  foreach my $type (@types) {
    ### $type
    ### display: $display{$type}
    $model->set ($model->append,
                 _COLUMN_TYPE,    $type,
                 _COLUMN_DISPLAY, $display{$type});
  }

  # preserve existing setting
  $self->set (active_type => $type);
}

1;
__END__