home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / Clipboard.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  1.7 KB  |  87 lines
  1. # Copyright (c) 1995-1997 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::Widget;
  5.  
  6. sub clipboardSet
  7. {
  8.  my $w = shift;
  9.  $w->clipboardClear;
  10.  $w->clipboardAppend(@_);
  11. }
  12.  
  13. sub clipboardCopy
  14. {
  15.  my $w = shift;
  16.  if ($w->IS($w->SelectionOwner))
  17.   {
  18.    eval {local $SIG{'__DIE__'}; $w->clipboardSet('--',$w->SelectionGet) };
  19.   }
  20. }
  21.  
  22. sub clipboardCut
  23. {
  24.  my $w = shift;
  25.  if ($w->IS($w->SelectionOwner))
  26.   {
  27.    eval {local $SIG{'__DIE__'}; $w->clipboardSet('--',$w->SelectionGet) };
  28.    $w->deleteSelected;
  29.   }
  30. }
  31.  
  32. sub clipboardGet
  33. {
  34.  my $w = shift;
  35.  $w->SelectionGet("-selection","CLIPBOARD",@_);
  36. }
  37.  
  38. sub clipboardPaste
  39. {
  40.  my $w = shift;
  41.  local $@;
  42.  eval {local $SIG{__DIE__}; $w->insert("insert",$w->clipboardGet)};
  43. }
  44.  
  45. # clipboardKeysyms --
  46. # This procedure is invoked to identify the keys that correspond to
  47. # the "copy", "cut", and "paste" functions for the clipboard.
  48. #
  49. # Arguments:
  50. # copy - Name of the key (keysym name plus modifiers, if any,
  51. # such as "Meta-y") used for the copy operation.
  52. # cut - Name of the key used for the cut operation.
  53. # paste - Name of the key used for the paste operation.
  54.  
  55.  
  56. sub clipboardKeysyms
  57. {
  58.  my @class = (); 
  59.  my $mw    = shift;
  60.  if (ref $mw)
  61.   {
  62.    $mw = $mw->DelegateFor('bind');
  63.   }
  64.  else
  65.   {
  66.    push(@class,$mw);
  67.    $mw = shift;
  68.   }
  69.  if (@_)
  70.   {
  71.    my $copy  = shift;
  72.    $mw->Tk::bind(@class,"<$copy>",'clipboardCopy')   if (defined $copy);
  73.   }
  74.  if (@_)
  75.   {
  76.    my $cut   = shift;
  77.    $mw->Tk::bind(@class,"<$cut>",'clipboardCut')     if (defined $cut);
  78.   }
  79.  if (@_)
  80.   {
  81.    my $paste = shift;                                                
  82.    $mw->Tk::bind(@class,"<$paste>",'clipboardPaste') if (defined $paste);
  83.   }
  84. }
  85.  
  86. 1;
  87.