view release on metacpan or  search on metacpan

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

		#'-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();
	my $wait = $day - (($h *60 + $m)*60 + $s) + 10;
	$self->after($wait, [ 'tick', $self, $day, ]);

	# return widget.
	$self;
}

# DoWhenIdle seems to be replaced by afterIdle in Tk800.018.
sub afterIdle { &DoWhenIdle; }

;## Update the widget when you get a chance.
sub DoWhenIdle
{
	debug "args: @_\n";

	my $self = shift;

	# refresh the widget.
	$self->refresh();

	# update the widget now?
	$self->update if ($self->cget(-update));
}

;# Create all the subwidgets needed for the month.
sub make
{
	debug "args: @_\n";

	my $self	= shift;

	my $width = 2;

	# First create all the buttons in a grid.

	# navigation row.
	$self->{title} = $self->Menubutton(
		-width		=> 15,
	)->grid(
		-row		=> 0,
		-column		=> 2,
		-columnspan	=> 4,
		-sticky		=> 'nsew',
	);


	# Positions (0,0), (0,1), (0,6), (0,7) are the
	# navigation buttons.

	# other buttons......
	for (my $c=0; $c<$#week+2; $c++)
	{
		for (my $r=1; $r<8; $r++)
		{
			$self->{'button'}->{$r}->{$c} =
				$self->Button(
					# width is in chars
					-width	=> $width,
					#-padx	=> 0,
					#-pady	=> 0,
				)->grid(
					'-row'		=> $r,
					'-column'	=> $c,
					'-sticky'	=> 'nsew',
				);
		}
	}

	# Lets set up aliases for these buttons.

	# week day headings.....
	for (my $c=1; $c<= 1+$#week; $c++)
	{
		$self->{week}->{$c} = $self->{'button'}->{1}->{$c};
	}

	# side buttons.
	#for (my $r=1; $r<8; $r++)
	#{
		#$self->{side}->{$r} = $self->{'button'}->{$r}->{0};
	#}

	# date buttons.
	for (my $c=1; $c<$#week+2; $c++)
	{
		for (my $r=2; $r<8; $r++)
		{
			$self->{date}->{$r}->{$c} = 
				$self->{'button'}->{$r}->{$c};
		}
	}

	$self;
}

;# Toggle the side buttons on the left side
sub side
{
	debug "args: @_\n";

	my $self = shift;