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