clipboard results from the CPAN

clipboard

Tcl-pTk

view release on metacpan or search on metacpan

lib/Tcl/pTk/Clipboard.pm view on Meta::CPAN

{
 return qw[Copy Cut Paste];
}

sub ClassInit
{
 my ($class,$mw, $tag) = @_;  # optional tag for binding
 $tag ||= $class; # If not supplied $tag = $class
 foreach my $op ($class->clipEvents)
  {
   $mw->bind($tag,"<<$op>>","clipboard$op");
  }
 return $class;
}

sub clipboardSet
{
 my $w = shift;
 $w->call('clipboard', 'clear');
 $w->call('clipboard', 'append', @_);
}

sub clipboardCopy
{
 my $w = shift;
 my $val = $w->getSelected;
 if (defined $val)
  {
   $w->clipboardSet('--',$val);
  }
 return $val;
}

sub clipboardCut
{
 my $w = shift;
 my $val = $w->clipboardCopy;
 if (defined $val)
  {
   $w->deleteSelected;
  }
 return $val;
}

sub clipboardGet
{
 my $w = shift;
 $w->SelectionGet('-selection','CLIPBOARD',@_);
}

sub clipboardPaste
{
 my $w = shift;
 local $@;
# Tcl::pTk::catch
  {
     eval
     {
       $w->deleteSelected;
     };
   my $value = $w->clipboardGet;
   # print "Clipboard paste = $value\n";
   $w->insert("insert", $value);
   $w->SeeInsert if $w->can('SeeInsert');
  };
}

sub clipboardOperations
{
 my @class = ();
 my $mw    = shift;
 if (ref $mw)
  {
   $mw = $mw->DelegateFor('bind');
  }
 else
  {
   push(@class,$mw);
   $mw = shift;
  }
 while (@_)
  {
   my $op = shift;
   $mw->bind(@class,"<<$op>>","clipboard$op");
  }
}

# These methods work for Entry and Text
# and can be overridden where they don't work

sub deleteSelected
{
 my $w = shift;
 Tcl::pTk::catch { $w->delete('sel.first','sel.last') };

lib/Tcl/pTk/Entry.pm view on Meta::CPAN

our ($VERSION) = ('1.11');

use warnings;
use strict;

# Entry widget is all auto-wrapped. 
# This File primarily needed to keep from getting the double-paste problem seen, where pasting into an
#  Entry will paste the text twice, due to the standard class initialization calling the Clipboard classinit, 
#   which sets up bindings using the class name (i.e. Tcl::pTk::Entry), where Tcl/Tk has already setup bindings using the 
#   Tcl/Tk name (i.e. Entry). 
#  This removes clipboard from the inheritance, so its initialization doesn't get called

use base  qw(Tcl::pTk::Widget);



1;

lib/Tcl/pTk/TableMatrix.pm view on Meta::CPAN


		return $txt;
		
	}
}
		


# ClipboardKeysyms --
# This procedure is invoked to identify the keys that correspond to
# the "copy", "cut", and "paste" functions for the clipboard.
#
# Arguments:
# copy -	Name of the key (keysym name plus modifiers, if any,
#		such as "Meta-y") used for the copy operation.
# cut -		Name of the key used for the cut operation.
# paste -	Name of the key used for the paste operation.

sub ClipboardKeysyms
{
 my $mw = shift;

lib/Tcl/pTk/TableMatrix.pm view on Meta::CPAN

  {
   $w->colWidth($tmp,$width += $a);
  }
 else
  {
   $w->colWidth($tmp,$width += -$a);
  }
}
# Copy --
# This procedure copies the selection from a table widget into the
# clipboard.
#
# Arguments:
# w -		Name of a table widget.

sub Copy
{
 my $w = shift;
 if ($w->SelectionOwner() eq $w)
  {
   $w->clipboardClear;
   eval
    {
     $w->clipboardAppend($w->GetSelection);
    }
   ;
  }
}
# Cut --
# This procedure copies the selection from a table widget into the
# clipboard, then deletes the selection (if it exists in the given
# widget).
#
# Arguments:
# w -		Name of a table widget.

