home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / TiedListbox.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  8.4 KB  |  301 lines
  1. # $Id: TiedListbox.pm,v 0.1 1997/04/09 10:56:10 ada Exp $
  2. #
  3. # TiedListbox: tie together the scrolling and/or selection of Listboxes
  4.  
  5. package Tk::TiedListbox;
  6.  
  7. require Tk::Listbox;
  8. use Carp;
  9.  
  10. @Tk::TiedListbox::ISA=qw(Tk::Derived Tk::Listbox);
  11.  
  12. Tk::Widget->Construct('TiedListbox');
  13.  
  14. use Tk::Submethods ( 'tie' => [qw(scroll selection all)],
  15.                      'selection' => [qw(anchor clear includes set)],
  16.                      'scan' => [qw(mark dragto)]
  17.                    );
  18.  
  19. sub tie {
  20.   my $cw=shift;
  21.   bless $cw,"Tk::TiedListbox";
  22.   if(@_) {
  23.     $cw->untie;
  24.     $cw->{-tieoption}='all';
  25.     if($_[0] eq 'scroll' || $_[0] eq 'selection' || $_[0] eq 'all') {
  26.       $cw->{-tieoption}=shift;
  27.     }
  28.     @_=@{$_[0]} if ref($_[0]) eq 'ARRAY';
  29.     $cw->{-tiedto}=[@_];
  30.     foreach $w (@_) {
  31.       bless $w,ref($cw) if(ref($w)=~/Listbox$/); # Let's hope this works
  32.       if(ref($w) eq ref($cw)) {
  33.         $w->untie;
  34.         $w->{-tieoption}=$cw->{-tieoption};
  35.         $w->{-tiedto}=[$cw,grep($_ ne $w,@_)];
  36.       }
  37.       else {
  38.         carp "trying to tie a non-Listbox $w";
  39.       }
  40.     }
  41.     return $cw;
  42.   }
  43.   else {
  44.     $cw->{-tieoption}='all',$cw->{-tiedto}=[]
  45.       unless ref $cw->{-tiedto};
  46.     return($cw->{-tieoption},$cw->{-tiedto});
  47.   }
  48. }
  49.  
  50. sub untie
  51. {
  52.   my $cw=shift;
  53.   my @ret=$cw->tie;
  54.   foreach $w (@{$cw->{-tiedto}}) {
  55.     $w->{-tiedto}=[grep($_ ne $cw,@{$w->{-tiedto}})];
  56.   }
  57.   @ret;
  58. }
  59.  
  60. sub Tk::Listbox::tie {
  61.   shift->Tk::TiedListbox::tie(@_);
  62. }
  63.  
  64. sub activate {
  65.   my $cw=shift;
  66.   $cw->CallTie('selection','activate',[$cw->index($_[0])],\&ActivateTie);
  67. }
  68.  
  69. sub ActivateTie {
  70.   my($w,$sub,$index)=@_;
  71.   $w->$sub($index) if $index<$w->size;
  72. }
  73.  
  74. sub scan {
  75.   my $cw=shift;
  76.   $cw->SUPER::scan(@_);
  77.   $cw->CallTie('scroll','yview',[($cw->SUPER::yview)[0]*$cw->size]);
  78. }
  79.  
  80. sub see {
  81.   my $cw=shift;
  82.   $cw->CallTie('scroll','see',[$cw->index($_[0])]);
  83. }
  84.  
  85. sub selection {
  86.   my $cw=shift;
  87.   if($_[0] eq 'anchor') {
  88.     $cw->CallTie('selection','selection',['anchor',$cw->index($_[1])],
  89.                  \&SelectionAnchorTie);
  90.   }
  91.   if($_[0] eq 'clear' || $_[0] eq 'set') {
  92.     $cw->CallTie('selection','selection',
  93.                  [$_[0],map($cw->index($_),@_[1..@_-1])],
  94.                  \&SelectionSetClearTie);
  95.   }
  96.   elsif($_[0] eq 'includes') {
  97.     return $cw->SUPER::selection(@_);
  98.   } 
  99. }
  100.  
  101. sub SelectionAnchorTie {
  102.   my($w,$sub,$action,$index)=@_;
  103.   $w->$sub($action,$index) if $index<$w->size;
  104. }
  105.  
  106. sub SelectionSetClearTie {
  107.   my($w,$sub,$action,@index)=@_;
  108.   $w->$sub($action,@index) if $index[0]<$w->size || 
  109.                               ($#index>=1 && $index[1]<$w->size);
  110. }
  111.  
  112. sub yview {
  113.   my $cw=shift;
  114.   if(@_) {
  115.     if($_[0] eq 'moveto') {
  116.       $cw->SUPER::yview(@_);
  117.       $cw->CallTie('scroll','yview',[($cw->SUPER::yview)[0]*$cw->size]);
  118.     }
  119.     elsif($_[0] eq 'scroll') {
  120.       $cw->SUPER::yview(@_);
  121.       $cw->CallTie('scroll','yview',[($cw->SUPER::yview)[0]*$cw->size]);
  122.     }
  123.     else {
  124.       $cw->CallTie('scroll','yview',[$cw->index($_[0])]);
  125.     }
  126.   }
  127.   else {
  128.     return $cw->SUPER::yview();
  129.   }
  130. }
  131.  
  132. sub YviewScrollTie {
  133.   my($w,$sub,$cw,$action,$num,$what)=@_;
  134.   if($w eq $cw) {
  135.     $w->$sub($action,$num,$what);
  136.   }
  137.   else {
  138.     $w->$sub('moveto',($cw->yview)[0]*$cw->size/$w->size);
  139.   }
  140. }
  141.  
  142.  
  143. sub CallTie {
  144.   my($cw,$option,$sub,$args,$tiesub)=@_;
  145.   my $supersub="SUPER::$sub";
  146.   $tiesub=sub{my($w,$sub)=(shift,shift); $w->$sub(@_);} 
  147.     unless defined $tiesub;
  148.   my @ret=&$tiesub($cw,$supersub,@$args);
  149.   if(ref($cw->{'-tiedto'}) &&
  150.      ($cw->{'-tieoption'} eq 'all' ||
  151.       $cw->{'-tieoption'} eq $option)) {
  152.     foreach $w (@{$cw->{'-tiedto'}}) {
  153.       &$tiesub($w,$supersub,@$args);
  154.     }
  155.   }
  156.   @ret;
  157. }
  158.  
  159. 1;
  160.  
  161. __END__
  162.  
  163. =head1 NAME
  164.  
  165. Tk::TiedListbox - gang together Listboxes
  166.  
  167. =head1 SYNOPSIS
  168.  
  169.     use Tk::TiedListbox
  170.  
  171.     $l1 = $mw->Listbox(-exportselection => 0,...);
  172.     $l2 = $mw->Listbox(-exportselection => 0,...);
  173.     $l3 = $mw->Listbox(-exportselection => 0,...);
  174.     $l1->tie([$l2,$l3]);
  175.  
  176. =head1 DESCRIPTION
  177.  
  178. TiedListbox causes two or more Listboxes to be operated in tandem.
  179. One application is emulating multi-column listboxes. The scrolling,
  180. selection, or both mechanisms may be tied together. The methods B<tie>
  181. and B<untie> are provided, along with overridden versions of some of
  182. the Listbox methods to provide tandem operation.
  183.  
  184. Scrollbars are fully supported. You can use either explicitly created
  185. B<Scrollbar>s, the B<ScrlListbox> widget, or the B<Scrolled>
  186. super-widget. Tricks to "attach" multiple tied listboxes to a single
  187. scrollbar are unnecessary and will lead to multiple calls of the
  188. listbox methods (a bad thing).
  189.  
  190. The configuration options, geometry, and items of the Listboxes are
  191. not altered by tying them. The programmer will have to make sure that
  192. the setup of the Listboxes make sense together. Here are some
  193. (unenforced) guidelines:
  194.  
  195. For listboxes with tied selection:
  196.   set B<-exportselection> to 0 for all but possibly one Listbox
  197.   use identical B<-selectmode> for all Listboxes
  198.   if items are added/deleted, they should be done all at once and 
  199.     at the same index, or the selection should be cleared
  200.   Listboxes should have the same number of items
  201. For listboxes with tied scrolling:
  202.   use the same window height and font for all Listboxes
  203.   Listboxes should have the same number of items
  204.  
  205. =head1 METHODS
  206.  
  207. =over 4
  208.  
  209. =item I<$listbox>->B<tie>?(?I<option>?, [I<listbox>,...])?
  210.  
  211. Ties together I<$listbox> and the list of Listboxes with the given
  212. I<option>. Returns I<$listbox>.
  213.  
  214. If no arguments are given, returns a list containing two items: the
  215. tie option ("scroll", "selection", or "all") and the list of Listboxes
  216. that I<$listbox> is tied to.
  217.  
  218. I<option> can be one of "scroll", "selection", or "all".  If omitted,
  219. "all" is assumed. "scroll" makes the tied Listboxes to scroll
  220. together, "selection" makes selections to occur simultaneously in all
  221. tied Listboxes, and "all" effects both actions.
  222.  
  223. All the Listboxes are B<untie>d (if previously tied) before being tied
  224. to each other; hence a Listbox can only be in one "tie group" at a
  225. time. "Tiedness" is commutative.
  226.  
  227. The tie method can be called with either Listbox or TiedListbox
  228. objects. All listbox objects specified are reblessed to TiedListbox
  229. objects.
  230.  
  231. Code such as below can be used to tie ScrlListboxes:
  232.  
  233.   $slb1=ScrlListbox(...); # or Scrolled('Listbox',...
  234.   $slb2=ScrlListbox(...); # or Scrolled('Listbox',...
  235.   $slb1->tie([$slb2->Subwidget('scrolled')]);
  236.  
  237. =item I<$listbox>->B<untie()>
  238.  
  239. This function unties the Listbox from its "tie group". The other items
  240. in the "tie group" (if more than one) remain tied to each other.
  241.  
  242. Returns a list containing two items: the old tie option ("scroll",
  243. "selection", or "all") and the list of Listboxes that I<$listbox> was
  244. tied to.
  245.  
  246. =head1 OVERRIDDEN METHODS
  247.  
  248. You probably don't care about these. They are just details to tie
  249. together the behaviors of the listboxes.
  250.  
  251. All overriden methods take identical arguments as the corresponding
  252. B<Listbox> methods (see the B<Listbox> documentation for a full
  253. description). All overridden methods that take an index interpret that
  254. index in the context of the listbox object provided.
  255.  
  256. =item I<$listbox>->B<activate>(...)
  257. =item I<$listbox>->B<selection>(...)
  258.  
  259. To allow tied selection, these functions are overridden for listboxes
  260. tied together with the "selection" or "all" option. When an item is
  261. selected or activated in one listbox, the items with the same index
  262. (if present) are selected or activated in all tied listboxes.
  263.  
  264. The B<selection>('includes',...) submethod returns only information
  265. about the given I<$listbox>.
  266.  
  267. =item I<$listbox>->B<scan>(...)
  268. =item I<$listbox>->B<see>(...)
  269. =item I<$listbox>->B<yview>(...)
  270.  
  271. To allow tied scrolling, these functions are overridden for listboxes
  272. tied together with the "scroll" or "all" option. When one listbox is
  273. scrolled, all the other tied listboxes are scrolled by the same number
  274. of items (if possible). An attempt is made to keep items of the same
  275. index at the top of each tied listbox, while not interfering with the
  276. normal scrolling operations.
  277.  
  278. The B<yview> method with no arguments returns only information about
  279. the given I<$listbox>.
  280.  
  281. Horizontal scrolling (via B<xview>) is not tied.
  282.  
  283. =back
  284.  
  285. =head1 BUGS
  286.  
  287. Reblessing the widgets to TiedListbox might be too weird. It will
  288. disable any additional features for widgets in a class derived from
  289. Listbox (none yet that I know of).
  290.  
  291. The bindtags for reblessed widgets aren't updated. This is probably
  292. wouldn't be a good thing to do automatically anyway.
  293.  
  294. =head1 AUTHOR
  295.  
  296. B<Andrew Allen> ada@fc.hp.com
  297.  
  298. This code may be distributed under the same conditions as Perl.
  299.  
  300.  
  301.