ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/selection-popup
Revision: 1.29
Committed: Sat May 17 13:38:23 2014 UTC (10 years ago) by root
Branch: MAIN
Changes since 1.28: +1 -1 lines
Log Message:
X_RESOURCE => RESOURCE

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3 root 1.29 #:META:RESOURCE:url-launcher:string:shell command to use
4 root 1.25
5 root 1.26 =head1 NAME
6    
7 root 1.28 selection-popup (enabled by default)
8 root 1.26
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 root 1.27 onto C<< @{ $term->{selection_popup_hook} } >>, which gets called whenever
17     the popup is being displayed.
18 root 1.26
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 root 1.4 sub msg {
37 root 1.6 my ($self, $msg) = @_;
38 root 1.4
39 root 1.6 my $overlay = $self->overlay (0, 0, $self->strwidth ($msg), 1);
40     $overlay->set (0, 0, $msg);
41 root 1.13 my $iow; $iow = urxvt::timer->new->after (1)->cb (sub {
42 root 1.4 undef $overlay;
43     undef $iow;
44     });
45     }
46    
47 root 1.1 sub on_start {
48     my ($self) = @_;
49    
50 root 1.25 $self->{browser} = $self->x_resource ("url-launcher") || "sensible-browser";
51 root 1.8
52 root 1.1 $self->grab_button (3, urxvt::ControlMask);
53 root 1.9
54     ()
55 root 1.1 }
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 root 1.4 my $orig = $_;
80 root 1.1 $cb->();
81 root 1.4
82     if ($orig ne $_) {
83     $self->selection ($_);
84 root 1.5 s/[\x00-\x1f\x80-\x9f]/·/g;
85 root 1.6 $self->msg ($self->special_encode ($_));
86 root 1.4 }
87 root 1.1 }
88     });
89     };
90    
91     for ($text) {
92 root 1.22 /\n/
93     and $add_button->("newlines to spaces" => sub { y/\n/ / });
94    
95 root 1.16 /./
96     and $add_button->("rot13" => sub { y/A-Za-z/N-ZA-Mn-za-m/ });
97    
98     /./
99 root 1.24 and $add_button->("eval perl expression" => sub { my $self = $self; no warnings; $_ = eval $_; $_ = "$@" if $@ });
100 root 1.3
101 root 1.19 /./
102     and $add_button->((sprintf "to unicode hex index (%x)", ord) => sub { $_ = sprintf "%x", ord });
103    
104 root 1.23 /(\S+):(\d+):?/
105 root 1.1 and $add_button->("vi-commands to load '$1'" => sub { s/^(\S+):(\d+):?$/\x1b:e $1\x0d:$2\x0d/ });
106 root 1.2
107 root 1.1 /%[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 root 1.2
110 root 1.4 /[\\"'\ \t|&;<>()]/
111     and $add_button->("shell quote" => sub { $_ = "\Q$_" });
112    
113 ayin 1.20 /^(https?|ftp|telnet|irc|news):\//
114 root 1.14 and $add_button->("run $self->{browser}" => sub { $self->exec_async ($self->{browser}, $_) });
115 root 1.10
116 root 1.15 for my $hook (@{ $self->{term}{selection_popup_hook} || [] }) {
117 root 1.12 if (my ($title, $cb) = $hook->($popup)) {
118     $add_button->($title, $cb);
119     }
120     }
121    
122 root 1.10 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 root 1.1 }
128    
129     $popup->show;
130    
131     return 1;
132     }
133    
134     ()
135     }
136