Tk-LabPopEntry

 view release on metacpan or  search on metacpan

LabPopEntry.pm  view on Meta::CPAN

   $dw->grabRelease;
}

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# Set the state of the various buttons based on certain criterion, detailed
# below.  Note that any non-default menu-items should automatically have 
# their state set to 'normal'.
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub setState{
   my $dw = shift; 
   my($entry, $entryVal, $selection, $clipboard);

   # For bind operations, the Entry widget is actually the first arg passed
   if(ref($dw) eq "Tk::Entry"){ 
      $entry = $dw;
      $dw = $entry->parent;
   }
   else{ $entry = $dw->cget(-entry) }

   my $menuitems = $dw->cget(-menuitems);

   $entryVal  = $entry->get;
   $selection = getSelection($dw, 'PRIMARY');
   $clipboard = getSelection($dw, 'CLIPBOARD');

   foreach my $item(@$menuitems){
      if($item->[0] =~ /Cut|Copy|Paste|Delete|Sel. All/){
         eval{$dw->{"mb_$item->[0]"}->configure(-state=>'disabled')};
      }
   }

   #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   # Only set state to 'normal' for default items if clipboard is
   # not empty or selection is present.
   #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   if(($clipboard) && ($dw->{mb_Paste})){
      eval{$dw->{mb_Paste}->configure(-state=>'normal')};
   }
   if(($selection) && ($dw->{mb_Cut})){
      eval{$dw->{mb_Cut}->configure(-state=>'normal')};
   }
   if(($selection) && ($dw->{mb_Copy})){
      eval{$dw->{mb_Copy}->configure(-state=>'normal')};
   }
   if(($selection) && ($dw->{mb_Delete})){
      eval{$dw->{mb_Delete}->configure(-state=>'normal')};
   }
   if(($entry) && ($dw->{"mb_Sel. All"}) && ($selection eq "") && ($entry->get ne "")){
      eval{$dw->{"mb_Sel. All"}->configure(-state=>'normal')};
   }

   return;


   #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   # Only set state to 'normal' for default items if clipboard is
   # not empty or selection is present.
   #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   if(defined $dw->{"mb_Paste"}){
      if(($clipboard) && ($dw->{"mb_Paste"}->cget(-state) ne 'normal')){
         eval{ $dw->{mb_Paste}->configure(-state=>'normal') };
      }
   }
   if(defined $dw->{"mb_Cut"}){
      if(($selection) && ($dw->{"mb_Cut"}->cget(-state) ne 'normal')){
         eval{ $dw->{mb_Cut}->configure(-state=>'normal') };
      }
   }
   if(defined $dw->{"mb_Copy"}){
      if(($selection) && ($dw->{"mb_Copy"}->cget(-state) ne 'normal')){

LabPopEntry.pm  view on Meta::CPAN

   if(ref($dw) eq "Tk::Entry"){ 
      $entry = $dw;
      $dw = $entry->parent;
   }
   else{ $entry = $dw->cget(-entry) }
   
   $entry->selectionRange(0,'end');
   setState($dw);
}

# Copy data to the clipboard
sub copyToClip{
   my $dw = shift;
   my $entry;

   # For bind operations, the Entry widget is actually the first arg passed
   if(ref($dw) eq "Tk::Entry"){ 
      $entry = $dw;
      $dw = $entry->parent;
   }
   else{ $entry = $dw->cget(-entry) }

   if($entry->selectionPresent){
      my $string = $entry->SelectionGet(-selection=>'PRIMARY');
      $dw->clipboardClear;
      $dw->clipboardAppend('--',$string);
   }

   my $popupmenu = $dw->Subwidget('popupmenu');
   $dw->withdrawMenu if($popupmenu->ismapped);
}

# Automatically put cut data into the clipboard
sub cutToClip{
   my $dw = shift;
   my $entry;

   # For bind operations, the Entry widget is actually the first arg passed
   if(ref($dw) eq "Tk::Entry"){ 
      $entry = $dw;
      $dw = $entry->parent;
   }
   else{ $entry = $dw->cget(-entry) }

   if($entry->selectionPresent){
      my $string = deleteSelected($entry);
      $entry->clipboardClear;
      $entry->clipboardAppend('--', $string);
   }

   my $popupmenu = $dw->Subwidget('popupmenu');
   $dw->withdrawMenu if($popupmenu->ismapped);
}

# Delete selected text
sub deleteSelected{
   my $dw = shift;

LabPopEntry.pm  view on Meta::CPAN

   else{ $entry = $dw->cget(-entry) }

   my($from,$to);
   if( ($entry->selectionPresent) ){
      $from = $entry->index('sel.first');
      $to = $entry->index('sel.last');
      $deleted_string = substr($entry->get, $from, $to-$from);
      $entry->delete($from,$to);
   }

   #$dw->clipboardClear;

   my $popupmenu = $dw->Subwidget('popupmenu');
   $dw->withdrawMenu if($popupmenu->ismapped);
   
   return $deleted_string;
}

# Paste data from the clipboard into the Entry widget
sub pasteFromClip{
   my $dw = shift;

   my($entry, $from);

   # For bind operations, the Entry widget is actually the first arg passed
   if(ref($dw) eq "Tk::Entry"){ 
      $entry = $dw;
      $dw = $entry->parent;
   }

LabPopEntry.pm  view on Meta::CPAN

LabPopEntry is a LabEntry widget with a right-click menu automatically
attached.  In addition, certain field masks can easily be applied to the entry
widget in order to force the end-user into entering only the values you want
him or her to enter.

By default, there are five items attached to the right-click menu: Cut, Copy,
Paste, Delete and Sel. All.  The default bindings for the items are Control-x,
Control-c, Control-v, Control-d, and Control-a, respectively.

The difference between 'Cut' and 'Delete' is that the former automatically
copies the contents that were cut to the clipboard, while the latter does not.

=head2 OPTIONS

B<-pattern =E<gt>> I<string>

S<   The pattern specified here creates an input mask for the LabPopEntry
widget.  There are seven pre-defined masks:> 

=over 4