view release on metacpan or  search on metacpan

lib/Tk/CodeText/StatusBar.pm  view on Meta::CPAN

package Tk::CodeText::StatusBar;

package PopTabs;

use strict;
use warnings;

use base qw(Tk::Derived Tk::Poplevel);

Construct Tk::Widget 'PopTabs';

sub Populate {
	my ($self,$args) = @_;
	
	my $var = delete $args->{'-variable'};
	unless (defined $var) {
		my $val = '';
		$var = \$val;
	}
	$self->SUPER::Populate($args);
	$self->{VAR} = $var;
	$self->CreateWidgets;

	$self->ConfigSpecs(
		-setcall => ['CALLBACK', undef, undef, sub {}],
		DEFAULT => [ $self ],
	);
}

sub CreateWidgets {
	my $self = shift;
	$self->Label(
		-anchor => 'w',
		-text => 'Unit:'
	)->pack(-fill => 'x');
	my $var = $self->{VAR};
	$self->Radiobutton(
		-anchor => 'w',
		-text => 'pixels',
		-value => 'p',
		-variable => $var,
	)->pack(-fill => 'x');
	$self->Radiobutton(
		-anchor => 'w',
		-text => 'cm',
		-value => 'c',
		-variable => $var,
	)->pack(-fill => 'x');
	$self->Radiobutton(
		-anchor => 'w',
		-text => 'mm',
		-value => 'm',
		-variable => $var,
	)->pack(-fill => 'x');
	$self->Radiobutton(
		-anchor => 'w',
		-text => 'inch',
		-value => 'i',
		-variable => $var,
	)->pack(-fill => 'x');
	my $f = $self->Frame->pack(-fill => 'x');
	$f->Label(
		-anchor => 'w',
		-text => 'Size:'
	)->pack(-side => 'left');
	my $e = $f->Entry->pack(-side => 'left', -padx => 2, -fill => 'x');
	$self->Advertise(Entry => $e);
	$e->bind('<Escape>', [$self, 'popDown']);
	$self->Button(
		-text => 'Ok',
		-command => ['Select', $self],
	)->pack(-fill, 'x');
}

sub popDown {
	my $self = shift;
	my $f = $self->{'_focus'};
	$f->focus if defined $f;;
	$self->SUPER::popDown;
}

sub popUp {
	my $self = shift;
	my $e = $self->Subwidget('Entry');
	$self->{'_focus'} = $e->focusCurrent;
	$e->focus;
	$self->SUPER::popUp;
}

sub Put {
	my ($self, $value) = @_;
	return unless defined $value;
	if ($value =~ /^(.*)([c,m,i,p])/) {
		my $size = $1;
		my $unit = $2;
		my $e = $self->Subwidget('Entry');
		$e->delete('0', 'end');
		$e->insert('end', $size);
		my $var = $self->Var;
		$$var = $unit;
	}
}

sub Select {
	my $self = shift;
	my $var = $self->Var;
	my $e = $self->Subwidget('Entry');
	my $val = $e->get . $$var;
	$self->Callback('-setcall', $val);
	$self->popDown;
}

sub Var {
	return $_[0]->{VAR};
}

package PopIndent;

use strict;
use warnings;

use base qw(Tk::Derived PopTabs);

Construct Tk::Widget 'PopIndent';

sub AlterSizeState {
	my ($self, $value) = @_;
	my $f = $self->Subwidget('Entry');
	if ($value) {
		$f->configure(-state => 'disabled');
	} else {
		$f->configure(-state => 'normal');
	}
}

sub CreateWidgets {
	my $self = shift;
	$self->Checkbutton(
		-command => sub {
			my $var = $self->Var;
			$self->AlterSizeState($$var)
		},
		-anchor => 'w',
		-text => 'Use tabs',
		-variable => $self->Var,
	)->pack(-fill => 'x');
	my $f = $self->Frame->pack(-fill => 'x');
	$f->Label(
		-anchor => 'w',
		-text => 'Size:'
	)->pack(-side => 'left');
	my $e = $f->Entry->pack(-side => 'left', -padx => 2, -fill => 'x');
	$self->Advertise(Entry => $e);
	$e->bind('<Escape>', [$self, 'popDown']);
	$self->Button(
		-text => 'Ok',
		-command => ['Select', $self],
	)->pack(-fill, 'x');
}

sub Put {
	my ($self, $value) = @_;
	my $e = $self->Subwidget('Entry');
	$e->delete(0, 'end');
	my $var = $self->Var;
	if ($value eq 'tab') {
		$$var = 1;
		$self->AlterSizeState(1);
	} else {
		$$var = 0;
		$self->AlterSizeState(0);
		$e->insert('end', $value);
	}
}

sub Select {
	my $self = shift;
	my $var = $self->Var;
	my $e = $self->Subwidget('Entry');
	my $val;
	if ($$var) {
		$val = 'tab',
	} else {
		$val = $e->get;
	}
	$self->Callback('-setcall', $val);
	$self->popDown;
}


##########################################################################
##                 Main Module                                          ##
##########################################################################

package Tk::CodeText::StatusBar;

=head1 NAME

Tk:CodeText::StatusBar - Status bar for  L<Tk::CodeText>

=cut

use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '0.42';

use base qw(Tk::Derived Tk::Frame);

use Tk;
require Tk::PopList;

Construct Tk::Widget 'StatusBar';

my $save_pixmap = '
/* XPM */
static char *save[]={
"16 16 4 1",
". c None",
"# c #000000",
"a c #808080",
"b c #ffff00",
"................",
"..############..",
".#aaaaaaaaaaaa#.",
".#aaaaaaaaaaaa#.",
".#aaaaaaaaaaaa#.",
".#aaaaaaaaaaaa#.",
".#aaaaaaaaaaaa#.",
".#aaaaaaaaaaaa#.",
".#aa########aa#.",
".#aa########aa#.",
".#aa########aa#.",
".#aa########aa#.",
".#aa#bbbbbb#aa#.",
".#aa#bbbbbb#aa#.",
"..############..",
"................"};
';

=head1 SYNOPSIS

 require Tk::CodeText::StatusBar;
 my $text= $window->StatusBar(@options)->pack;

=head1 DESCRIPTION

Inherits L<Tk::Frame>.

Provides a status bar to L<Tk::CodeText>.

=head1 OPTIONS

=over 4

=item Switch: B<-statusinterval>

By default 200 ms. Update interval for the status bar.

=item Switch: B<-saveimage>

The icon image used to indicate the text is modified.
By default it is an internally defined xpm.

=item Switch: B<-widget>

Mandatory!