Gtk2::Ex::DateSpinner - year/month/day date entry using SpinButtons

 use Gtk2::Ex::DateSpinner;
 my $ds = Gtk2::Ex::DateSpinner->new (value => '2008-06-14');

    Gtk2::Widget
      Gtk2::Container
        Gtk2::Box
          Gtk2::HBox
            Gtk2::Ex::DateSpinner

        +------+   +----+   +----+
        | 2008 |^  |  6 |^  | 14 |^   Sat
        +------+v  +----+v  +----+v

# Copyright 2008, 2009, 2010 Kevin Ryde

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

package Gtk2::Ex::DateSpinner;
use 5.008;
use strict;
use warnings;
use Date::Calc;
use Gtk2;
use Glib::Ex::ObjectBits 'set_property_maybe';
# 1.16 for turn_utf_8_on()
use Locale::Messages 1.16 'dgettext', 'turn_utf_8_on';

our $VERSION = 8;

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

use Glib::Object::Subclass
  'Gtk2::HBox',
  properties => [Glib::ParamSpec->string
                 ('value',
                  'value',
                  'ISO format date string like 2008-07-25.',
                  '2000-01-01',
                  Glib::G_PARAM_READWRITE),
                ];

sub INIT_INSTANCE {
  my ($self) = @_;
  $self->{'value'} = '2000-01-01';

  my $year_adj = Gtk2::Adjustment->new (2000,    # initial
                                        0, 9999, # range
                                        1,       # step increment
                                        10,      # page_increment
                                        0);      # page_size (not applicable)
  my $year = $self->{'year'} = Gtk2::SpinButton->new ($year_adj, 1, 0);
  $year->signal_connect (insert_text => \&_do_spin_insert_text);
  $year->show;
  $self->pack_start ($year, 0,0,0);

  my $month_adj = Gtk2::Adjustment->new (1,      # initial
                                         0, 99,  # range
                                         1,      # step_increment
                                         1,      # page_increment
                                         0);     # page_size (not applicable)
  my $month = $self->{'month'} = Gtk2::SpinButton->new ($month_adj, 1, 0);
  $month->signal_connect (insert_text => \&_do_spin_insert_text);
  $month->show;
  $self->pack_start ($month, 0,0,0);

  my $day_adj = Gtk2::Adjustment->new (1,      # initial
                                       0, 99,  # range
                                       1,      # step_increment
                                       1,      # page_increment
                                       0);     # page_size (not applicable)
  my $day = $self->{'day'} = Gtk2::SpinButton->new ($day_adj, 1, 0);
  $day->signal_connect (insert_text => \&_do_spin_insert_text);
  $day->show;
  $self->pack_start ($day, 0,0,0);

  # translations from Gtk itself
  # eg. /usr/share/locale/de/LC_MESSAGES/gtk20-properties.mo
  # tooltip-text new in Gtk 2.10
  set_property_maybe ($year,  tooltip_text =>
                      turn_utf_8_on(dgettext('gtk20-properties','Year')));
  set_property_maybe ($month, tooltip_text =>
                      turn_utf_8_on(dgettext('gtk20-properties','Month')));
  set_property_maybe ($day,   tooltip_text =>
                      turn_utf_8_on(dgettext('gtk20-properties','Day')));

  my $dow = $self->{'dayofweek_label'} = Gtk2::Label->new;
  $dow->show;
  $self->pack_start ($dow, 0,0,0);

  $year->signal_connect  (value_changed => \&_spin_value_changed);
  $month->signal_connect (value_changed => \&_spin_value_changed);
  $day->signal_connect   (value_changed => \&_spin_value_changed);
  _spin_value_changed ($year);
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  $self->{$pname} = $newval;  # per default GET_PROPERTY

  if ($pname eq 'value') {
    my ($year, $month, $day) = split /-/, $newval;
    $self->{'year'}->set_value ($year);
    $self->{'month'}->set_value ($month);
    $self->{'day'}->set_value ($day);
  }
}

sub _do_spin_insert_text {
  my ($spin, $text, $len) = @_;
  ### DateSpinner insert: $text
  $text =~ s/^\s+//;
  $text =~ s/\s+$//;
  if ($text =~ /^\d\d\d\d-\d\d-\d\d$/) {
    my $self = $spin->parent;
    $self->set (value => $text);
    $spin->signal_stop_emission_by_name ('insert-text')
  }
  return;
}

sub _spin_value_changed {
  my ($spin) = @_;
  my $self = $spin->parent;

  if ($self->{'update_in_progress'}) { return; }
  local $self->{'update_in_progress'} = 1;

  my $year_spin = $self->{'year'};
  my $month_spin = $self->{'month'};
  my $day_spin = $self->{'day'};

  my $year  = $year_spin->get_value;
  my $month = $month_spin->get_value;
  my $day   = $day_spin->get_value;
  ### DateSpinner update: "$year, $month, $day"

  ($year, $month, $day) = Date::Calc::Add_Delta_YMD
    (2000, 1, 1, $year-2000, $month-1, $day-1);

  $year_spin->set_value ($year);
  $month_spin->set_value ($month);
  $day_spin->set_value ($day);

  # Prefer strftime over Date::Calc's localized names, on the basis that
  # strftime will probably know more languages, and setlocale() is done
  # automatically when perl starts.
  #
  # The modules end up required for the initial value when a DateSpinner is
  # created, but deferring them until that time might let you load the
  # module without yet dragging in the other big stuff.
  #
  require POSIX;
  require I18N::Langinfo;
  require Encode;
  my $wday = Date::Calc::Day_of_Week ($year, $month, $day); # 1=Mon,7=Sun,...
  my $str = POSIX::strftime (' %a ', 0,0,0, 1,1,100, $wday%7);# 0=Sun,1=Mon,..
  my $charset = I18N::Langinfo::langinfo (I18N::Langinfo::CODESET());
  $str = Encode::decode ($charset, $str);
  $self->{'dayofweek_label'}->set_text ($str);

  my $value = sprintf ('%04d-%02d-%02d', $year, $month, $day);
  if ($value ne $self->{'value'}) {
    $self->{'value'} = $value;
    $self->notify('value');
  }
}

sub get_value {
  my ($self) = @_;
  return $self->{'value'};
}

sub set_today {
  my ($self) = @_;
  my ($year, $month, $day) = Date::Calc::Today();
  $self->set (value => sprintf ('%04d-%02d-%02d', $year, $month, $day));
}

1;
__END__