view release on metacpan or  search on metacpan

lib/Text/Editor/Vip/Buffer/Plugins/Clipboard.pm  view on Meta::CPAN

package Text::Editor::Vip::Buffer::Plugins::Clipboard ;

use strict;
use warnings ;

BEGIN 
{
use Exporter ();

use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION     = 0.01;
@ISA         = qw (Exporter);
@EXPORT      = qw ();
@EXPORT_OK   = qw ();
%EXPORT_TAGS = ();
}

=head1 NAME

Text::Editor::Vip::Buffer::Plugins::Clipboard - Internal clipboard handling

=head1 SYNOPSIS

  use Text::Editor::Vip::Buffer ;
  $buffer = new Text::Editor::Vip::Buffer() ;
  
 $buffer->LoadAndExpandWith('Text::Editor::Vip::Buffer::Plugins::Clipboard') ;
 
=head1 DESCRIPTION

Access Text::Editor::Vip::Buffer internal buffers.

=head1 Functions

=cut

#-------------------------------------------------------------------------------------------------------------

sub SetClipboardContents
{

=head2 SetClipboardContents

Sets the content of the named clipboard.

B<Arguments:>

=over 2

=item * clipboard name, a scalar

=item * text, a scalar, or an array ref (elements are joined to a single string)

=back

  $buffer->SetClipboardContents(4, 'something') ;
  $buffer->SetClipboardContents(4, ['something', "\n", 'hi']) ;

=cut

my ($buffer, $clipboard_name, $text_to_insert) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("SetClipboardContents: Invalid clipboard name!") ;
	return(0) ;
	}
	
if(@_ != 3)
	{
	$buffer->PrintError("SetClipboardContents: wrong number of arguments!") ;
	return(0) ;
	}

$text_to_insert ='' unless defined $text_to_insert ;
my @text_to_insert ;

if(ref($text_to_insert) eq 'ARRAY')
	{
	@text_to_insert = @$text_to_insert ;
	}
else
	{
	@text_to_insert = ($text_to_insert) ;
	}

#~ $buffer->{CLIPBOARDS}{$clipboard_name} = join('', @text_to_insert) ;

$buffer->{CLIPBOARDS}{$clipboard_name} = [@text_to_insert] ;
}

#-------------------------------------------------------------------------------------------------------------

sub GetClipboardContents
{

=head2 GetClipboardContents

Returns the contents of the named clipboard.

B<Arguments:>

=over 2

=item * clipboard name

=back

  $buffer->GetClipboardContents(4) ;

=cut

my ($buffer, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name  || '' eq $clipboard_name)
	{
	$buffer->PrintError("GetClipboardContents: Invalid clipboard name!") ;
	return('') ;
	}

if(@_ != 2)
	{
	$buffer->PrintError("GetClipboardContents: wrong number of arguments!") ;
	return('') ;
	}

#~ exists $buffer->{CLIPBOARDS}{$clipboard_name} ? $buffer->{CLIPBOARDS}{$clipboard_name}	: '' ;
if(exists $buffer->{CLIPBOARDS}{$clipboard_name})
	{
	return
		(
		join('', @{$buffer->{CLIPBOARDS}{$clipboard_name}})
		)
	}
else
	{
	return('') ;
	}
}

#-------------------------------------------------------------------------------------------------------------

sub CopySelectionToClipboard
{

=head2 CopySelectionToClipboard

Makes a copy of the selected text and copies it to the named clipboard.

B<Arguments:>

=over 2

=item * clipboard name

=back

  $buffer->CopySelectionToClipboard('some_clipboard_name') ;

=cut

my ($buffer, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("CopySelectionToClipboard: Invalid clipboard name!") ;
	return(0) ;
	}

if(@_ != 2)
	{
	$buffer->PrintError("CopySelectionToClipboard: wrong number of arguments!") ;
	return(0) ;
	}

if($buffer->IsSelectionEmpty)
	{
	# do nothing
	return(0) ;
	}
else
	{
	$buffer->RunSubOnSelection
				(
				sub
					{
					my ($text, $selection_line_index, $modification_character, $original_selection, $buffer) = @_;
					
					my $add_newline = $selection_line_index != $original_selection->GetEndLine()
											? "\n" 
											: '' ;
											
					$buffer->AppendToClipboardContents($clipboard_name, $text . $add_newline) ;
					
					# remember to not modify the line
					$text ;
					}
				, sub
					{
					$buffer->PrintError("Please select text to copy to clipboard '$clipboard_name'.\n") ;
					}
				) ;
				
	return(1) ;
	}
}

