view release on metacpan or  search on metacpan

TextList/TextList.pm  view on Meta::CPAN

# Copyright (c) 1999 Greg London. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

# code for bindings taken from Listbox.pm

# comments specifying method functionality taken from
# "Perl/Tk Pocket Reference" by Stephen Lidie.

#######################################################################
# this module uses a text module as its base class to create a list box.
# this will allow list box functionality to also have all the functionality
# of the Text widget.
#
# note that most methods use an element number to indicate which
# element in the list to work on.
# the exception to this is the tag and mark methods which
# are dual natured. These methods may accept either the
# normal element number, or they will also take a element.char index,
# which would be useful for applying tags to part of a line in the list.
#
#######################################################################

package Tk::TextList;

use strict;
use vars qw($VERSION);
$VERSION = '4.006'; # $Id: //depot/Tkutf8/TextList/TextList.pm#5 $

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

use Tk qw (Ev);

Construct Tk::Widget 'TextList';

#######################################################################
# the following line causes Populate to get called
# @ISA = qw(Tk::Derived ... );
#######################################################################
sub Populate
{
 my ($w,$args)=@_;
 my $option=delete $args->{'-selectmode'};
 $w->SUPER::Populate($args);
 $w->ConfigSpecs( -selectmode  => ['PASSIVE','selectMode','SelectMode','browse'],
		  -takefocus   => ['PASSIVE','takeFocus','TakeFocus',1],
		  -spacing3    => ['SELF', undef, undef, 3],
		  -insertwidth => ['SELF', undef, undef, 0],
		);

}

#######################################################################
#######################################################################
sub ClassInit
{
 my ($class,$mw) = @_;

 # Standard Motif bindings:
 $mw->bind($class,'<1>',['BeginSelect',Ev('index',Ev('@'))]);
 $mw->bind($class,'<B1-Motion>',['Motion',Ev('index',Ev('@'))]);
 $mw->bind($class,'<ButtonRelease-1>','ButtonRelease_1');

 $mw->bind($class,'<Shift-1>',['BeginExtend',Ev('index',Ev('@'))]);
 $mw->bind($class,'<Control-1>',['BeginToggle',Ev('index',Ev('@'))]);

 $mw->bind($class,'<B1-Leave>',['AutoScan',Ev('x'),Ev('y')]);
 $mw->bind($class,'<B1-Enter>','CancelRepeat');
 $mw->bind($class,'<Up>',['UpDown',-1]);
 $mw->bind($class,'<Shift-Up>',['ExtendUpDown',-1]);
 $mw->bind($class,'<Down>',['UpDown',1]);
 $mw->bind($class,'<Shift-Down>',['ExtendUpDown',1]);

 $mw->XscrollBind($class);
 $mw->PriorNextBind($class);

 $mw->bind($class,'<Control-Home>','Cntrl_Home');

 $mw->bind($class,'<Shift-Control-Home>',['DataExtend',0]);
 $mw->bind($class,'<Control-End>','Cntrl_End');

 $mw->bind($class,'<Shift-Control-End>',['DataExtend','end']);
 $class->clipboardOperations($mw,'Copy');
 $mw->bind($class,'<space>',['BeginSelect',Ev('index','active')]);
 $mw->bind($class,'<Select>',['BeginSelect',Ev('index','active')]);
 $mw->bind($class,'<Control-Shift-space>',['BeginExtend',Ev('index','active')]);
 $mw->bind($class,'<Shift-Select>',['BeginExtend',Ev('index','active')]);
 $mw->bind($class,'<Escape>','Cancel');
 $mw->bind($class,'<Control-slash>','SelectAll');
 $mw->bind($class,'<Control-backslash>','Cntrl_backslash');
 ;
 # Additional Tk bindings that aren't part of the Motif look and feel:
 $mw->bind($class,'<2>',['scan','mark',Ev('x'),Ev('y')]);
 $mw->bind($class,'<B2-Motion>',['scan','dragto',Ev('x'),Ev('y')]);

 $mw->bind($class,'<FocusIn>' , ['tagConfigure','_ACTIVE_TAG', -underline=>1]);
 $mw->bind($class,'<FocusOut>', ['tagConfigure','_ACTIVE_TAG', -underline=>0]);