sub Cut
{
 my $w = shift;
 if ($w->SelectionOwner() eq $w)
  {
   $w->clipboardClear;
   eval
    {
     $w->clipboardAppend($w->GetSelection);
     $w->curselection('');# Clear whatever is selected
     $w->selectionClear();
    }
   ;
  }
}
# Paste --
# This procedure pastes the contents of the clipboard to the specified
# cell (active by default) in a table widget.
#
# Arguments:
# w -		Name of a table widget.
# cell -	Cell to start pasting in.

sub Paste
{
 my $w = shift;
 my $cell = shift || ''; ## Perltk not sure if translated correctly

lib/Tcl/pTk/TableMatrix/Spreadsheet.pm view on Meta::CPAN


The tab (or shift tab) key causes the current cell to be moved to the right (left).

=item *

The delete key will delete the current selection, if no cell is currently active.

=item *

The Mouse button 2 (middle button) paste from the PRIMARY. (Control-v pastes from the
clipboard).

=back

=head1 Additional Information

Widget methods, options, etc, are inherited from the L<Tcl::pTk::TableMatrix> widget. See its 
docs for additional information.

=cut

lib/Tcl/pTk/TableMatrix/Spreadsheet.pm view on Meta::CPAN

				     $self->selectionClear();
				     }
			}
			else{  # There is a current active cell, perform delete in that
				$self->deleteActive('insert');
			}
		}
		
	);
	
	# middle mouse button release pastes from PRIMARY (control v pastes from clipboard)
	 $mw->bind(
		  $class,
	 	  $mw->windowingsystem ne 'aqua' ? '<ButtonRelease-2>' : '<ButtonRelease-3>',
		  [sub
		   {
		    my $w = shift;
		    my ($x, $y) = @_;
		    $w->Paste($w->index('@' . $x.",".$y),'PRIMARY') unless ($Tcl::pTk::TableMatrix::tkPriv{'mouseMoved'});
		   }, Ev('x'), Ev('y')
                   ]

lib/Tcl/pTk/TableMatrix/Spreadsheet.pm view on Meta::CPAN

## Over-ridden Paste. 
##  This method performs pasting cells in a more Excel-like way:
##   Paste Data will be pasted into the current selection anchor point
##     if no current cell is active, otherwise it pastes starting at the active
##       cell.
##
##   If no current active cell, and no anchor point, does nothing.
sub Paste{
	 my $w = shift;
	 my $cell = shift || ''; 
	 my $source = shift || 'CLIPBOARD';  # Default is to paste from the clipboard
	 my $data;
	 
	 # Check for active cell or anchor cell:
	 unless($cell){


		my $active;    # Current active cell

		# Get the current active cell, if one exists
		eval { $active = $w->index('active'); };

lib/Tcl/pTk/Text.pm view on Meta::CPAN

   ['PostPopupMenu', Tcl::pTk::Ev('X'), Tcl::pTk::Ev('Y')],
  );
 
 # We use the 'Text' tag for the bindings below, because we are adding to the tcl text-widget
 #  bindings, which are under the 'Text' bindtag.
 $class = 'Text';
 $mw->bind($class,'<KeyPress>',['InsertKeypress',Tcl::pTk::Ev('A')]);
 $mw->bind($class,'<Insert>', \&ToggleInsertMode ) ;
 $mw->bind($class,'<Delete>','Delete');
 
 $mw->bind($class,'<F1>', 'clipboardColumnCopy');
 $mw->bind($class,'<F2>', 'clipboardColumnCut');
 $mw->bind($class,'<F3>', 'clipboardColumnPaste');
 
 $mw->bind($class,'<BackSpace>','Backspace');
 
 $mw->MouseWheelBind($class);


}


sub selectAll

lib/Tcl/pTk/Text.pm view on Meta::CPAN


sub WhatLineNumberPopUp
{
 my ($w)=@_;
 my ($line,$col) = split(/\./,$w->index('insert'));
 $w->messageBox(-type => 'Ok', -title => "What Line Number",
                -message => "The cursor is on line $line (column is $col)");
}

########################################################################
sub clipboardColumnCopy
{
 my ($w) = @_;
 $w->Column_Copy_or_Cut(0);
}

sub clipboardColumnCut
{
 my ($w) = @_;
 $w->Column_Copy_or_Cut(1);
}

########################################################################
sub Column_Copy_or_Cut
{
 my ($w, $cut) = @_;
 my @ranges = $w->tagRanges('sel');

lib/Tcl/pTk/Text.pm view on Meta::CPAN

 $string = $w->get($end_line.'.0', $end_line.'.0 lineend');
 $string = substr($string, 0, $end_column);
 $string = expand($string);
 my $tab_end_column = length($string);

 my $length = $tab_end_column - $tab_start_column;

 $selection_start_index = $start_line . '.' . $tab_start_column;
 $selection_end_index   = $end_line   . '.' . $tab_end_column;

 # clear the clipboard
 $w->clipboardClear;
 my ($clipstring, $startstring, $endstring);
 my $padded_string = ' 'x$tab_end_column;
 for(my $line = $start_line; $line <= $end_line; $line++)
  {
  $string = $w->get($line.'.0', $line.'.0 lineend');
  $string = expand($string) . $padded_string;
  $clipstring = substr($string, $tab_start_column, $length);
  #$clipstring = unexpand($clipstring);
  $w->clipboardAppend($clipstring."\n");

  if ($cut)
   {
   $startstring = substr($string, 0, $tab_start_column);
   $startstring = unexpand($startstring);
   $start_column = length($startstring);

   $endstring = substr($string, 0, $tab_end_column );
   $endstring = unexpand($endstring);
   $end_column = length($endstring);

   $w->delete($line.'.'.$start_column,  $line.'.'.$end_column);
   }
  }
}

########################################################################

sub clipboardColumnPaste
{
 my ($w) = @_;
 my @ranges = $w->tagRanges('sel');
 my $range_total = @ranges;
 if ($range_total)
  {
  warn " there cannot be any selections during clipboardColumnPaste. \n";
  $w->bell;
  return;
  }

 my $clipboard_text;
 eval
  {
  $clipboard_text = $w->SelectionGet(-selection => "CLIPBOARD");
  };

 return unless (defined($clipboard_text));
 return unless (length($clipboard_text));
 my $string;

 my $current_index = $w->index('insert');
 my ($current_line, $current_column) = split(/\./,$current_index);
 $string = $w->get($current_line.'.0', $current_line.'.'.$current_column);
 $string = expand($string);
 $current_column = length($string);

 my @clipboard_lines = split(/\n/,$clipboard_text);
 my $length;
 my $end_index;
 my ($delete_start_column, $delete_end_column, $insert_column_index);
 foreach my $line (@clipboard_lines)
  {
  if ($w->OverstrikeMode)
   {
   #figure out start and end indexes to delete, compensating for tabs.
   $string = $w->get($current_line.'.0', $current_line.'.0 lineend');
   $string = expand($string);
   $string = substr($string, 0, $current_column);
   $string = unexpand($string);
   $delete_start_column = length($string);

lib/Tcl/pTk/Text.pm view on Meta::CPAN

    ['command'=>'~Replace',       -command => [$w => 'FindAndReplacePopUp']]
   ];
}

sub EditMenuItems
{
 my ($w) = @_;
 my @items = ();
 foreach my $op ($w->clipEvents)
  {
   push(@items,['command' => "~$op", -command => [ $w => "clipboard$op"]]);
  }
 push(@items,
    '-',
    ['command'=>'Select All', -command   => [$w => 'selectAll']],
    ['command'=>'Unselect All', -command => [$w => 'unselectAll']],
  );
 return \@items;
}

sub ViewMenuItems

lib/Tcl/pTk/TextUndo.pm view on Meta::CPAN

}

sub FindAndReplaceAll
{
 my $w = shift;
 $w->addGlobStart;
 $w->SUPER::FindAndReplaceAll(@_);
 $w->addGlobEnd;
}

sub clipboardCut
{
 my $w = shift;
 $w->addGlobStart;
 $w->SUPER::clipboardCut(@_);
 $w->addGlobEnd;
}

sub clipboardPaste
{
 my $w = shift;
 $w->addGlobStart;
 $w->SUPER::clipboardPaste(@_);
 $w->addGlobEnd;
}

sub clipboardColumnCut
{
 my $w = shift;
 $w->addGlobStart;
 $w->SUPER::clipboardColumnCut(@_);
 $w->addGlobEnd;
}

sub clipboardColumnPaste
{
 my $w = shift;
 $w->addGlobStart;
 $w->SUPER::clipboardColumnPaste(@_);
 $w->addGlobEnd;
}

# Greg: this method is more tightly coupled to the base class
# than I would prefer, but I know of no other way to do it.

sub Insert
{
 my ($w,$char)=@_;
 return if $char eq '';

lib/Tcl/pTk/Widget.pm view on Meta::CPAN

			   unless $Tk::strictMotif;
		   });
   $mw->bind($class, '<5>',
		 sub { $_[0]->yview('scroll', 3, 'units')
			   unless $Tk::strictMotif;
		   });
  }
}

# Clipboard functions defined in perl/tk
sub clipboardClear{
        my $self = shift;
        $self->call('clipboard', 'clear', @_);
}
sub clipboardAppend{
        my $self = shift;
        $self->call('clipboard', 'append', @_);
}
sub clipboardGet{
        my $self = shift;
        $self->call('clipboard', 'get', @_);
}


# Method to get the patchlevel of the tcl we are using
sub tclPatchlevel{
        my $self = shift;
        return $self->interp->icall('info', 'patchlevel');
}

# Method to get the version of the tcl we are using

lib/Tcl/pTk/demos/widtrib/Gedi.pl view on Meta::CPAN

features.

Insert and Overstrike modes are also supported
in the Text.pm module. Pressing the <Insert>
key will toggle modes back and forth.

Column based copy/cut/paste features are also
available in the Text.pm module. They are bound
to the following keys:

<F1> clipboardColumnCopy
<F2> clipboardColumnCut
<F3> clipboardColumnPaste

Currently, column based operations are beta versions.
They compensate for tabs, but they will not behave
properly unless the text is all the same font, and
is the same width per character.

Hopefully some future version of Text.pm will correct
for this deficiency.

Column paste should work with overstrike mode.

t/selection.t view on Meta::CPAN

$t->tagRemove('sel','1.0','end');
$t->tagAdd('sel','1.0','1.10');




my $owner = $t->SelectionOwner();
#print "selection owner = '$owner' ref = ".ref($owner)."\n";
ok(ref($owner), 'Tcl::pTk::Text', "Unexpected object type for SelectionOwner");

# Test the clipboard
$t->tagRemove('sel','1.0','end');
$t->tagAdd('sel','1.0','1.10');
my $val = $t->clipboardCopy;
ok($val, "This windo", "Unexpected results of clipboardCopy");
#print "clip = $val\n";

my $get = $t->clipboardGet();
ok($val, "This windo", "Unexpected results of clipboardGet");
#print "clip = $get\n";


###### SelectionHanldle Test #####
$t->SelectionOwn( -selection => 'CLIPBOARD'); # Make sure $t owns the selection

# Setup SelectionHandle Callback
$t->SelectionHandle( -selection => 'CLIPBOARD',
#$t->interp->call('selection', 'handle', -selection  => 'CLIPBOARD', $t,
         sub{

( run in 0.682 second using v1.01-cache-2.11-cpan-2398b32b56e )