view release on metacpan or  search on metacpan

lib/Tk/Month.pm  view on Meta::CPAN

#! /usr/bin/env perl

use 5.014000;
use warnings;
use strict;

package Tk::Month;

our $VERSION = '1.8';

use vars qw(
	@year @Year %year %a2year
	@week @Week %week %a2week
	$day %firstday
);

use Carp;
use POSIX;
use Time::Local;
use Text::Abbrev;
use Tk;
use Tk::Widget;

use base qw/ Tk::Derived Tk::Frame /;

Construct Tk::Widget 'Month';

sub debug {};
#sub debug { print STDERR @_; };

;# ---------------------------------------------------------------------
;# class initialisation.
{
	$day		= 24*60*60;	# a day in seconds.
	%firstday	= ();		# first weekday in a month cache

	# set up week and month names.
	&setWeek();
	&setYear();
}

;# ---------------------------------------------------------------------

;## Constructor.  Uses new inherited from base class
sub Populate
{
	debug "args: @_\n";

	my $self = shift;

	$self->SUPER::Populate(@_);

	# Set up extra configuration
	$self->ConfigSpecs(
		'-month'	=> ['PASSIVE',undef,undef, ''],
		'-year'		=> ['PASSIVE',undef,undef, ''],
		'-command'	=> ['PASSIVE',undef,undef, \&defaultAction],
		'-press'	=> '-command',
		'-printformat'	=> ['PASSIVE',undef,undef, '%d %B %Y'],
		'-dayformat'	=> ['PASSIVE',undef,undef, '%d'],
		'-title'	=> ['PASSIVE',undef,undef, '%B %Y'],
		'-update'	=> ['PASSIVE',undef,undef, 0],
		#'-printcommand'	=> ['PASSIVE',undef,undef, \&defaultPrint],
		'-navigation'	=> ['PASSIVE',undef,undef, 1],
		'-side'		=> ['PASSIVE',undef,undef, 1],
		#'-close'	=> ['PASSIVE',undef,undef, $self],

		# configurable from Xdefaults file.
		'-includeall'	=> ['PASSIVE','includeall','IncludeAll', 1],
		'-showall'	=> ['PASSIVE','showall','ShowAll', 0],
		'-first'	=> ['PASSIVE','first','First', 0],
		'-buttonhighlightcolor'	=> ['PASSIVE','buttonhighlightcolor','ButtonHighlightColor', ''],
		'-buttonhighlightbackground'	=> ['PASSIVE','buttonhighlightbackground','ButtonHighlightBackground', ''],
		'-buttonfg'	=> ['PASSIVE','buttonfg','ButtonFg', ''],
		'-buttonbg'	=> ['PASSIVE','buttonbg','ButtonBg', ''],
		'-buttonbd'	=> ['PASSIVE','buttonbd','ButtonBd', ''],
		'-buttonrelief'	=> ['PASSIVE','buttonrelief','ButtonRelief', ''],
	);

	# Construct the subwidgets.
	$self->{frame} = $self->make();

	# decide when to tick.......
	my ($s, $m, $h) = localtime();