view release on metacpan or  search on metacpan

lib/Tk/MARC/Editor.pm  view on Meta::CPAN

you could do something like this:

 my $ed = $FRAME->Scrolled('Editor', 
			   -scrollbars => 'e', 
			   -record => $marc, 
			   -background => 'black',
			   -leaderbg => 'yellow',
			   -leaderfg => 'black',
			   -fieldbg => 'black',
			   -fieldfg => 'yellow',
			   -ind1bg => 'black',
			   -ind1fg => 'yellow',
			   -ind2bg => 'black',
			   -ind2fg => 'yellow',
			   -subfieldbg => 'yellow',
			   -subfieldfg => 'black',
			   -databg => 'black',
			   -datafg => 'yellow',
			   -fixedbg => 'black',
			   -fixedfg => 'yellow',
			   )->pack(-side => 'top');

You can, of course, always use the configure( -attribute => value ); form
to deal with colors individually.  For example, $ed->configure( -leaderbg => 'darkgreen' );

You can also use the C<ColorScheme> method to get or set all the colors at once. 

=cut

# Revision history for Tk::MARC::Editor
# -------------------------------------
# 1.0 2006.02.24
#     - renamed module from Tk::MARC_Editor to Tk::MARC::Editor on the
#       advice of the kind folks at modules [at] perl.org
# 0.9 2006.01.06
#     - file dialog problems in the sample app under windows
#     - shift key acts as a delete key
# 0.8 2006.01.04
#     - added ColorScheme method to get or set all colors
#       as a unit.
# 0.7 2006.01.04
#     - handle configure and cget in the Tk way (using ConfigSpecs)
# 0.6 2006.01.04
#     - fixed leader bug (allow re-editing of editable fields)
#     - proper positioning of insertion cursor re: leaderedit tag						  
# 0.5 2005.12.29
#     - fixed leader bug (leader was being returned as a 26-character string!)
# 0.4 2005.12.22
#     - proper event bindings
#     - specify colors
#     - POD
# 0.3 2005.12.21
#     - better leader handling :-)
# 0.2 2005.12.20
#     - leader handling
# 0.1 2005.12.19
#     - original version

use Tk qw(Ev);
use Tk::widgets qw(Text);
use base qw/Tk::Derived Tk::Text/;
use Carp;
use MARC::Record;
use MARC::Descriptions;
use MARC::Lint;
use MARC::Errorchecks;
use Data::Dumper;
use strict;

Construct Tk::Widget 'Editor';

our (
     $TD,
     %pos,
     %ldrpos,
     );

sub ClassInit {
    my ($class, $mw) = @_;
    $TD = MARC::Descriptions->new;
    %pos = ( field    => { start => 0, length => 3 },
	     ind1     => { start => 4, length => 1 },
	     ind2     => { start => 5, length => 1 },
	     subfield => { start => 8, length => 1 },
	     data     => { start => 9, length => undef },
	     );
    %ldrpos = ( "A Logical record length"       => { start => 0, length => 5, editable => 0 },
		"B Record status"               => { start => 5, length => 1, editable => 1 },
		"C Type of record"              => { start => 6, length => 1, editable => 1 },
		"D Bibliographic level"         => { start => 7, length => 1, editable => 1 },
		"E Type of control"             => { start => 8, length => 1, editable => 1 },
		"F Character coding scheme"     => { start => 9, length => 1, editable => 0 },
		"G Indicator count"             => { start => 10, length => 1, editable => 0 },
		"H Subfield code count"         => { start => 11, length => 1, editable => 0 },
		"I Base address of data"        => { start => 12, length => 5, editable => 0 },
		"J Encoding level"              => { start => 17, length => 1, editable => 1 },
		"K Descriptive cataloging form" => { start => 18, length => 1, editable => 1 },
		"L Linked record requirement"   => { start => 19, length => 1, editable => 1 },
		"M Entry map"                   => { start => 20, length => 4, editable => 0 },
		);

    $class->SUPER::ClassInit($mw);
}

sub Populate {
    my ($self, $args) = @_;
    
    my $record = delete $args->{'-record'};
    croak "Missing -record" unless $record;
    croak "Not a MARC::Record" unless (ref($record) eq "MARC::Record");

    $self->ConfigSpecs('-fieldfg'      => ['METHOD',undef,undef,'darkgreen']);
    $self->ConfigSpecs('-fieldbg'      => ['METHOD',undef,undef,undef]);
    $self->ConfigSpecs('-ind1fg'       => ['METHOD',undef,undef,'yellow']);
    $self->ConfigSpecs('-ind1bg'       => ['METHOD',undef,undef,'darkslategrey']);
    $self->ConfigSpecs('-ind2fg'       => ['METHOD',undef,undef,'yellow']);
    $self->ConfigSpecs('-ind2bg'       => ['METHOD',undef,undef,'darkslategrey']);
    $self->ConfigSpecs('-subfieldfg'   => ['METHOD',undef,undef,'darkgoldenrod']);
    $self->ConfigSpecs('-subfieldbg'   => ['METHOD',undef,undef,undef]);
    $self->ConfigSpecs('-datafg'       => ['METHOD',undef,undef,'blue']);
    $self->ConfigSpecs('-databg'       => ['METHOD',undef,undef,undef]);