view release on metacpan or  search on metacpan

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

   {
    my $w = shift;
    #
   }
 );



}



# ::tk::table::GetSelection --
#   This tries to obtain the default selection.  On Unix, we first try
#   and get a UTF8_STRING, a type supported by modern Unix apps for
#   passing Unicode data safely.  We fall back on the default STRING
#   type otherwise.  On Windows, only the STRING type is necessary.
# Arguments:
#   w	The widget for which the selection will be retrieved.
#	Important for the -displayof property.
#   sel	The source of the selection (PRIMARY or CLIPBOARD)
# Results:
#   Returns the selection, or an error if none could be found
#
sub GetSelection{

	my $w = shift;
	my $sel = shift;
	$sel ||= 'PRIMARY';
	
	my $txt;
	if( $Tcl::pTk::platform eq 'unix'){
		eval{ $txt = $w->SelectionGet( -selection =>  $sel) };

		if( $@){
			warn("Could not find default selection\n");
			return undef;
		}
			
		return $txt;

	}
	else{
	
		eval{ $txt = $w->SelectionGet( -selection => $sel) };

		if( $@){
			warn("Could not find default selection\n");
			return undef;
		}

		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;
 my $class = shift;
 my $copy = shift;
 my $cut = shift;
 my $paste = shift;
 $mw->bind($class,"<$copy>",'Copy');
 $mw->bind($class,"<$cut>",'Cut');
 $mw->bind($class,"<$paste>",'Paste');

}
# TableInsert --
#
#   Insert into the active cell
#
# Arguments:
#   w	- the table widget
#   s	- the string to insert
# Results:
#   Returns nothing
#

sub TableInsert
{
 my $w = shift;
 my $s = shift;
 $w->insert('active','insert',$s) if ($s ne '' ) ;
}
# ::tk::table::BackSpace --
#
#   BackSpace in the current cell
#
# Arguments:
#   w	- the table widget
# Results:
#   Returns nothing
#
sub BackSpace{
	
    my $w = shift;
    my $posn = $w->icursor;
    $w->delete('active',$posn - 1) if( $posn > -1);
}

# Button1 --
#
# This procedure is called to handle selecting with mouse button 1 (left button).
# It will distinguish whether to start selection or mark a border.
#
# Arguments:
#   w	- the table widget
#   x	- x coord

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

   $w->activate($el);
   $w->see($el);
   $w->Motion($el) if ($w->selection('includes','anchor'));
  }
 elsif ($mode =~ /multiple/i)
  {
   $w->activate($el);
   $w->see($el);
  }
}
# SelectAll
#
# This procedure is invoked to handle the "select all" operation.
# For single and browse mode, it just selects the active element.
# Otherwise it selects everything in the widget.
#
# Arguments:
# w - The table widget.

sub SelectAll
{
 my $w = shift;
 if ( $w->cget(-selectmode) =~ /^(single|browse)$/)
  {
   $w->selection('clear','all');
   $w->selection('set','active');
   $w->TableMatrixHandleType($w->index('active'));
  }
 else
  {
   $w->selection('set','origin','end');
  }
}
# ChangeWidth --
# Adjust the widget of the specified cell by $a.
#
# Arguments:
# w - The table widget.
# i - cell index
# a - amount to adjust by

sub ChangeWidth
{
 my $w = shift;
 my $i = shift;
 my $a = shift;
 my $tmp;
 my $width;
 $tmp = $w->index($i,'col');
 if (($width = $w->colWidth($tmp)) >= 0)
  {
   $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
 my $data;
 if ($cell ne '')
  {
   eval{ $data = $w->GetSelection(); }; return if($@);
  }
 else
  {
   eval{ $data = $w->GetSelection('CLIPBOARD'); }; return if($@);
   $cell = 'active';
  }
 $w->PasteHandler($w->index($cell),$data);
 $w->focus if ($w->cget('-state') eq 'normal');
}
# PasteHandler --
# This procedure handles how data is pasted into the table widget.
# This handles data in the default table selection form.
# NOTE: this allows pasting into all cells, even those with -state disabled
#
# Arguments:
# w -		Name of a table widget.
# cell -	Cell to start pasting in.

sub PasteHandler
{

 my $w = shift;
 my $cell = shift;
 my $data = shift;
 #
 # Don't allow pasting into the title cells
 #
 return if( $w->tagIncludes('title', $cell));
 my $rows;
 my $cols;
 my $r;
 my $c;
 my $rsep;
 my $csep;
 my $row;
 my $line;
 my $col;
 my $item;
 $rows = $w->cget('-rows') - $w->cget('-roworigin');
 $cols = $w->cget('-cols') - $w->cget('-colorigin');
 $r = $w->index($cell,'row');
 $c = $w->index($cell,'col');
 $rsep = $w->cget('-rowseparator');
 $csep = $w->cget('-colseparator');
 ## Assume separate rows are split by row separator if specified
 ## If you were to want multi-character row separators, you would need: