home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 December / PCpro_2006_12.ISO / ossdvd / server / Perl2 / site / lib / Tk / Clipboard.pm < prev    next >
Encoding:
Perl POD Document  |  2000-03-30  |  1.7 KB  |  111 lines
  1. # Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved.
  2. # This program is free software; you can redistribute it and/or
  3. # modify it under the same terms as Perl itself.
  4. package Tk::Clipboard;
  5. use strict;
  6.  
  7. use vars qw($VERSION);
  8. $VERSION = '3.016'; # $Id: //depot/Tk8/Tk/Clipboard.pm#16 $
  9.  
  10. use AutoLoader qw(AUTOLOAD);
  11. use Tk qw(catch);
  12.  
  13. sub clipEvents
  14. {
  15.  return qw[Copy Cut Paste];
  16. }
  17.  
  18. sub ClassInit
  19. {
  20.  my ($class,$mw) = @_;
  21.  foreach my $op ($class->clipEvents)
  22.   {
  23.    $mw->Tk::bind($class,"<<$op>>","clipboard$op");
  24.   }
  25.  return $class;
  26. }
  27.  
  28. sub clipboardSet
  29. {
  30.  my $w = shift;
  31.  $w->clipboardClear;
  32.  $w->clipboardAppend(@_);
  33. }
  34.  
  35. sub clipboardCopy
  36. {
  37.  my $w = shift;
  38.  my $val = $w->getSelected;
  39.  if (defined $val)
  40.   {
  41.    $w->clipboardSet('--',$val);
  42.   }
  43.  return $val;
  44. }
  45.  
  46. sub clipboardCut
  47. {
  48.  my $w = shift;
  49.  my $val = $w->clipboardCopy;
  50.  if (defined $val)
  51.   {
  52.    $w->deleteSelected;
  53.   }
  54.  return $val;
  55. }
  56.  
  57. sub clipboardGet
  58. {
  59.  my $w = shift;
  60.  $w->SelectionGet('-selection','CLIPBOARD',@_);
  61. }
  62.  
  63. sub clipboardPaste
  64. {
  65.  my $w = shift;
  66.  local $@;
  67.  catch { $w->insert('insert',$w->clipboardGet)};
  68. }
  69.  
  70. sub clipboardOperations
  71. {
  72.  my @class = ();
  73.  my $mw    = shift;
  74.  if (ref $mw)
  75.   {
  76.    $mw = $mw->DelegateFor('bind');
  77.   }
  78.  else
  79.   {
  80.    push(@class,$mw);
  81.    $mw = shift;
  82.   }
  83.  while (@_)
  84.   {
  85.    my $op = shift;
  86.    $mw->Tk::bind(@class,"<<$op>>","clipboard$op");
  87.   }
  88. }
  89.  
  90. # These methods work for Entry and Text
  91. # and can be overridden where they don't work
  92.  
  93. sub deleteSelected
  94. {
  95.  my $w = shift;
  96.  catch { $w->delete('sel.first','sel.last') };
  97. }
  98.  
  99.  
  100. 1;
  101. __END__
  102.  
  103. sub getSelected
  104. {
  105.  my $w   = shift;
  106.  my $val = Tk::catch { $w->get('sel.first','sel.last') };
  107.  return $val;
  108. }
  109.  
  110.  
  111.