#-------------------------------------------------------------------------------------------------------------

sub InsertClipboardContents
{

=head2 InsertClipboardContents

Inserts the Contents of the named clipboard into the buffer.

B<Arguments:>

=over 2

=item * clipboard name

=back

  $buffer->InsertClipboardContents('my_clipboard') ;

=cut

my ($buffer, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("InsertClipboardContents: Invalid clipboard name!") ;
	return(0) ;
	}

if(@_ != 2)
	{
	$buffer->PrintError("InsertClipboardContents: wrong number of arguments!") ;
	return(0) ;
	}

#~ $buffer->Insert($buffer->{CLIPBOARDS}{$clipboard_name}) ;
$buffer->Insert($buffer->GetClipboardContents($clipboard_name)) ;

return(1) ;
}

#---------------------------------------------------------------------------------------------

sub ClearClipboardContents
{

=head2 ClearClipboardContents


B<Arguments:>

=over 2

=item * clipboard name

=back

  $buffer->ClearClipboardContents('clipboard_1') ;

=cut

my ($buffer, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("ClearClipboardContents: Invalid clipboard name!") ;
	return(0) ;
	}

if(@_ != 2)
	{
	$buffer->PrintError("ClearClipboardContents: wrong number of arguments!") ;
	return(0) ;
	}

delete $buffer->{CLIPBOARDS}{$clipboard_name} ;

return(1) ;
}

#---------------------------------------------------------------------------------------------

sub AppendToClipboardContents
{

=head2 AppendToClipboardContents

Adds the text argument to the end of the clipboard.

B<Arguments:>

=over 2

=item * clipboard name, a scalar

=item * text, a scalar, or an array ref (elements are joined to a single string)

=back

  $buffer->AppendToClipboardContents('clipboard_2', "some string and a newline\n") ;

=cut

my ($buffer, $clipboard_name, $text_to_insert) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("AppendToClipboardContents: Invalid clipboard name!") ;
	return(0) ;
	}

if(@_ != 3)
	{
	$buffer->PrintError("AppendToClipboardContents: wrong number of arguments!") ;
	return(0) ;
	}

$text_to_insert = '' unless defined $text_to_insert ;
my @text_to_insert ;

if(ref($text_to_insert) eq 'ARRAY')
	{
	@text_to_insert = @$text_to_insert ;
	}
else
	{
	@text_to_insert = ($text_to_insert) ;
	}

#~ $buffer->{CLIPBOARDS}{$clipboard_name} .= join('', @text_to_insert) ;

push @{$buffer->{CLIPBOARDS}{$clipboard_name}}, @text_to_insert ;

return(1) ;
}

#-------------------------------------------------------------------------------------------------------------

sub PopClipboard
{

=head2 PopClipboard

Removes the last entry of a clipboard and returnes it. An error is displayed if the clipboard is empty.

B<Arguments:>

=over 2

=item * clipboard name, a scalar

=back

  $buffer->PopClipboard(4) ;

=cut

my ($buffer, $clipboard_name, $text_to_insert) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("PopClipboard: Invalid clipboard name!") ;
	return(0) ;
	}
	
if(@_ != 2)
	{
	$buffer->PrintError("PopClipboard: wrong number of arguments!") ;
	return(0) ;
	}

if(@{$buffer->{CLIPBOARDS}{$clipboard_name}})
	{
	return( pop @{$buffer->{CLIPBOARDS}{$clipboard_name}} ) ;
	}
else
	{
	$buffer->PrintError("PopClipboard: clipboard '$clipboard_name' is empty!") ;
	return('') ;
	}
}

#-------------------------------------------------------------------------------------------------------------

sub GetNumberOfClipboardElements
{

=head2 GetNumberOfClipboardElements

Returns the number of elements in the clipboard, zero if the clipboard doesn't exist.

B<Arguments:>

=over 2

=item * clipboard name, a scalar

=back

  $buffer->GetNumberOfClipboardElements(4) ;

=cut

my ($buffer, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("PopClipboard: Invalid clipboard name!") ;
	return(0) ;
	}
	
if(@_ != 2)
	{
	$buffer->PrintError("PopClipboard: wrong number of arguments!") ;
	return(0) ;
	}

if(exists $buffer->{CLIPBOARDS}{$clipboard_name})
	{
	return(scalar (@{$buffer->{CLIPBOARDS}{$clipboard_name}})) ;
	}
else
	{
	return(0) ;
	}
}

#-------------------------------------------------------------------------------------------------------------

sub YankLineToClipboard
{

=head2 YankLineToClipboard

Removes a line from the buffer and adds it to a clipboard

B<Arguments:>

=over 2

=item * line number

=item * clipboard name, a scalar

=back

  $buffer->YankLineToClipboard(4, 'clipboard') ;

=cut

my ($buffer, $line, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("YankLineToClipboard: Invalid clipboard name!") ;
	return(0) ;
	}
	
if(@_ != 3)
	{
	$buffer->PrintError("YankLineToClipboard: wrong number of arguments!") ;
	return(0) ;
	}

if(! defined $line || $line < 0 || $line > $buffer->GetLastLineIndex())
	{
	$buffer->PrintError("SetClipboardContents: Invalid line arguments!") ;
	return(0) ;
	}
	
$buffer->AppendToClipboardContents($clipboard_name, $buffer->GetLineTextWithNewline($line));
$buffer->DeleteLine($line) ;

return(1) ;
}

#-------------------------------------------------------------------------------------------------------------

sub YankSelectionToClipboard
{

=head2 YankSelectionToClipboard

Removes the current selection from the buffer and adds it to a clipboard

B<Arguments:>

=over 2

=item * clipboard name, a scalar

=item * text, a scalar, or an array ref (elements are joined to a single string)

=back

  $buffer->YankSelectionToClipboard('clipboard') ;

=cut

my ($buffer, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("YankSelectionToClipboard: Invalid clipboard name!") ;
	return(0) ;
	}
	
if(@_ != 2)
	{
	$buffer->PrintError("YankSelectionToClipboard: wrong number of arguments!") ;
	return(0) ;
	}

$buffer->RunSubOnSelection
			(
			sub
				{
				my ($text, $selection_line_index, $modification_character, $original_selection, $buffer) = @_;
				
				#~ $buffer->AppendToClipboardContents($clipboard_name, $buffer->GetSelectionText($selection_line_index)) ;
				
				my $add_newline = $selection_line_index != $original_selection->GetEndLine()
										? "\n"
										: '' ;
										
				$buffer->AppendToClipboardContents($clipboard_name, $text . $add_newline) ;
				
				# remove selection content  from buffer
				return(undef) ;
				}
			, sub
				{
				$buffer->PrintError("Please select text to yank to clipboard '$clipboard_name'.\n") ;
				}
			) ;
			
return(1) ;

}

#-------------------------------------------------------------------------------------------------------------

sub AppendCurrentLineToClipboardContents
{

=head2 AppendCurrentLineToClipboardContents

Adds the current line  to a clipboars

B<Arguments:>

=over 2

=item * clipboard name, a scalar

=back

  $buffer->AppendCurrentLineToClipboardContents(4) ;

=cut

my ($buffer, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("AppendCurrentLineToClipboardContents: Invalid clipboard name!") ;
	return(0) ;
	}
	
if(@_ != 2)
	{
	$buffer->PrintError("AppendCurrentLineToClipboardContents: wrong number of arguments!") ;
	return(0) ;
	}

$buffer->AppendToClipboardContents($clipboard_name, $buffer->GetLineTextWithNewline()) ;

return(1) ;
}

#-------------------------------------------------------------------------------------------------------------

sub AppendSelectionToClipboardContents
{

=head2 AppendSelectionToClipboardContents

Adds the current selection to a clipboars

B<Arguments:>

=over 2

=item * clipboard name, a scalar

=back

  $buffer->AppendSelectionToClipboardContents(4, 'clipboard') ;

=cut

my ($buffer, $clipboard_name) = @_ ;

if('' ne ref $clipboard_name || ! defined $clipboard_name || '' eq $clipboard_name)
	{
	$buffer->PrintError("AppendSelectionToClipboardContents: Invalid clipboard name!") ;
	return(0) ;
	}
	
if(@_ != 2)
	{
	$buffer->PrintError("AppendSelectionToClipboardContents: wrong number of arguments!") ;
	return(0) ;
	}

unless($buffer->IsSelectionEmpty())
	{
	$buffer->AppendToClipboardContents($clipboard_name, $buffer->GetSelectionText()) ;
	}
else
	{
	$buffer->PrintError("AppendSelectionToClipboardContents: no selection!") ;
	}

return(1) ;
}

#-------------------------------------------------------------------------------------------------------------
1 ;

=head1 AUTHOR

	Khemir Nadim ibn Hamouda
	CPAN ID: NKH
	mailto:nadim@khemir.net
	http:// no web site

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut