view release on metacpan or  search on metacpan

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

######################################## SOH ###########################################
## Function : Additional Tk Class for Listbox-type HList with Data per Item, Sorting
##
## Copyright (c) 2002-2013 Michael Krause. All rights reserved.
## This program is free software; you can redistribute it and/or modify it
## under the same terms as Perl itself.
##
## History  : V1.00	10-Dec-2002 	Class adopted from ExtListbox. MK
##            V1.01 10-Jan-2003 	Added -databackground(color). MK
##            V1.02 19-Jan-2004 	Added numeric sorting for column 2. MK
##            V1.1  13-May-2005 	Added missing data for sorting in column 2. MK
##            V1.2  23-Oct-2008 	Bugfix: Deleting the first entry messed the reverse func. MK
##            V2.0  11-Sep-2009 	Rewrite: Added multi-Column and Header support. MK
##            V2.1  14-Sep-2009 	Bugfix: Solved problems with memory leak due Itemstyle. MK
##            V2.2  08-Apr-2013 	Bugfix: Retrieval of data this is a ref-to-* is lost (flattened in return-list). MK
##
######################################## EOH ###########################################
package Tk::DHList;

##############################################
### Use
##############################################
use Tk::HList;
use Tk::ItemStyle;
use Tk qw(Ev);

use strict;
use Carp;

use vars qw ($VERSION);
$VERSION = '2.2';

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

use constant DEFAULT_COLUMN_SEPARATOR	=> '|';
########################################################################
Construct Tk::Widget 'DHList';

# Class Variables
my ($DataStyles, $HeaderStyle);

#---------------------------------------------
# internal Setup function
#---------------------------------------------
sub ClassInit
{
    my ($class, $window) = @_;

    $class->SUPER::ClassInit($window);

	# Note these keyboard-Keys are only usable, if the widget gets 'focus'
	$window->bind ($class, '<Control-Key-bracketleft>', [\&viewtype, 'withdata']);
	$window->bind ($class, '<Control-Key-bracketright>', [\&viewtype, 'normal']);
	# Update the view after mapping
	$window->bind ($class, '<Map>', \&map_cb);
}

#---------------------------------------------
# internal Setup function
#---------------------------------------------
sub CreateArgs
{
    my ($class, $window, $args) = @_;

	# Convenience function - calculate coulncount from the headline
	if ($args->{-headline} and not $args->{-columns}) {
		my $columnseparator = $args->{-columnseparator} || DEFAULT_COLUMN_SEPARATOR();
		my $pattern = quotemeta $columnseparator;
		@_ = split(/$pattern/, $args->{-headline});
	    $args->{-columns} = scalar @_;
	}

 	# Necessarily Set/Patch Column-Count to accept a multi-purpose data-column
	$args->{-columns} = 1 unless $args->{-columns};
	$args->{-columns}++;
	
	$class->SUPER::CreateArgs($window, $args);
}

#---------------------------------------------
# internal Setup function
#---------------------------------------------
sub Populate
{
	# Parameters
    my ($this, $args) = @_;		

	# Locals
	my ($headline, $headerforeground, $headerbackground,$headerfont, $headerrelief,
		$data_background, $datastyle, $headerstyle);

	$headline			= delete $args->{-headline}; $args->{-header} = 1 if $headline; # Convenience
	$headerforeground	= delete $args->{-headerforeground};