ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/macosx-clipboard-native
Revision: 1.3
Committed: Tue Nov 22 17:04:28 2011 UTC (12 years, 6 months ago) by sf-exg
Branch: MAIN
CVS Tags: rel-9_14, rxvt-unicode-rel-9_15
Changes since 1.2: +5 -9 lines
Log Message:
Cleanups.

File Contents

# User Rev Content
1 root 1.1 #! perl -w
2    
3     # ----------------------------------------------------------------------
4     # File: macosx-clipboard-native
5     # ----------------------------------------------------------------------
6 sf-exg 1.2 #
7 root 1.1 # All portions of code are copyright by their respective author/s.
8     # Copyright (c) 2006 Samuel Ljungkvist <salj@triplefusion.net>
9     #
10     # This program is free software; you can redistribute it and/or modify
11     # it under the terms of the GNU General Public License as published by
12     # the Free Software Foundation; either version 2 of the License, or
13     # (at your option) any later version.
14     #
15     # This program is distributed in the hope that it will be useful,
16     # but WITHOUT ANY WARRANTY; without even the implied warranty of
17     # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18     # GNU General Public License for more details.
19     #
20     # You should have received a copy of the GNU General Public License
21     # along with this program; if not, write to the Free Software
22     # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23     # ----------------------------------------------------------------------
24    
25     # Usage:
26    
27     # URxvt.perl-ext-common: macosx-clipboard
28     # URxvt.keysym.M-c: perl:macosx-clipboard:copy
29     # URxvt.keysym.M-v: perl:macosx-clipboard:paste
30    
31     use Foundation;
32    
33 sf-exg 1.3 my $appkit = NSBundle->alloc->init->initWithPath_('/System/Library/Frameworks/AppKit.framework');
34 root 1.1 $appkit->load if $appkit;
35    
36     if ($appkit->isLoaded) {
37     no strict 'refs';
38     for my $class (qw(NSPasteboard)) {
39     @{$class . '::ISA'} = 'PerlObjCBridge';
40     }
41     } else {
42     undef $appkit;
43     }
44    
45 sf-exg 1.3 my $pasteboard = NSPasteboard->generalPasteboard;
46 root 1.1
47     sub copy {
48     my ($self) = @_;
49    
50     $pasteboard->declareTypes_owner_(NSArray->arrayWithObject_('NSStringPboardType'), undef);
51     $pasteboard->setString_forType_($self->selection, 'NSStringPboardType');
52    
53     ()
54     }
55    
56     sub paste {
57     my ($self) = @_;
58    
59 sf-exg 1.3 my $type = $pasteboard->availableTypeFromArray_(NSArray->arrayWithObject_('NSStringPboardType'));
60     if ($type->isEqual_('NSStringPboardType')) {
61     my $str = $pasteboard->stringForType_($type)->UTF8String;
62 root 1.1 $str =~ tr/\n/\r/;
63     utf8::decode($str);
64     $self->tt_write($self->locale_encode($str));
65     }
66    
67     ()
68     }
69    
70     sub on_user_command {
71     my ($self, $cmd) = @_;
72    
73     if ($cmd eq "macosx-clipboard:copy") {
74     $self->copy;
75     }
76    
77     if ($cmd eq "macosx-clipboard:paste") {
78     $self->paste;
79     }
80    
81     ()
82     }
83