ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/selection-popup
Revision: 1.26
Committed: Sun Jun 10 17:31:53 2012 UTC (11 years, 11 months ago) by root
Branch: MAIN
Changes since 1.25: +31 -0 lines
Log Message:
move perl docs to extensions

File Contents

# Content
1 #! perl
2
3 #:META:X_RESOURCE:url-launcher:string:shell command to use
4
5 =head1 NAME
6
7 selection-popup (enabled by default)
8
9 =head1 DESCRIPTION
10
11 Binds a popup menu to Ctrl-Button3 that lets you convert the selection
12 text into various other formats/action (such as uri unescaping, perl
13 evaluation, web-browser starting etc.), depending on content.
14
15 Other extensions can extend this popup menu by pushing a code reference
16 onto C<@{ $term->{selection_popup_hook} }>, which gets called whenever the
17 popup is being displayed.
18
19 Its sole argument is the popup menu, which can be modified. The selection
20 is in C<$_>, which can be used to decide whether to add something or not.
21 It should either return nothing or a string and a code reference. The
22 string will be used as button text and the code reference will be called
23 when the button gets activated and should transform C<$_>.
24
25 The following will add an entry C<a to b> that transforms all C<a>s in
26 the selection to C<b>s, but only if the selection currently contains any
27 C<a>s:
28
29 push @{ $self->{term}{selection_popup_hook} }, sub {
30 /a/ ? ("a to b" => sub { s/a/b/g }
31 : ()
32 };
33
34 =cut
35
36 sub msg {
37 my ($self, $msg) = @_;
38
39 my $overlay = $self->overlay (0, 0, $self->strwidth ($msg), 1);
40 $overlay->set (0, 0, $msg);
41 my $iow; $iow = urxvt::timer->new->after (1)->cb (sub {
42 undef $overlay;
43 undef $iow;
44 });
45 }
46
47 sub on_start {
48 my ($self) = @_;
49
50 $self->{browser} = $self->x_resource ("url-launcher") || "sensible-browser";
51
52 $self->grab_button (3, urxvt::ControlMask);
53
54 ()
55 }
56
57 sub on_button_press {
58 my ($self, $event) = @_;
59
60 if ($event->{button} == 3 && $event->{state} & urxvt::ControlMask) {
61 my $popup = $self->popup ($event)
62 or return 1;
63
64 $popup->add_title ("Convert Selection");
65
66 my $text = $self->selection;
67
68 my $title = $text;
69 $title =~ s/[\x00-\x1f\x80-\x9f]/·/g;
70 substr $title, 40, -1, "..." if 40 < length $title;
71 $popup->add_title ($title);
72 $popup->add_separator;
73
74 my $add_button = sub {
75 my ($title, $cb) = @_;
76
77 $popup->add_button ($title => sub {
78 for ($text) {
79 my $orig = $_;
80 $cb->();
81
82 if ($orig ne $_) {
83 $self->selection ($_);
84 s/[\x00-\x1f\x80-\x9f]/·/g;
85 $self->msg ($self->special_encode ($_));
86 }
87 }
88 });
89 };
90
91 for ($text) {
92 /\n/
93 and $add_button->("newlines to spaces" => sub { y/\n/ / });
94
95 /./
96 and $add_button->("rot13" => sub { y/A-Za-z/N-ZA-Mn-za-m/ });
97
98 /./
99 and $add_button->("eval perl expression" => sub { my $self = $self; no warnings; $_ = eval $_; $_ = "$@" if $@ });
100
101 /./
102 and $add_button->((sprintf "to unicode hex index (%x)", ord) => sub { $_ = sprintf "%x", ord });
103
104 /(\S+):(\d+):?/
105 and $add_button->("vi-commands to load '$1'" => sub { s/^(\S+):(\d+):?$/\x1b:e $1\x0d:$2\x0d/ });
106
107 /%[0-9a-fA-F]{2}/ && !/%[^0-9a-fA-F]/ && !/%.[^0-9a-fA-F]/
108 and $add_button->("uri unescape" => sub { s/%([0-9a-fA-F]{2})/chr hex $1/ge });
109
110 /[\\"'\ \t|&;<>()]/
111 and $add_button->("shell quote" => sub { $_ = "\Q$_" });
112
113 /^(https?|ftp|telnet|irc|news):\//
114 and $add_button->("run $self->{browser}" => sub { $self->exec_async ($self->{browser}, $_) });
115
116 for my $hook (@{ $self->{term}{selection_popup_hook} || [] }) {
117 if (my ($title, $cb) = $hook->($popup)) {
118 $add_button->($title, $cb);
119 }
120 }
121
122 if (/^\s*((?:0x)?\d+)\s*$/) {
123 $popup->add_title (sprintf "%20s", eval $1);
124 $popup->add_title (sprintf "%20s", sprintf "0x%x", eval $1);
125 $popup->add_title (sprintf "%20s", sprintf "0%o", eval $1);
126 }
127 }
128
129 $popup->show;
130
131 return 1;
132 }
133
134 ()
135 }
136