view release on metacpan or  search on metacpan

JListbox.pm  view on Meta::CPAN

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

package Tk::JListbox;
use vars qw($VERSION);
$VERSION = '.01';

use warnings;

require Tk::Derived;
require Tk::Listbox;
require Tk::Toplevel;

@ISA = qw(Tk::Derived Tk::Listbox Tk::Toplevel);

Construct Tk::Widget 'JListbox';
   
sub Populate{
	my ($dw,$args) = @_;
   $dw->SUPER::Populate($args);
   
   my $popupmenu = delete $args->{-popupmenu};
   my $justifyVal = $args->{-justify};
   
   my $menuitems;
   
   if(defined($popupmenu)){
      $popupmenu = $dw->Toplevel(-bd=>2, -relief=>'raised');
      $popupmenu->withdraw;
      
      # Default menu items.  Format is: label, callback, bind, underline.
      if(!defined($menuitems)){
         $menuitems = [
            ["Cut", 'Tk::JListbox::Jcut', '<Control-x>', 2],
            ["Copy", 'Tk::JListbox::Jcopy', '<Control-c>', 0],
            ["Paste", 'Tk::JListbox::Jpaste', '<Control-v>', 0],
         ]
      }
      
      $dw->setBindings;
   }
   
   $dw->Advertise('popupmenu' => $popupmenu) if defined $popupmenu;
 
   $dw->ConfigSpecs(
      -justify    => [qw/METHOD justify Justify left/],
      -autowidth  => [qw/PASSIVE autowidth Autowidth 0/],
      -popupmenu  => [qw/PASSIVE undef undef/, $popupmenu],
      -menuitems  => [qw/PASSIVE undef undef/, $menuitems],
      -justifyVal => [qw/PASSIVE undef undef/, $justifyVal],
      DEFAULT  => [$dw],
   );
   
}

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# Use the appropriate subroutine based on whether the user selected the 'right'
# or 'center' option, and on the type of font (proportional vs. fixed).
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub justify{
    my ($dw,$flag) = @_;
    
    my $font = $dw->cget(-font);
    my $fontVal = $dw->fontMetrics($font, -fixed);
    
    if($flag eq 'center'){     
      if($fontVal == 1){ justifyCenter_fixed($dw) }
      else{ justifyCenter_variable($dw) }
    }
    if($flag eq 'right'){ 
      if($fontVal == 1){ justifyRight_fixed($dw) }
      else{ justifyRight_variable($dw) }
    }