30 changed files with 6877 additions and 13 deletions
@ -0,0 +1,33 @@ |
|||||||
|
!Расширения Perl |
||||||
|
URxvt.perl-lib: /home/maks/.shellrc/etc/soft/urxvt/perl/ |
||||||
|
URxvt.perl-ext-common: tabbedex,readline,searchable-scrollback,matcher,font-size |
||||||
|
|
||||||
|
!Tabbedex |
||||||
|
URxvt.tabbed.autohide: true |
||||||
|
URxvt.keysym.Control-t: perl:tabbedex:new_tab |
||||||
|
URxvt.keysym.Control-Tab: perl:tabbedex:next_tab |
||||||
|
URxvt.keysym.Control-Shift-Tab: perl:tabbedex:prev_tab |
||||||
|
|
||||||
|
URxvt.tabbed.tabbar-fg: 2 |
||||||
|
URxvt.tabbed.tabbar-bg: 252 |
||||||
|
URxvt.tabbed.tab-fg: 0 |
||||||
|
URxvt.tabbed.tab-bg: 250 |
||||||
|
URxvt.tabbed.title-bg: 252 |
||||||
|
URxvt.tabbed.title-fg: 0 |
||||||
|
URxvt.tabbed.tabbar-timeouts: " " |
||||||
|
|
||||||
|
!Font-size |
||||||
|
URxvt.keysym.C-Up: font-size:increase |
||||||
|
URxvt.keysym.C-Down: font-size:decrease |
||||||
|
URxvt.keysym.C-S-Up: font-size:incglobal |
||||||
|
URxvt.keysym.C-S-Down: font-size:decglobal |
||||||
|
URxvt.keysym.C-equal: font-size:reset |
||||||
|
URxvt.keysym.C-slash: font-size:show |
||||||
|
|
||||||
|
!Matcher |
||||||
|
URxvt.url-launcher: chromium |
||||||
|
URxvt.matcher.button: 2 |
||||||
|
URxvt.colorUL: #09419b |
||||||
|
URxvt.underlineURLs: false |
||||||
|
URxvt.underlineColor: #09419b |
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,51 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
# Copyright (C) 2011 Ryan Kavanagh <ryanakca@kubuntu.org> |
||||||
|
# |
||||||
|
# This program is free software; you can redistribute it and/or modify |
||||||
|
# it under the terms of the GNU General Public License as published by |
||||||
|
# the Free Software Foundation; either version 3 of the License, or |
||||||
|
# (at your option) any later version. |
||||||
|
# |
||||||
|
# This program is distributed in the hope that it will be useful, |
||||||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||||
|
# GNU General Public License for more details. |
||||||
|
# |
||||||
|
# You should have received a copy of the GNU General Public License along |
||||||
|
# with this program; if not, write to the Free Software Foundation, Inc., |
||||||
|
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
||||||
|
|
||||||
|
#:META:RESOURCE:%:string:the shell snippet to execute |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
bell-command - execute a command when the bell rings |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Runs the command specified by the C<URxvt.bell-command> resource when |
||||||
|
a bell event occurs. For example, the following pops up a notification |
||||||
|
bubble with the text "Beep, Beep" using notify-send: |
||||||
|
|
||||||
|
URxvt.bell-command: notify-send "Beep, Beep" |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{bell_cmd} = $self->x_resource ("bell-command"); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_bell { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
if (defined $self->{bell_cmd}) { |
||||||
|
$self->exec_async ($self->{bell_cmd}); |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
@ -0,0 +1,37 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
block-graphics-to-ascii - map block graphics to ascii characters |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
A not very useful example of filtering all text output to the terminal |
||||||
|
by replacing all line-drawing characters (U+2500 .. U+259F) by a |
||||||
|
similar-looking ascii character. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
# simple example that uses the add_lines hook to filter unicode and vt100 line/box graphics |
||||||
|
|
||||||
|
# ─━│┃┄┅┆┇┈┉┊┋┌┍┎┏┐┑┒┓└┕┖┗┘┙┚┛├┝┞┟┠┡┢┣┤┥┦┧┨┩┪┫┬┭┮┯┰┱┲┳┴┵┶┷┸┹┺┻┼┽┾┿╀╁╂╃╄╅╆╇╈╉╊╋╌╍╎╏ |
||||||
|
my $rep_unicode = "--||--||--||++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--||" |
||||||
|
# ═║╒╓╔╕╖╗╘╙╚╛╜╝╞╟╠╡╢╣╤╥╦╧╨╩╪╫╬╭╮╯╰╱╲ ╳╴╵╶╷╸╹╺╻╼╽╾╿▀▁▂▃▄▅▆▇█▉▊▋▌▍▎▏▐░▒▓▔▕▖▗▘▙▚▛▜▝▞▟ |
||||||
|
. "=|+++++++++++++++++++++++++++++++/\\X-|-|-|-|-|-|#____#######|||||###~###########"; |
||||||
|
|
||||||
|
# ↑↓→←█▚ ☃HIJKLMNOPQRSTUVWXYZ[\ ]^ ◆▒␉␌␍␊°±␋┘┐┌└┼⎺⎻─⎼⎽├┤┴┬│≤≥π≠£· |
||||||
|
my $rep_acs = "↑↓<>#\\☃HIJKLMNOPQRSTUVWXYZ[\\]^ ◆#␉␌␍␊°±␋+++++⎺⎻-⎼⎽++++!<>π≠£·"; |
||||||
|
|
||||||
|
sub on_add_lines { |
||||||
|
my ($self, $str) = @_; |
||||||
|
|
||||||
|
$str =~ s/([\x{2500}-\x{259f}])/substr $rep_unicode, (ord $1) - 0x2500, 1/ge; |
||||||
|
|
||||||
|
$str =~ s/([\x41-\x7e])/substr $rep_acs, (ord $1) - 0x41, 1/ge |
||||||
|
if $self->cur_charset eq "0"; |
||||||
|
|
||||||
|
$self->scr_add_lines ($str); |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
@ -0,0 +1,30 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
clipboard-osc - implement the clipboard operating system command sequence |
||||||
|
|
||||||
|
=head1 SYNOPSIS |
||||||
|
|
||||||
|
urxvt -pe clipboard-osc |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
This extension implements the clipboard;copy Perl OSC. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
|
||||||
|
sub on_osc_seq_perl { |
||||||
|
my ($self, $osc, $resp) = @_; |
||||||
|
|
||||||
|
return unless $osc =~ s/^clipboard;([^;]+)//; |
||||||
|
|
||||||
|
if ($1 eq "copy") { |
||||||
|
my $text = $self->selection (); |
||||||
|
$self->selection ($text, 1); |
||||||
|
$self->selection_grab (urxvt::CurrentTime, 1); |
||||||
|
} |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
@ -0,0 +1,57 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
confirm-paste - ask for confirmation before pasting multiline text |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Displays a confirmation dialog when a paste containing at least a full |
||||||
|
line is detected. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub msg { |
||||||
|
my ($self, $msg) = @_; |
||||||
|
|
||||||
|
$self->{overlay} = $self->overlay (0, -1, $self->ncol, 2, urxvt::OVERLAY_RSTYLE, 0); |
||||||
|
$self->{overlay}->set (0, 0, $msg); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_tt_paste { |
||||||
|
my ($self, $str) = @_; |
||||||
|
|
||||||
|
my $count = ($str =~ tr/\012\015//); |
||||||
|
|
||||||
|
return unless $count; |
||||||
|
|
||||||
|
$self->{paste} = \$str; |
||||||
|
$self->msg ("Paste of $count lines, continue? (y/n)"); |
||||||
|
my $preview = substr $self->locale_decode ($str), 0, $self->ncol; |
||||||
|
$preview =~ s/\n/\\n/g; |
||||||
|
$self->{overlay}->set (0, 1, $self->special_encode ($preview)); |
||||||
|
$self->enable (key_press => \&key_press); |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub leave { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{paste} = undef; |
||||||
|
delete $self->{overlay}; |
||||||
|
$self->disable ("key_press"); |
||||||
|
} |
||||||
|
|
||||||
|
sub key_press { |
||||||
|
my ($self, $event, $keysym, $string) = @_; |
||||||
|
|
||||||
|
if ($keysym == 121) { # y |
||||||
|
$self->tt_paste (${$self->{paste}}); |
||||||
|
$self->leave; |
||||||
|
} elsif ($keysym == 110) { # n |
||||||
|
$self->leave; |
||||||
|
} |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
@ -0,0 +1,29 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
digital-clock - display a digital clock overlay |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Displays a digital clock using the built-in overlay. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{overlay} = $self->overlay (-1, 0, 8, 1, urxvt::OVERLAY_RSTYLE, 0); |
||||||
|
$self->{timer} = urxvt::timer |
||||||
|
->new |
||||||
|
->start (1 + int urxvt::NOW) # make sure we update "on" the second |
||||||
|
->interval (1) |
||||||
|
->cb (sub { |
||||||
|
$self->{overlay}->set (0, 0, |
||||||
|
sprintf "%2d:%02d:%02d", (localtime urxvt::NOW)[2,1,0]); |
||||||
|
}); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,119 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
eval - evaluate arbitrary perl code using actions |
||||||
|
|
||||||
|
=head1 EXAMPLES |
||||||
|
|
||||||
|
URxvt.keysym.M-c: eval:selection_to_clipboard |
||||||
|
URxvt.keysym.M-v: eval:paste_clipboard |
||||||
|
URxvt.keysym.M-V: eval:paste_primary |
||||||
|
|
||||||
|
URxvt.keysym.M-Up: eval:scroll_up 1 |
||||||
|
URxvt.keysym.M-Down: eval:scroll_down 1 |
||||||
|
URxvt.keysym.M-Home: eval:scroll_to_top |
||||||
|
URxvt.keysym.M-End: eval:scroll_to_bottom |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Add support for evaluating arbitrary perl code using actions in keysym |
||||||
|
resources. If a keysym I<action> takes the form C<eval:STRING>, the |
||||||
|
specified B<STRING> is evaluated as a Perl expression. While the full |
||||||
|
urxvt API is available, the following methods are also provided for |
||||||
|
users' convenience, as they implement basic actions: |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
our ($self); |
||||||
|
|
||||||
|
=over 4 |
||||||
|
|
||||||
|
=item scroll_up $count |
||||||
|
|
||||||
|
=item scroll_up_pages $count |
||||||
|
|
||||||
|
=item scroll_down $count |
||||||
|
|
||||||
|
=item scroll_down_pages $count |
||||||
|
|
||||||
|
Scroll up or down by C<$count> lines or pages. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub scroll_up ($) { |
||||||
|
my $lines = $_[0]; |
||||||
|
$self->view_start ($self->view_start - $lines); |
||||||
|
} |
||||||
|
|
||||||
|
sub scroll_up_pages ($) { |
||||||
|
my $lines = $_[0] * ($self->nrow - 1); |
||||||
|
$self->view_start ($self->view_start - $lines); |
||||||
|
} |
||||||
|
|
||||||
|
sub scroll_down ($) { |
||||||
|
my $lines = $_[0]; |
||||||
|
$self->view_start ($self->view_start + $lines); |
||||||
|
} |
||||||
|
|
||||||
|
sub scroll_down_pages ($) { |
||||||
|
my $lines = $_[0] * ($self->nrow - 1); |
||||||
|
$self->view_start ($self->view_start + $lines); |
||||||
|
} |
||||||
|
|
||||||
|
=item scroll_to_top |
||||||
|
|
||||||
|
=item scroll_to_bottom |
||||||
|
|
||||||
|
Scroll to the top or bottom of the scrollback. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub scroll_to_top () { |
||||||
|
$self->view_start ($self->top_row); |
||||||
|
} |
||||||
|
|
||||||
|
sub scroll_to_bottom () { |
||||||
|
$self->view_start (0); |
||||||
|
} |
||||||
|
|
||||||
|
=item selection_to_clipboard |
||||||
|
|
||||||
|
Copy the selection to the CLIPBOARD. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub selection_to_clipboard () { |
||||||
|
$self->selection ($self->selection, 1); |
||||||
|
$self->selection_grab (urxvt::CurrentTime, 1); |
||||||
|
} |
||||||
|
|
||||||
|
=item paste_primary |
||||||
|
|
||||||
|
=item paste_clipboard |
||||||
|
|
||||||
|
Paste the value of the PRIMARY or CLIPBOARD selection. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub paste_primary () { |
||||||
|
$self->selection_request (urxvt::CurrentTime, 1); |
||||||
|
} |
||||||
|
|
||||||
|
sub paste_clipboard () { |
||||||
|
$self->selection_request (urxvt::CurrentTime, 3); |
||||||
|
} |
||||||
|
|
||||||
|
=back |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_action { |
||||||
|
my ($arg_self, $action) = @_; |
||||||
|
|
||||||
|
local $self = $arg_self; |
||||||
|
eval "#line 1 \"$action\"\n$action"; |
||||||
|
die $@ if $@; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
@ -0,0 +1,57 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
example-refresh-hooks - example of how to use refresh hooks |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Displays a very simple digital clock in the upper right corner of the |
||||||
|
window. Illustrates overwriting the refresh callbacks to create your own |
||||||
|
overlays or changes. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
# force a refresh every second |
||||||
|
$self->{digital_clock_refresh} = urxvt::timer |
||||||
|
->new |
||||||
|
->start (1 + int urxvt::NOW) |
||||||
|
->interval (1) |
||||||
|
->cb (sub { $self->want_refresh }); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
# before refreshing: replace upper right with the clock display |
||||||
|
sub on_refresh_begin { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $time = sprintf "%2d:%02d:%02d", (localtime urxvt::NOW)[2, 1, 0]; |
||||||
|
my $xpos = $self->ncol - length $time; |
||||||
|
|
||||||
|
$xpos >= 0 |
||||||
|
or return; |
||||||
|
|
||||||
|
$self->{digital_clock_rend} = $self->ROW_r (0, [(urxvt::DEFAULT_RSTYLE) x length $time], $xpos); |
||||||
|
$self->{digital_clock_text} = $self->ROW_t (0, $time, $xpos); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
# after refreshing: restore previous screen contents |
||||||
|
sub on_refresh_end { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
exists $self->{digital_clock_text} |
||||||
|
or return; |
||||||
|
|
||||||
|
$self->ROW_r (0, delete $self->{digital_clock_rend}); |
||||||
|
$self->ROW_t (0, delete $self->{digital_clock_text}); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,471 @@ |
|||||||
|
#!/usr/bin/perl |
||||||
|
# |
||||||
|
# On-the-fly adjusting of the font size in urxvt |
||||||
|
# |
||||||
|
# Copyright (c) 2008 David O'Neill |
||||||
|
# 2012 Noah K. Tilton <noahktilton@gmail.com> |
||||||
|
# 2009-2012 Simon Lundström <simmel@soy.se> |
||||||
|
# 2012-2016 Jan Larres <jan@majutsushi.net> |
||||||
|
# |
||||||
|
# Permission is hereby granted, free of charge, to any person obtaining a copy |
||||||
|
# of this software and associated documentation files (the "Software"), to |
||||||
|
# deal in the Software without restriction, including without limitation the |
||||||
|
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or |
||||||
|
# sell copies of the Software, and to permit persons to whom the Software is |
||||||
|
# furnished to do so, subject to the following conditions: |
||||||
|
# |
||||||
|
# The above copyright notice and this permission notice shall be included in |
||||||
|
# all copies or substantial portions of the Software. |
||||||
|
# |
||||||
|
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
||||||
|
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
||||||
|
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
||||||
|
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
||||||
|
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING |
||||||
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS |
||||||
|
# IN THE SOFTWARE. |
||||||
|
# |
||||||
|
# URL: https://github.com/majutsushi/urxvt-font-size |
||||||
|
# |
||||||
|
# Based on: |
||||||
|
# https://github.com/dave0/urxvt-font-size |
||||||
|
# https://github.com/noah/urxvt-font |
||||||
|
# https://github.com/simmel/urxvt-resize-font |
||||||
|
# |
||||||
|
|
||||||
|
#:META:X_RESOURCE:%.step:interger:font size increase/decrease step |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
font-size - interactive font size setter |
||||||
|
|
||||||
|
=head1 USAGE |
||||||
|
|
||||||
|
Put the font-size script into $HOME/.urxvt/ext/ and add it to the list |
||||||
|
of enabled perl-extensions in ~/.Xresources: |
||||||
|
|
||||||
|
URxvt.perl-ext-common: ...,font-size |
||||||
|
|
||||||
|
Add some keybindings: |
||||||
|
|
||||||
|
URxvt.keysym.C-Up: font-size:increase |
||||||
|
URxvt.keysym.C-Down: font-size:decrease |
||||||
|
URxvt.keysym.C-S-Up: font-size:incglobal |
||||||
|
URxvt.keysym.C-S-Down: font-size:decglobal |
||||||
|
URxvt.keysym.C-equal: font-size:reset |
||||||
|
URxvt.keysym.C-slash: font-size:show |
||||||
|
|
||||||
|
Note that for urxvt versions older than 9.21 the resources have to look like this: |
||||||
|
|
||||||
|
URxvt.keysym.C-Up: perl:font-size:increase |
||||||
|
URxvt.keysym.C-Down: perl:font-size:decrease |
||||||
|
URxvt.keysym.C-S-Up: perl:font-size:incglobal |
||||||
|
URxvt.keysym.C-S-Down: perl:font-size:decglobal |
||||||
|
URxvt.keysym.C-equal: perl:font-size:reset |
||||||
|
URxvt.keysym.C-slash: perl:font-size:show |
||||||
|
|
||||||
|
Supported functions: |
||||||
|
|
||||||
|
=over 2 |
||||||
|
|
||||||
|
=item * increase/decrease: |
||||||
|
|
||||||
|
increase or decrease the font size of the current terminal. |
||||||
|
|
||||||
|
=item * incglobal/decglobal: |
||||||
|
|
||||||
|
same as above and also adjust the X server values so all newly |
||||||
|
started terminals will use the same fontsize. |
||||||
|
|
||||||
|
=item * incsave/decsave: |
||||||
|
|
||||||
|
same as incglobal/decglobal and also modify the ~/.Xresources |
||||||
|
file so the changed font sizes will persist over a restart of |
||||||
|
the X server or a reboot. |
||||||
|
|
||||||
|
=item * reset: |
||||||
|
|
||||||
|
reset the font size to the value of the resource when starting |
||||||
|
the terminal. |
||||||
|
|
||||||
|
=item * show |
||||||
|
|
||||||
|
show the current value of the 'font' resource in a popup. |
||||||
|
|
||||||
|
=back |
||||||
|
|
||||||
|
You can also change the step size that the script will use to increase |
||||||
|
the font size: |
||||||
|
|
||||||
|
URxvt.font-size.step: 4 |
||||||
|
|
||||||
|
The default step size is 1. This means that with this setting a |
||||||
|
size change sequence would be for example 8->12->16->20 instead of |
||||||
|
8->9->10->11->12 etc. Please note that many X11 fonts are only |
||||||
|
available in specific sizes, though, and odd sizes are often not |
||||||
|
available, resulting in an effective step size of 2 instead of 1 |
||||||
|
in that case. |
||||||
|
=cut |
||||||
|
|
||||||
|
use strict; |
||||||
|
use warnings; |
||||||
|
|
||||||
|
my %escapecodes = ( |
||||||
|
"font" => 710, |
||||||
|
"boldFont" => 711, |
||||||
|
"italicFont" => 712, |
||||||
|
"boldItalicFont" => 713 |
||||||
|
); |
||||||
|
|
||||||
|
sub on_start |
||||||
|
{ |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{step} = $self->x_resource("%.step") || 1; |
||||||
|
|
||||||
|
foreach my $type (qw(font boldFont italicFont boldItalicFont)) { |
||||||
|
$self->{$type} = $self->x_resource($type) || "undef"; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
# Needed for backwards compatibility with < 9.21 |
||||||
|
sub on_user_command |
||||||
|
{ |
||||||
|
my ($self, $cmd) = @_; |
||||||
|
|
||||||
|
my $step = $self->{step}; |
||||||
|
|
||||||
|
if ($cmd eq "font-size:increase") { |
||||||
|
fonts_change_size($self, $step, 0); |
||||||
|
} elsif ($cmd eq "font-size:decrease") { |
||||||
|
fonts_change_size($self, -$step, 0); |
||||||
|
} elsif ($cmd eq "font-size:incglobal") { |
||||||
|
fonts_change_size($self, $step, 1); |
||||||
|
} elsif ($cmd eq "font-size:decglobal") { |
||||||
|
fonts_change_size($self, -$step, 1); |
||||||
|
} elsif ($cmd eq "font-size:incsave") { |
||||||
|
fonts_change_size($self, $step, 2); |
||||||
|
} elsif ($cmd eq "font-size:decsave") { |
||||||
|
fonts_change_size($self, -$step, 2); |
||||||
|
} elsif ($cmd eq "font-size:reset") { |
||||||
|
fonts_reset($self); |
||||||
|
} elsif ($cmd eq "font-size:show") { |
||||||
|
fonts_show($self); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub on_action |
||||||
|
{ |
||||||
|
my ($self, $action) = @_; |
||||||
|
|
||||||
|
my $step = $self->{step}; |
||||||
|
|
||||||
|
if ($action eq "increase") { |
||||||
|
fonts_change_size($self, $step, 0); |
||||||
|
} elsif ($action eq "decrease") { |
||||||
|
fonts_change_size($self, -$step, 0); |
||||||
|
} elsif ($action eq "incglobal") { |
||||||
|
fonts_change_size($self, $step, 1); |
||||||
|
} elsif ($action eq "decglobal") { |
||||||
|
fonts_change_size($self, -$step, 1); |
||||||
|
} elsif ($action eq "incsave") { |
||||||
|
fonts_change_size($self, $step, 2); |
||||||
|
} elsif ($action eq "decsave") { |
||||||
|
fonts_change_size($self, -$step, 2); |
||||||
|
} elsif ($action eq "reset") { |
||||||
|
fonts_reset($self); |
||||||
|
} elsif ($action eq "show") { |
||||||
|
fonts_show($self); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub fonts_change_size |
||||||
|
{ |
||||||
|
my ($term, $delta, $save) = @_; |
||||||
|
|
||||||
|
my @newfonts = (); |
||||||
|
|
||||||
|
my $curres = $term->resource('font'); |
||||||
|
if (!$curres) { |
||||||
|
$term->scr_add_lines("\r\nWarning: No font configured, trying a default.\r\nPlease set a font with the 'URxvt.font' resource."); |
||||||
|
$curres = "fixed"; |
||||||
|
} |
||||||
|
my @curfonts = split(/\s*,\s*/, $curres); |
||||||
|
|
||||||
|
my $basefont = shift(@curfonts); |
||||||
|
my ($newbasefont, $newbasedelta, $newbasesize) = handle_font($term, $basefont, $delta, 0, 0); |
||||||
|
push @newfonts, $newbasefont; |
||||||
|
|
||||||
|
# Only adjust other fonts if base font changed |
||||||
|
if ($newbasefont ne $basefont) { |
||||||
|
foreach my $font (@curfonts) { |
||||||
|
my ($newfont, $newdelta, $newsize) = handle_font($term, $font, $delta, $newbasedelta, $newbasesize); |
||||||
|
push @newfonts, $newfont; |
||||||
|
} |
||||||
|
my $newres = join(",", @newfonts); |
||||||
|
font_apply_new($term, $newres, "font", $save); |
||||||
|
|
||||||
|
handle_type($term, "boldFont", $delta, $newbasedelta, $newbasesize, $save); |
||||||
|
handle_type($term, "italicFont", $delta, $newbasedelta, $newbasesize, $save); |
||||||
|
handle_type($term, "boldItalicFont", $delta, $newbasedelta, $newbasesize, $save); |
||||||
|
} |
||||||
|
|
||||||
|
if ($save > 1) { |
||||||
|
# write the new values back to the file |
||||||
|
my $xresources = readlink $ENV{"HOME"} . "/.Xresources"; |
||||||
|
system("xrdb -edit " . $xresources); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub fonts_reset |
||||||
|
{ |
||||||
|
my ($term) = @_; |
||||||
|
|
||||||
|
foreach my $type (qw(font boldFont italicFont boldItalicFont)) { |
||||||
|
my $initial = $term->{$type}; |
||||||
|
if ($initial ne "undef") { |
||||||
|
font_apply_new($term, $initial, $type, 0); |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub fonts_show |
||||||
|
{ |
||||||
|
my ($term) = @_; |
||||||
|
|
||||||
|
my $out = $term->resource('font'); |
||||||
|
$out =~ s/\s*,\s*/\n/g; |
||||||
|
|
||||||
|
$term->{'font-size'}{'overlay'} = { |
||||||
|
overlay => $term->overlay_simple(0, -1, $out), |
||||||
|
timer => urxvt::timer->new->start(urxvt::NOW + 5)->cb( |
||||||
|
sub { |
||||||
|
delete $term->{'font-size'}{'overlay'}; |
||||||
|
} |
||||||
|
), |
||||||
|
}; |
||||||
|
} |
||||||
|
|
||||||
|
sub handle_type |
||||||
|
{ |
||||||
|
my ($term, $type, $delta, $basedelta, $basesize, $save) = @_; |
||||||
|
|
||||||
|
my $curres = $term->resource($type); |
||||||
|
if (!$curres) { |
||||||
|
return; |
||||||
|
} |
||||||
|
my @curfonts = split(/\s*,\s*/, $curres); |
||||||
|
my @newfonts = (); |
||||||
|
|
||||||
|
foreach my $font (@curfonts) { |
||||||
|
my ($newfont, $newdelta, $newsize) = handle_font($term, $font, $delta, $basedelta, $basesize); |
||||||
|
push @newfonts, $newfont; |
||||||
|
} |
||||||
|
|
||||||
|
my $newres = join(",", @newfonts); |
||||||
|
font_apply_new($term, $newres, $type, $save); |
||||||
|
} |
||||||
|
|
||||||
|
sub handle_font |
||||||
|
{ |
||||||
|
my ($term, $font, $delta, $basedelta, $basesize) = @_; |
||||||
|
|
||||||
|
my $newfont; |
||||||
|
my $newdelta; |
||||||
|
my $newsize; |
||||||
|
my $prefix = 0; |
||||||
|
|
||||||
|
if ($font =~ /^\s*x:/) { |
||||||
|
$font =~ s/^\s*x://; |
||||||
|
$prefix = 1; |
||||||
|
} |
||||||
|
if ($font =~ /^\s*(\[.*\])?xft:/) { |
||||||
|
($newfont, $newdelta, $newsize) = font_change_size_xft($term, $font, $delta, $basedelta, $basesize); |
||||||
|
} elsif ($font =~ /^\s*-/) { |
||||||
|
($newfont, $newdelta, $newsize) = font_change_size_xlfd($term, $font, $delta, $basedelta, $basesize); |
||||||
|
} else { |
||||||
|
# check whether the font is a valid alias and if yes resolve it to the |
||||||
|
# actual font |
||||||
|
my $lsfinfo = `xlsfonts -l $font 2>/dev/null`; |
||||||
|
|
||||||
|
if ($lsfinfo eq "") { |
||||||
|
# not a valid alias, ring the bell if it is the base font and just |
||||||
|
# return the current font |
||||||
|
if ($basesize == 0) { |
||||||
|
$term->scr_bell; |
||||||
|
} |
||||||
|
return ($font, $basedelta, $basesize); |
||||||
|
} |
||||||
|
|
||||||
|
my $fontinfo = (split(/\n/, $lsfinfo))[-1]; |
||||||
|
my ($fontfull) = ($fontinfo =~ /\s+([-a-z0-9]+$)/); |
||||||
|
($newfont, $newdelta, $newsize) = font_change_size_xlfd($term, $fontfull, $delta, $basedelta, $basesize); |
||||||
|
} |
||||||
|
|
||||||
|
# $term->scr_add_lines("\r\nNew font is $newfont\n"); |
||||||
|
if ($prefix) { |
||||||
|
$newfont = "x:$newfont"; |
||||||
|
} |
||||||
|
return ($newfont, $newdelta, $newsize); |
||||||
|
} |
||||||
|
|
||||||
|
sub font_change_size_xft |
||||||
|
{ |
||||||
|
my ($term, $fontstring, $delta, $basedelta, $basesize) = @_; |
||||||
|
|
||||||
|
my @pieces = split(/:/, $fontstring); |
||||||
|
my @resized = (); |
||||||
|
my $size = 0; |
||||||
|
my $new_size = 0; |
||||||
|
|
||||||
|
foreach my $piece (@pieces) { |
||||||
|
if ($piece =~ /^(?:(?:pixel)?size=|[^=-]+-)(\d+(\.\d*)?)$/) { |
||||||
|
$size = $1; |
||||||
|
|
||||||
|
if ($basedelta != 0) { |
||||||
|
$new_size = $size + $basedelta; |
||||||
|
} else { |
||||||
|
$new_size = $size + $delta; |
||||||
|
} |
||||||
|
|
||||||
|
$piece =~ s/(=|-)$size/$1$new_size/; |
||||||
|
} |
||||||
|
push @resized, $piece; |
||||||
|
} |
||||||
|
|
||||||
|
my $resized_str = join(":", @resized); |
||||||
|
|
||||||
|
# don't make fonts too small |
||||||
|
if ($new_size >= 6) { |
||||||
|
return ($resized_str, $new_size - $size, $new_size); |
||||||
|
} else { |
||||||
|
if ($basesize == 0) { |
||||||
|
$term->scr_bell; |
||||||
|
} |
||||||
|
return ($fontstring, 0, $size); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub font_change_size_xlfd |
||||||
|
{ |
||||||
|
my ($term, $fontstring, $delta, $basedelta, $basesize) = @_; |
||||||
|
|
||||||
|
#-xos4-terminus-medium-r-normal-*-12-*-*-*-*-*-*-1 |
||||||
|
|
||||||
|
my @fields = qw(foundry family weight slant setwidth style pixelSize pointSize Xresolution Yresolution spacing averageWidth registry encoding); |
||||||
|
|
||||||
|
my %font; |
||||||
|
$fontstring =~ s/^-//; # Strip leading - before split |
||||||
|
@font{@fields} = split(/-/, $fontstring); |
||||||
|
|
||||||
|
if ($font{pixelSize} eq '*') { |
||||||
|
$term->scr_add_lines("\r\nWarning: Font size undefined, assuming 12.\r\nPlease set the 'URxvt.font' resource to a font with a concrete size."); |
||||||
|
$font{pixelSize} = '12' |
||||||
|
} |
||||||
|
if ($font{registry} eq '*') { |
||||||
|
$font{registry} ='iso8859'; |
||||||
|
} |
||||||
|
|
||||||
|
# Blank out the size for the pattern |
||||||
|
my %pattern = %font; |
||||||
|
$pattern{foundry} = '*'; |
||||||
|
$pattern{setwidth} = '*'; |
||||||
|
$pattern{pixelSize} = '*'; |
||||||
|
$pattern{pointSize} = '*'; |
||||||
|
# if ($basesize != 0) { |
||||||
|
# $pattern{Xresolution} = '*'; |
||||||
|
# $pattern{Yresolution} = '*'; |
||||||
|
# } |
||||||
|
$pattern{averageWidth} = '*'; |
||||||
|
# make sure there are no empty fields |
||||||
|
foreach my $field (@fields) { |
||||||
|
$pattern{$field} = '*' unless defined($pattern{$field}); |
||||||
|
} |
||||||
|
my $new_fontstring = '-' . join('-', @pattern{@fields}); |
||||||
|
|
||||||
|
my @candidates; |
||||||
|
# $term->scr_add_lines("\r\nPattern is $new_fontstring\n"); |
||||||
|
open(FOO, "xlsfonts -fn '$new_fontstring' | sort -u |") or die $!; |
||||||
|
while (<FOO>) { |
||||||
|
chomp; |
||||||
|
s/^-//; # Strip leading '-' before split |
||||||
|
my @fontdata = split(/-/, $_); |
||||||
|
|
||||||
|
push @candidates, [$fontdata[6], "-$_"]; |
||||||
|
# $term->scr_add_lines("\r\npossibly $fontdata[6] $_\n"); |
||||||
|
} |
||||||
|
close(FOO); |
||||||
|
|
||||||
|
if (!@candidates) { |
||||||
|
die "No possible fonts!"; |
||||||
|
} |
||||||
|
|
||||||
|
if ($basesize != 0) { |
||||||
|
# sort by font size, descending |
||||||
|
@candidates = sort {$b->[0] <=> $a->[0]} @candidates; |
||||||
|
|
||||||
|
# font is not the base font, so find the largest font that is at most |
||||||
|
# as large as the base font. If the largest possible font is smaller |
||||||
|
# than the base font bail and hope that a 0-size font can be found at |
||||||
|
# the end of the function |
||||||
|
if ($candidates[0]->[0] > $basesize) { |
||||||
|
foreach my $candidate (@candidates) { |
||||||
|
if ($candidate->[0] <= $basesize) { |
||||||
|
return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]); |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} elsif ($delta > 0) { |
||||||
|
# sort by font size, ascending |
||||||
|
@candidates = sort {$a->[0] <=> $b->[0]} @candidates; |
||||||
|
|
||||||
|
foreach my $candidate (@candidates) { |
||||||
|
if ($candidate->[0] >= $font{pixelSize} + $delta) { |
||||||
|
return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]); |
||||||
|
} |
||||||
|
} |
||||||
|
} elsif ($delta < 0) { |
||||||
|
# sort by font size, descending |
||||||
|
@candidates = sort {$b->[0] <=> $a->[0]} @candidates; |
||||||
|
|
||||||
|
foreach my $candidate (@candidates) { |
||||||
|
if ($candidate->[0] <= $font{pixelSize} + $delta && $candidate->[0] != 0) { |
||||||
|
return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]); |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
# no fitting font available, check whether a 0-size font can be used to |
||||||
|
# fit the size of the base font |
||||||
|
@candidates = sort {$a->[0] <=> $b->[0]} @candidates; |
||||||
|
if ($basesize != 0 && $candidates[0]->[0] == 0) { |
||||||
|
return ($candidates[0]->[1], $basedelta, $basesize); |
||||||
|
} else { |
||||||
|
# if there is absolutely no smaller/larger font that can be used |
||||||
|
# return the current one, and beep if this is the base font |
||||||
|
if ($basesize == 0) { |
||||||
|
$term->scr_bell; |
||||||
|
} |
||||||
|
return ("-$fontstring", 0, $font{pixelSize}); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub font_apply_new |
||||||
|
{ |
||||||
|
my ($term, $newfont, $type, $save) = @_; |
||||||
|
|
||||||
|
# $term->scr_add_lines("\r\nnew font is $newfont\n"); |
||||||
|
|
||||||
|
$term->cmd_parse("\033]" . $escapecodes{$type} . ";" . $newfont . "\033\\"); |
||||||
|
|
||||||
|
# load the xrdb db |
||||||
|
# system("xrdb -load " . X_RESOURCES); |
||||||
|
|
||||||
|
if ($save > 0) { |
||||||
|
# merge the new values |
||||||
|
open(XRDB_MERGE, "| xrdb -merge") || die "can't fork: $!"; |
||||||
|
local $SIG{PIPE} = sub { die "xrdb pipe broken" }; |
||||||
|
print XRDB_MERGE "URxvt." . $type . ": " . $newfont; |
||||||
|
close(XRDB_MERGE) || die "bad xrdb: $! $?"; |
||||||
|
} |
||||||
|
} |
||||||
@ -0,0 +1,37 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
keysym-list - implement the "list" keysym expansion. |
||||||
|
|
||||||
|
=head1 SYNOPSIS |
||||||
|
|
||||||
|
urxvt -pe keysym-list |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
The "list" keysym expansion was formerly part of the rxvt-unicode core, |
||||||
|
and has been moved into this extension for backwards compatibility. You |
||||||
|
shouldn't use this extension except for compatibility with old |
||||||
|
configurations. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
|
||||||
|
sub on_register_command { |
||||||
|
my ($self, $keysym, $state, $str) = @_; |
||||||
|
|
||||||
|
if ($str =~ /^list(.)/) { |
||||||
|
my @list = split /\Q$1/, $str; |
||||||
|
if (@list == 3 or @list == 4) { |
||||||
|
$self->register_command ($keysym++, $state, "string:$list[1]$_$list[3]") |
||||||
|
for split //, $list[2]; |
||||||
|
|
||||||
|
return 1; |
||||||
|
} |
||||||
|
|
||||||
|
warn "unable to parse keysym '$str' as list, processing as normal keysym\n"; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
@ -0,0 +1,85 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
#:META:RESOURCE:%.hotkey:string:activation hotkey keysym |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
kuake - kuake-like hotkey terminal |
||||||
|
|
||||||
|
=head1 EXAMPLES |
||||||
|
|
||||||
|
@@RXVT_NAME@@ -kuake-hotkey F10 |
||||||
|
|
||||||
|
URxvt.kuake.hotkey: F10 |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
A very primitive quake-console-like extension. It was inspired by a |
||||||
|
description of how the programs C<kuake> and C<yakuake> work: Whenever the |
||||||
|
user presses a global accelerator key (by default C<F10>), the terminal |
||||||
|
will show or hide itself. Another press of the accelerator key will hide |
||||||
|
or show it again. |
||||||
|
|
||||||
|
Initially, the window will not be shown when using this extension. |
||||||
|
|
||||||
|
This is useful if you need a single terminal that is not using any desktop |
||||||
|
space most of the time but is quickly available at the press of a key. |
||||||
|
|
||||||
|
The accelerator key is grabbed regardless of any modifiers, so this |
||||||
|
extension will actually grab a physical key just for this function. |
||||||
|
|
||||||
|
If you want a quake-like animation, tell your window manager to do so |
||||||
|
(fvwm can do it). |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{key} = $self->{argv}[0] || $self->x_resource ("%.hotkey") || "F10"; |
||||||
|
|
||||||
|
$self->{keysym} = $self->XStringToKeysym ($self->{key}) |
||||||
|
or urxvt::fatal "cannot convert requested kuake wake-up key '$self->{key}' to keysym, unable to continue.\n"; |
||||||
|
|
||||||
|
$self->{keycode} = $self->XKeysymToKeycode ($self->{keysym}) |
||||||
|
or urxvt::fatal "cannot convert requested kuake wake-up key '$self->{key}' to keycode, unable to continue.\n"; |
||||||
|
|
||||||
|
$self->XGrabKey ($self->{keycode}, urxvt::AnyModifier, $self->DefaultRootWindow); |
||||||
|
|
||||||
|
$self->XUnmapWindow ($self->parent); |
||||||
|
|
||||||
|
$self->{unmap_me} = 1; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_map_notify { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
# suppress initial map event |
||||||
|
$self->XUnmapWindow ($self->parent) |
||||||
|
if delete $self->{unmap_me}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_root_event { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
return unless $event->{type} == urxvt::KeyPress && $event->{keycode} == $self->{keycode}; |
||||||
|
|
||||||
|
$self->mapped |
||||||
|
? $self->XUnmapWindow ($self->parent) |
||||||
|
: $self->XMapWindow ($self->parent); |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_destroy { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->XUngrabKey ($self->XKeysymToKeycode ($self->{keysym}), 0, $self->DefaultRootWindow) |
||||||
|
if $self->{keysym}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
@ -0,0 +1,492 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
# Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.org> |
||||||
|
# Bob Farrell <robertanthonyfarrell@gmail.com> |
||||||
|
# Emanuele Giaquinta |
||||||
|
|
||||||
|
#:META:RESOURCE:%.launcher:string:default launcher command |
||||||
|
#:META:RESOURCE:%.button:string:the mouse button used to activate a match |
||||||
|
#:META:RESOURCE:%.pattern.:string:extra pattern to match |
||||||
|
#:META:RESOURCE:%.launcher.:string:custom launcher for pattern |
||||||
|
#:META:RESOURCE:%.rend.:string:custom rendition for pattern |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
matcher - match strings in terminal output and change their rendition |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Uses per-line display filtering (C<on_line_update>) to underline text |
||||||
|
matching a certain pattern and make it clickable. When clicked with the |
||||||
|
mouse button specified in the C<matcher.button> resource (default 2, or |
||||||
|
middle), the program specified in the C<matcher.launcher> resource |
||||||
|
(default, the C<url-launcher> resource, C<sensible-browser>) will be started |
||||||
|
with the matched text as first argument. The default configuration is |
||||||
|
suitable for matching URLs and launching a web browser, like the |
||||||
|
former "mark-urls" extension. |
||||||
|
|
||||||
|
The default pattern to match URLs can be overridden with the |
||||||
|
C<matcher.pattern.0> resource, and additional patterns can be specified |
||||||
|
with numbered patterns, in a manner similar to the "selection" extension. |
||||||
|
The launcher can also be overridden on a per-pattern basis. |
||||||
|
|
||||||
|
It is possible to activate the most recently seen match or a list of matches |
||||||
|
from the keyboard. Simply bind a keysym to "matcher:last" or |
||||||
|
"matcher:list" as seen in the example below. |
||||||
|
|
||||||
|
The 'matcher:select' action enables a mode in which it is possible to |
||||||
|
iterate over the matches using the keyboard and either activate them |
||||||
|
or copy them to the clipboard. While the mode is active, normal terminal |
||||||
|
input/output is suspended and the following bindings are recognized: |
||||||
|
|
||||||
|
=over 4 |
||||||
|
|
||||||
|
=item C<Up> |
||||||
|
|
||||||
|
Search for a match upwards. |
||||||
|
|
||||||
|
=item C<Down> |
||||||
|
|
||||||
|
Search for a match downwards. |
||||||
|
|
||||||
|
=item C<Home> |
||||||
|
|
||||||
|
Jump to the topmost match. |
||||||
|
|
||||||
|
=item C<End> |
||||||
|
|
||||||
|
Jump to the bottommost match. |
||||||
|
|
||||||
|
=item C<Escape> |
||||||
|
|
||||||
|
Leave the mode and return to the point where search was started. |
||||||
|
|
||||||
|
=item C<Enter> |
||||||
|
|
||||||
|
Activate the current match. |
||||||
|
|
||||||
|
=item C<y> |
||||||
|
|
||||||
|
Copy the current match to the clipboard. |
||||||
|
|
||||||
|
=back |
||||||
|
|
||||||
|
Example: load and use the matcher extension with defaults. |
||||||
|
|
||||||
|
URxvt.perl-ext: default,matcher |
||||||
|
|
||||||
|
Example: use a custom configuration. |
||||||
|
|
||||||
|
URxvt.url-launcher: sensible-browser |
||||||
|
URxvt.keysym.C-Delete: matcher:last |
||||||
|
URxvt.keysym.M-Delete: matcher:list |
||||||
|
URxvt.matcher.button: 1 |
||||||
|
URxvt.matcher.pattern.1: \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-] |
||||||
|
URxvt.matcher.pattern.2: \\B(/\\S+?):(\\d+)(?=:|$) |
||||||
|
URxvt.matcher.launcher.2: gvim +$2 $1 |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
my $url = |
||||||
|
qr{ |
||||||
|
(?:https?://|ftp://|news://|mailto:|file://|\bwww\.) |
||||||
|
[\w\-\@;\/?:&=%\$.+!*\x27,~#]* |
||||||
|
( |
||||||
|
\([\w\-\@;\/?:&=%\$.+!*\x27,~#]*\)| # Allow a pair of matched parentheses |
||||||
|
[\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic) |
||||||
|
)+ |
||||||
|
}x; |
||||||
|
|
||||||
|
sub matchlist_key_press { |
||||||
|
my ($self, $event, $keysym, $octets) = @_; |
||||||
|
|
||||||
|
delete $self->{overlay}; |
||||||
|
$self->disable ("key_press"); |
||||||
|
|
||||||
|
my $i = ($keysym == 96 ? 0 : $keysym - 48); |
||||||
|
if ($i >= 0 && $i < @{ $self->{matches} }) { |
||||||
|
my @exec = @{ $self->{matches}[$i] }; |
||||||
|
$self->exec_async (@exec[5 .. $#exec]); |
||||||
|
} |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
# backwards compat |
||||||
|
sub on_user_command { |
||||||
|
my ($self, $cmd) = @_; |
||||||
|
|
||||||
|
if ($cmd eq "matcher:list") { |
||||||
|
$self->matchlist; |
||||||
|
} elsif ($cmd eq "matcher:last") { |
||||||
|
$self->most_recent; |
||||||
|
} elsif ($cmd eq "matcher:select") { |
||||||
|
$self->select_enter; |
||||||
|
} elsif ($cmd eq "matcher") { |
||||||
|
# for backward compatibility |
||||||
|
$self->most_recent; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_action { |
||||||
|
my ($self, $action) = @_; |
||||||
|
|
||||||
|
if ($action eq "list") { |
||||||
|
$self->matchlist; |
||||||
|
} elsif ($action eq "last") { |
||||||
|
$self->most_recent; |
||||||
|
} elsif ($action eq "select") { |
||||||
|
$self->select_enter; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub matchlist { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{matches} = []; |
||||||
|
my $row = $self->nrow - 1; |
||||||
|
while ($row >= 0 && @{ $self->{matches} } < 10) { |
||||||
|
my $line = $self->line ($row); |
||||||
|
my @matches = $self->find_matches ($row); |
||||||
|
|
||||||
|
for (sort { $b->[0] <=> $a->[0] or $b->[1] <=> $a->[1] } @matches) { |
||||||
|
push @{ $self->{matches} }, $_; |
||||||
|
last if @{ $self->{matches} } == 10; |
||||||
|
} |
||||||
|
|
||||||
|
$row = $line->beg - 1; |
||||||
|
} |
||||||
|
|
||||||
|
return unless @{ $self->{matches} }; |
||||||
|
|
||||||
|
my $width = 0; |
||||||
|
|
||||||
|
my $i = 0; |
||||||
|
for my $match (@{ $self->{matches} }) { |
||||||
|
my $text = $match->[4]; |
||||||
|
my $w = $self->strwidth ("$i-$text"); |
||||||
|
|
||||||
|
$width = $w if $w > $width; |
||||||
|
$i++; |
||||||
|
} |
||||||
|
|
||||||
|
$width = $self->ncol - 2 if $width > $self->ncol - 2; |
||||||
|
|
||||||
|
$self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2); |
||||||
|
my $i = 0; |
||||||
|
for my $match (@{ $self->{matches} }) { |
||||||
|
my $text = $match->[4]; |
||||||
|
|
||||||
|
$self->{overlay}->set (0, $i, "$i-$text"); |
||||||
|
$i++; |
||||||
|
} |
||||||
|
|
||||||
|
$self->enable (key_press => \&matchlist_key_press); |
||||||
|
} |
||||||
|
|
||||||
|
sub most_recent { |
||||||
|
my ($self) = shift; |
||||||
|
my $row = $self->nrow - 1; |
||||||
|
my @exec; |
||||||
|
while ($row >= $self->top_row) { |
||||||
|
my $line = $self->line ($row); |
||||||
|
@exec = $self->command_for($row); |
||||||
|
last if(@exec); |
||||||
|
|
||||||
|
$row = $line->beg - 1; |
||||||
|
} |
||||||
|
if(@exec) { |
||||||
|
return $self->exec_async (@exec); |
||||||
|
} |
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub my_resource { |
||||||
|
$_[0]->x_resource ("%.$_[1]") |
||||||
|
} |
||||||
|
|
||||||
|
# turn a rendition spec in the resource into a sub that implements it on $_ |
||||||
|
sub parse_rend { |
||||||
|
my ($self, $str) = @_; |
||||||
|
my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str) |
||||||
|
: (urxvt::RS_Uline, undef, undef, []); |
||||||
|
warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed; |
||||||
|
my @rend; |
||||||
|
push @rend, sub { $_ |= $mask } if $mask; |
||||||
|
push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg; |
||||||
|
push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg; |
||||||
|
sub { |
||||||
|
for my $s ( @rend ) { &$s }; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser"; |
||||||
|
|
||||||
|
$self->{button} = 2; |
||||||
|
$self->{state} = 0; |
||||||
|
if($self->{argv}[0] || $self->my_resource ("button")) { |
||||||
|
my @mods = split '', $self->{argv}[0] || $self->my_resource ("button"); |
||||||
|
for my $mod (@mods) { |
||||||
|
if($mod =~ /^\d+$/) { |
||||||
|
$self->{button} = $mod; |
||||||
|
} elsif($mod eq "C") { |
||||||
|
$self->{state} |= urxvt::ControlMask; |
||||||
|
} elsif($mod eq "S") { |
||||||
|
$self->{state} |= urxvt::ShiftMask; |
||||||
|
} elsif($mod eq "M") { |
||||||
|
$self->{state} |= $self->ModMetaMask; |
||||||
|
} elsif($mod ne "-" && $mod ne " ") { |
||||||
|
warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n"); |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
my @defaults = ($url); |
||||||
|
my @matchers; |
||||||
|
for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") || $defaults[$idx]); $idx++) { |
||||||
|
$res = $self->locale_decode ($res); |
||||||
|
utf8::encode $res; |
||||||
|
my $launcher = $self->my_resource ("launcher.$idx"); |
||||||
|
$launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher; |
||||||
|
my $rend = $self->parse_rend($self->my_resource ("rend.$idx")); |
||||||
|
unshift @matchers, [qr($res)x,$launcher,$rend]; |
||||||
|
} |
||||||
|
$self->{matchers} = \@matchers; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_line_update { |
||||||
|
my ($self, $row) = @_; |
||||||
|
|
||||||
|
# fetch the line that has changed |
||||||
|
my $line = $self->line ($row); |
||||||
|
my $text = $line->t; |
||||||
|
my $rend; |
||||||
|
|
||||||
|
# find all urls (if any) |
||||||
|
for my $matcher (@{$self->{matchers}}) { |
||||||
|
while ($text =~ /$matcher->[0]/g) { |
||||||
|
#print "$&\n"; |
||||||
|
$rend ||= $line->r; |
||||||
|
|
||||||
|
# mark all characters as underlined. we _must_ not toggle underline, |
||||||
|
# as we might get called on an already-marked url. |
||||||
|
&{$matcher->[2]} |
||||||
|
for @{$rend}[$-[0] .. $+[0] - 1]; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
$line->r ($rend) if $rend; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub valid_button { |
||||||
|
my ($self, $event) = @_; |
||||||
|
my $mask = $self->ModLevel3Mask | $self->ModMetaMask |
||||||
|
| urxvt::ShiftMask | urxvt::ControlMask; |
||||||
|
return ($event->{button} == $self->{button} && |
||||||
|
($event->{state} & $mask) == $self->{state}); |
||||||
|
} |
||||||
|
|
||||||
|
sub find_matches { |
||||||
|
my ($self, $row, $col) = @_; |
||||||
|
my $line = $self->line ($row); |
||||||
|
my $text = $line->t; |
||||||
|
my $off = $line->offset_of ($row, $col) if defined $col; |
||||||
|
|
||||||
|
my @matches; |
||||||
|
for my $matcher (@{$self->{matchers}}) { |
||||||
|
my $launcher = $matcher->[1] || $self->{launcher}; |
||||||
|
while ($text =~ /$matcher->[0]/g) { |
||||||
|
my $match = substr $text, $-[0], $+[0] - $-[0]; |
||||||
|
my @begin = @-; |
||||||
|
my @end = @+; |
||||||
|
my @exec; |
||||||
|
|
||||||
|
if (!defined($off) || ($-[0] <= $off && $+[0] >= $off)) { |
||||||
|
if ($launcher !~ /\$/) { |
||||||
|
@exec = ($launcher, $match); |
||||||
|
} else { |
||||||
|
# It'd be nice to just access a list like ($&,$1,$2...), |
||||||
|
# but alas, m//g behaves differently in list context. |
||||||
|
@exec = map { s/\$(\d+)|\$\{(\d+)\}/ |
||||||
|
substr $text, $begin[$1 || $2], $end[$1 || $2] - $begin[$1 || $2] |
||||||
|
/egx; $_ } split /\s+/, $launcher; |
||||||
|
} |
||||||
|
|
||||||
|
push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ]; |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
@matches; |
||||||
|
} |
||||||
|
|
||||||
|
sub command_for { |
||||||
|
my ($self, $row, $col) = @_; |
||||||
|
|
||||||
|
my @matches = $self->find_matches ($row, $col); |
||||||
|
if (@matches) { |
||||||
|
my @match = @{ $matches[0] }; |
||||||
|
return @match[5 .. $#match]; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_press { |
||||||
|
my ($self, $event) = @_; |
||||||
|
if($self->valid_button($event) |
||||||
|
&& (my @exec = $self->command_for($event->{row},$event->{col}))) { |
||||||
|
$self->{row} = $event->{row}; |
||||||
|
$self->{col} = $event->{col}; |
||||||
|
$self->{cmd} = \@exec; |
||||||
|
return 1; |
||||||
|
} else { |
||||||
|
delete $self->{row}; |
||||||
|
delete $self->{col}; |
||||||
|
delete $self->{cmd}; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_release { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
my $row = delete $self->{row}; |
||||||
|
my $col = delete $self->{col}; |
||||||
|
my $cmd = delete $self->{cmd}; |
||||||
|
|
||||||
|
return if !defined $row; |
||||||
|
|
||||||
|
if($row == $event->{row} && abs($col-$event->{col}) < 2 |
||||||
|
&& join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) { |
||||||
|
if($self->valid_button($event)) { |
||||||
|
|
||||||
|
$self->exec_async (@$cmd); |
||||||
|
|
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub select_enter { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{view_start} = $self->view_start; |
||||||
|
$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE); |
||||||
|
$self->{cur_row} = $self->nrow - 1; |
||||||
|
|
||||||
|
$self->enable ( |
||||||
|
key_press => \&select_key_press, |
||||||
|
refresh_begin => \&select_refresh, |
||||||
|
refresh_end => \&select_refresh, |
||||||
|
); |
||||||
|
|
||||||
|
$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0); |
||||||
|
$self->{overlay}->set (0, 0, "match-select"); |
||||||
|
} |
||||||
|
|
||||||
|
sub select_leave { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->disable ("key_press", "refresh_begin", "refresh_end"); |
||||||
|
$self->pty_ev_events ($self->{pty_ev_events}); |
||||||
|
|
||||||
|
delete $self->{overlay}; |
||||||
|
delete $self->{matches}; |
||||||
|
delete $self->{id}; |
||||||
|
} |
||||||
|
|
||||||
|
sub select_search { |
||||||
|
my ($self, $dir, $row) = @_; |
||||||
|
|
||||||
|
while ($self->nrow > $row && $row >= $self->top_row) { |
||||||
|
my $line = $self->line ($row) |
||||||
|
or last; |
||||||
|
|
||||||
|
my @matches = $self->find_matches ($row); |
||||||
|
if (@matches) { |
||||||
|
@matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches; |
||||||
|
$self->{matches} = \@matches; |
||||||
|
$self->{cur_row} = $row; |
||||||
|
$self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0; |
||||||
|
$self->view_start (List::Util::min 0, $row - ($self->nrow >> 1)); |
||||||
|
$self->want_refresh; |
||||||
|
return; |
||||||
|
} |
||||||
|
|
||||||
|
$row = $dir < 0 ? $line->beg - 1 : $line->end + 1; |
||||||
|
} |
||||||
|
|
||||||
|
$self->scr_bell; |
||||||
|
} |
||||||
|
|
||||||
|
sub select_refresh { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
return unless $self->{matches}; |
||||||
|
|
||||||
|
my $cur = $self->{matches}[$self->{id}]; |
||||||
|
$self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub select_key_press { |
||||||
|
my ($self, $event, $keysym, $string) = @_; |
||||||
|
|
||||||
|
if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter |
||||||
|
if ($self->{matches}) { |
||||||
|
my @match = @{ $self->{matches}[$self->{id}] }; |
||||||
|
$self->exec_async (@match[5 .. $#match]); |
||||||
|
} |
||||||
|
$self->select_leave; |
||||||
|
} elsif ($keysym == 0x79) { # y |
||||||
|
if ($self->{matches}) { |
||||||
|
$self->selection ($self->{matches}[$self->{id}][4], 1); |
||||||
|
$self->selection_grab (urxvt::CurrentTime, 1); |
||||||
|
} |
||||||
|
$self->select_leave; |
||||||
|
} elsif ($keysym == 0xff1b) { # escape |
||||||
|
$self->view_start ($self->{view_start}); |
||||||
|
$self->select_leave; |
||||||
|
} elsif ($keysym == 0xff50) { # home |
||||||
|
$self->select_search (+1, $self->top_row) |
||||||
|
} elsif ($keysym == 0xff57) { # end |
||||||
|
$self->select_search (-1, $self->nrow - 1) |
||||||
|
} elsif ($keysym == 0xff52) { # up |
||||||
|
if ($self->{id} > 0) { |
||||||
|
$self->{id}--; |
||||||
|
$self->want_refresh; |
||||||
|
} else { |
||||||
|
my $line = $self->line ($self->{cur_row}); |
||||||
|
$self->select_search (-1, $line->beg - 1) |
||||||
|
if $line->beg > $self->top_row; |
||||||
|
} |
||||||
|
} elsif ($keysym == 0xff54) { # down |
||||||
|
if ($self->{id} < @{ $self->{matches} } - 1) { |
||||||
|
$self->{id}++; |
||||||
|
$self->want_refresh; |
||||||
|
} else { |
||||||
|
my $line = $self->line ($self->{cur_row}); |
||||||
|
$self->select_search (+1, $line->end + 1) |
||||||
|
if $line->end < $self->nrow; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
# vim:set sw=3 sts=3 et: |
||||||
@ -0,0 +1,84 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
option-popup - option menu (enabled by default) |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Binds a popup menu to Ctrl-Button2 that lets you toggle (some) options at |
||||||
|
runtime. |
||||||
|
|
||||||
|
Other extensions can extend this popup menu by pushing a code reference |
||||||
|
onto C<< @{ $term->{option_popup_hook} } >>, which gets called whenever |
||||||
|
the popup is being displayed. |
||||||
|
|
||||||
|
Its sole argument is the popup menu, which can be modified. It should |
||||||
|
either return nothing or a string, the initial boolean value and a code |
||||||
|
reference. The string will be used as button text and the code reference |
||||||
|
will be called when the toggle changes, with the new boolean value as |
||||||
|
first argument. |
||||||
|
|
||||||
|
The following will add an entry C<myoption> that changes |
||||||
|
C<< $self->{myoption} >>: |
||||||
|
|
||||||
|
push @{ $self->{term}{option_popup_hook} }, sub { |
||||||
|
("my option" => $myoption, sub { $self->{myoption} = $_[0] }) |
||||||
|
}; |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->grab_button (2, urxvt::ControlMask); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_press { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
if ($event->{button} == 2 && $event->{state} & urxvt::ControlMask) { |
||||||
|
my $popup = $self->popup ($event) |
||||||
|
or return 1; |
||||||
|
|
||||||
|
$popup->add_title ("Options"); |
||||||
|
$popup->add_separator; |
||||||
|
|
||||||
|
my %unsafe = map +($_ => 1), |
||||||
|
qw(borderLess console iconic loginShell reverseVideo |
||||||
|
scrollBar scrollBar_floating scrollBar_right |
||||||
|
secondaryScreen transparent utmpInhibit meta8 |
||||||
|
override_redirect); |
||||||
|
|
||||||
|
for my $name (sort keys %urxvt::OPTION) { |
||||||
|
next if $unsafe{$name}; |
||||||
|
|
||||||
|
my $optval = $urxvt::OPTION{$name}; |
||||||
|
|
||||||
|
$popup->add_toggle ($name => $self->option ($optval), |
||||||
|
sub { $self->option ($optval, $_[0]) }); |
||||||
|
} |
||||||
|
|
||||||
|
for my $hook (@{ $self->{term}{option_popup_hook} || [] }) { |
||||||
|
if (my ($name, $value, $cb) = $hook->($popup)) { |
||||||
|
$popup->add_toggle ($name => $value, sub { $cb->($_[0]) }); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
{ |
||||||
|
$popup->add_separator; |
||||||
|
my $locale = $self->locale; |
||||||
|
$locale =~ y/\x20-\x7e//cd; |
||||||
|
$popup->add_title ("Locale: $locale"); |
||||||
|
} |
||||||
|
|
||||||
|
$popup->show; |
||||||
|
|
||||||
|
return 1; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
@ -0,0 +1,73 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
overlay-osc - implement OSC to manage overlays |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
This extension implements some OSC commands to display timed popups on the |
||||||
|
screen - useful for status displays from within scripts. You have to read |
||||||
|
the sources for more info. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
# allows programs to open popups |
||||||
|
# printf "\033]777;overlay;action;args\007" |
||||||
|
# |
||||||
|
# action "simple;<id>;<timeout>;<x>;<y>;<h|t>;<text>" |
||||||
|
# printf "\033]777;overlay;simple;ov1;5;0;0;t;test\007" |
||||||
|
# |
||||||
|
|
||||||
|
# action "timeout;<id>;<seconds>" |
||||||
|
# printf "\033]777;overlay;timeout;ov1;6\007" |
||||||
|
|
||||||
|
# action "destroy;<id>" |
||||||
|
# printf "\033]777;overlay;destroy;ov1\007" |
||||||
|
|
||||||
|
# TODO: |
||||||
|
## action "complex;<id>;<timeout>;<x>;<y>;<width>;<height>;<rstyle>;<border>" |
||||||
|
## action "set;<id>;<x>;<y>;<h|t>;<hextext>;<rendition...>" |
||||||
|
|
||||||
|
sub on_osc_seq_perl { |
||||||
|
my ($self, $osc, $resp) = @_; |
||||||
|
|
||||||
|
return unless $osc =~ s/^overlay;//; |
||||||
|
|
||||||
|
$osc =~ s/^([^;]+)+;// |
||||||
|
or return; |
||||||
|
|
||||||
|
if ($1 eq "timeout") { |
||||||
|
my ($id, $to) = split /;/, $osc, 2; |
||||||
|
my $ov = $self->{ov}{$id} |
||||||
|
or return; |
||||||
|
if (length $to) { |
||||||
|
$ov->{to}->start (urxvt::NOW + $to); |
||||||
|
} else { |
||||||
|
delete $ov->{to}; |
||||||
|
} |
||||||
|
|
||||||
|
} elsif ($1 eq "simple") { |
||||||
|
my ($id, $to, $x, $y, $t, $txt) = split /;/, $osc, 6; |
||||||
|
if ($t eq "h") { |
||||||
|
$txt = pack "H*", $txt; |
||||||
|
utf8::decode $txt; |
||||||
|
} |
||||||
|
$self->{ov}{$id} = { |
||||||
|
ov => $self->overlay_simple ($x, $y, $txt), |
||||||
|
to => urxvt::timer |
||||||
|
->new |
||||||
|
->start (urxvt::NOW + $to) |
||||||
|
->cb(sub { |
||||||
|
delete $self->{ov}{$id}; |
||||||
|
}), |
||||||
|
}; |
||||||
|
|
||||||
|
} elsif ($1 eq "destroy") { |
||||||
|
delete $self->{ov}{$osc}; |
||||||
|
} |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,92 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
readline - improve readline editing (enabled by default) |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
A support package that tries to make editing with readline easier. At |
||||||
|
the moment, it reacts to clicking shift-left mouse button by trying to |
||||||
|
move the text cursor to this position. It does so by generating as many |
||||||
|
cursor-left or cursor-right keypresses as required (this only works |
||||||
|
for programs that correctly support wide characters). |
||||||
|
|
||||||
|
To avoid too many false positives, this is only done when: |
||||||
|
|
||||||
|
=over 4 |
||||||
|
|
||||||
|
=item - the tty is in ICANON state. |
||||||
|
|
||||||
|
=item - the text cursor is visible. |
||||||
|
|
||||||
|
=item - the primary screen is currently being displayed. |
||||||
|
|
||||||
|
=item - the mouse is on the same (multi-row-) line as the text cursor. |
||||||
|
|
||||||
|
=back |
||||||
|
|
||||||
|
The normal selection mechanism isn't disabled, so quick successive clicks |
||||||
|
might interfere with selection creation in harmless ways. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
use POSIX (); |
||||||
|
|
||||||
|
my $termios = new POSIX::Termios; |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{enabled} = 1; |
||||||
|
|
||||||
|
push @{ $self->{term}{option_popup_hook} }, sub { |
||||||
|
("readline" => $self->{enabled}, sub { $self->{enabled} = shift }) |
||||||
|
}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_press { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->current_screen || $self->hidden_cursor || !$self->{enabled} |
||||||
|
and return; |
||||||
|
|
||||||
|
my $mask = $self->ModLevel3Mask | $self->ModMetaMask |
||||||
|
| urxvt::ShiftMask | urxvt::ControlMask; |
||||||
|
|
||||||
|
($event->{state} & $mask) == urxvt::ShiftMask |
||||||
|
or return; |
||||||
|
|
||||||
|
$termios->getattr ($self->pty_fd) |
||||||
|
or return; |
||||||
|
|
||||||
|
$termios->getlflag & &POSIX::ICANON |
||||||
|
and return; |
||||||
|
|
||||||
|
my ($row, $col) = $self->screen_cur; |
||||||
|
my $line = $self->line ($row); |
||||||
|
my $cur = $line->offset_of ($row, $col); |
||||||
|
my $ofs = $line->offset_of ($event->{row}, $event->{col}); |
||||||
|
|
||||||
|
$ofs >= 0 && $ofs < $line->l |
||||||
|
or return; |
||||||
|
|
||||||
|
my $diff = $ofs - $cur; |
||||||
|
my $move; |
||||||
|
|
||||||
|
if ($diff < 0) { |
||||||
|
($ofs, $cur) = ($cur, $ofs); |
||||||
|
$move = "\x1b[D"; |
||||||
|
} else { |
||||||
|
$move = "\x1b[C"; |
||||||
|
} |
||||||
|
|
||||||
|
my $skipped = substr $line->t, $cur, $ofs - $cur; |
||||||
|
$skipped =~ s/\x{ffff}//g; |
||||||
|
|
||||||
|
$self->tt_write ($move x length $skipped); |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
@ -0,0 +1,132 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
#:META:RESOURCE:%.store:string:the command used to store the selection |
||||||
|
#:META:RESOURCE:%.fetch:string:the command used to fetch the selection |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
remote-clipboard - manage a shared and possibly remote clipboard |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Somewhat of a misnomer, this extension adds two menu entries to the |
||||||
|
selection popup that allows one to run external commands to store the |
||||||
|
selection somewhere and fetch it again. |
||||||
|
|
||||||
|
We use it to implement a "distributed selection mechanism", which just |
||||||
|
means that one command uploads the file to a remote server, and another |
||||||
|
reads it. |
||||||
|
|
||||||
|
The commands can be set using the C<URxvt.remote-selection.store> and |
||||||
|
C<URxvt.remote-selection.fetch> resources. The first should read the |
||||||
|
selection to store from STDIN (always in UTF-8), the second should provide |
||||||
|
the selection data on STDOUT (also in UTF-8). |
||||||
|
|
||||||
|
The defaults (which are likely useless to you) use rsh and cat: |
||||||
|
|
||||||
|
URxvt.remote-selection.store: rsh ruth 'cat >/tmp/distributed-selection' |
||||||
|
URxvt.remote-selection.fetch: rsh ruth 'cat /tmp/distributed-selection' |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
use Fcntl (); |
||||||
|
|
||||||
|
sub msg { |
||||||
|
my ($self, $msg) = @_; |
||||||
|
|
||||||
|
my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0); |
||||||
|
$ov->set (0, 0, $msg); |
||||||
|
|
||||||
|
$self->{msg} = |
||||||
|
urxvt::timer |
||||||
|
->new |
||||||
|
->after (5) |
||||||
|
->cb (sub { delete $self->{msg}; undef $ov; }); |
||||||
|
} |
||||||
|
|
||||||
|
sub wait_pipe { |
||||||
|
my ($self, $fh, $pid, $msg) = @_; |
||||||
|
|
||||||
|
$self->msg ("waiting for selection process to finish..."); |
||||||
|
|
||||||
|
my $wait_pipe; $wait_pipe = urxvt::pw->new->start ($pid)->cb (sub { |
||||||
|
my ($undef, $status) = @_; |
||||||
|
undef $wait_pipe; |
||||||
|
close $fh; |
||||||
|
$status >>= 8; |
||||||
|
$self->msg ("$msg (status $status)"); |
||||||
|
}); |
||||||
|
} |
||||||
|
|
||||||
|
sub store { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $txt = $self->selection; |
||||||
|
|
||||||
|
local %ENV = %{ $self->env }; |
||||||
|
if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) { |
||||||
|
fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
||||||
|
$self->{iow} = urxvt::iow |
||||||
|
->new |
||||||
|
->fd (fileno $fh) |
||||||
|
->events (urxvt::EV_WRITE) |
||||||
|
->start |
||||||
|
->cb (sub { |
||||||
|
if (my $len = syswrite $fh, $txt) { |
||||||
|
substr $txt, 0, $len, ""; |
||||||
|
$self->msg ((length $txt) . " chars to go..."); |
||||||
|
} else { |
||||||
|
delete $self->{iow}; |
||||||
|
$self->wait_pipe ($fh, $pid, "selection stored"); |
||||||
|
} |
||||||
|
}); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub fetch { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $txt; |
||||||
|
|
||||||
|
local %ENV = %{ $self->env }; |
||||||
|
if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) { |
||||||
|
fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
||||||
|
$self->{iow} = urxvt::iow |
||||||
|
->new |
||||||
|
->fd (fileno $fh) |
||||||
|
->events (urxvt::EV_READ) |
||||||
|
->start |
||||||
|
->cb (sub { |
||||||
|
if (my $len = sysread $fh, $txt, 8192, length $txt) { |
||||||
|
$self->msg ((length $txt) . " chars read..."); |
||||||
|
} else { |
||||||
|
delete $self->{iow}; |
||||||
|
$self->selection_clear; |
||||||
|
$self->selection ($txt); |
||||||
|
$self->selection_grab (urxvt::CurrentTime); |
||||||
|
$self->msg ("selection fetched"); |
||||||
|
} |
||||||
|
}); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{store_cmd} = $self->x_resource ("%.store") |
||||||
|
|| "rsh ruth 'cat >/tmp/distributed-selection'"; |
||||||
|
|
||||||
|
$self->{fetch_cmd} = $self->x_resource ("%.fetch") |
||||||
|
|| "rsh ruth 'cat /tmp/distributed-selection'"; |
||||||
|
|
||||||
|
push @{ $self->{term}{selection_popup_hook} }, sub { |
||||||
|
("selection => remote" => sub { $self->store }) |
||||||
|
}; |
||||||
|
push @{ $self->{term}{selection_popup_hook} }, sub { |
||||||
|
("remote => selection" => sub { $self->fetch }) |
||||||
|
}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,213 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
# this extension implements scrollback buffer search |
||||||
|
|
||||||
|
#:META:RESOURCE:%:string:activation hotkey keysym |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
searchable-scrollback - incremental scrollback search (enabled by default) |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
Adds regex search functionality to the scrollback buffer, triggered by |
||||||
|
the C<searchable-scrollback:start> action (bound to C<M-s> by |
||||||
|
default). While in search mode, normal terminal input/output is |
||||||
|
suspended and a regex is displayed at the bottom of the screen. |
||||||
|
|
||||||
|
Inputting characters appends them to the regex and continues incremental |
||||||
|
search. C<BackSpace> removes a character from the regex, C<Up> and C<Down> |
||||||
|
search upwards/downwards in the scrollback buffer, C<End> jumps to the |
||||||
|
bottom. C<Escape> leaves search mode and returns to the point where search |
||||||
|
was started, while C<Enter> or C<Return> stay at the current position and |
||||||
|
additionally stores the first match in the current line into the primary |
||||||
|
selection if the C<Shift> modifier is active. |
||||||
|
|
||||||
|
The regex defaults to "(?i)", resulting in a case-insensitive search. To |
||||||
|
get a case-sensitive search you can delete this prefix using C<BackSpace> |
||||||
|
or simply use an uppercase character which removes the "(?i)" prefix. |
||||||
|
|
||||||
|
See L<perlre> for more info about perl regular expression syntax. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
# only for backwards compatibility |
||||||
|
my $hotkey = $self->{argv}[0] |
||||||
|
|| $self->x_resource ("%") |
||||||
|
|| "M-s"; |
||||||
|
|
||||||
|
$self->bind_action ($hotkey, "%:start") |
||||||
|
or warn "unable to register '$hotkey' as scrollback search start hotkey\n"; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_user_command { |
||||||
|
my ($self, $cmd) = @_; |
||||||
|
|
||||||
|
$cmd eq "searchable-scrollback:start" |
||||||
|
and $self->enter; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_action { |
||||||
|
my ($self, $action) = @_; |
||||||
|
|
||||||
|
$action eq "start" |
||||||
|
and $self->enter; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub msg { |
||||||
|
my ($self, $msg) = @_; |
||||||
|
|
||||||
|
$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0); |
||||||
|
$self->{overlay}->set (0, 0, $self->special_encode ($msg)); |
||||||
|
} |
||||||
|
|
||||||
|
sub enter { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
return if $self->{overlay}; |
||||||
|
|
||||||
|
$self->{view_start} = $self->view_start; |
||||||
|
$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE); |
||||||
|
$self->{row} = $self->nrow - 1; |
||||||
|
$self->{search} = "(?i)"; |
||||||
|
|
||||||
|
$self->enable ( |
||||||
|
key_press => \&key_press, |
||||||
|
tt_write => \&tt_write, |
||||||
|
refresh_begin => \&refresh, |
||||||
|
refresh_end => \&refresh, |
||||||
|
); |
||||||
|
|
||||||
|
$self->{manpage_overlay} = $self->overlay (0, -2, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0); |
||||||
|
$self->{manpage_overlay}->set (0, 0, "scrollback search, see the ${urxvt::RXVTNAME}perl manpage for details"); |
||||||
|
|
||||||
|
$self->idle; |
||||||
|
} |
||||||
|
|
||||||
|
sub leave { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->disable ("key_press", "tt_write", "refresh_begin", "refresh_end"); |
||||||
|
$self->pty_ev_events ($self->{pty_ev_events}); |
||||||
|
|
||||||
|
delete $self->{manpage_overlay}; |
||||||
|
delete $self->{overlay}; |
||||||
|
delete $self->{search}; |
||||||
|
delete $self->{found}; |
||||||
|
} |
||||||
|
|
||||||
|
sub idle { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->msg ("(escape cancels) /$self->{search}█"); |
||||||
|
} |
||||||
|
|
||||||
|
sub search { |
||||||
|
my ($self, $dir, $row) = @_; |
||||||
|
|
||||||
|
my $search = $self->special_encode ($self->{search}); |
||||||
|
|
||||||
|
no re 'eval'; # just to be sure |
||||||
|
if (my $re = eval { qr/$search/ }) { |
||||||
|
while ($self->nrow > $row && $row >= $self->top_row) { |
||||||
|
my $line = $self->line ($row) |
||||||
|
or last; |
||||||
|
|
||||||
|
my $text = $line->t; |
||||||
|
if ($text =~ /$re/g) { |
||||||
|
delete $self->{found}; |
||||||
|
|
||||||
|
do { |
||||||
|
push @{ $self->{found} }, [$line->coord_of ($-[0]), $line->coord_of ($+[0])]; |
||||||
|
} while $text =~ /$re/g; |
||||||
|
|
||||||
|
$self->{row} = $row; |
||||||
|
$self->view_start (List::Util::min 0, $row - ($self->nrow >> 1)); |
||||||
|
$self->want_refresh; |
||||||
|
return; |
||||||
|
} |
||||||
|
|
||||||
|
$row = $dir < 0 ? $line->beg - 1 : $line->end + 1; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
$self->scr_bell; |
||||||
|
} |
||||||
|
|
||||||
|
sub refresh { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
return unless $self->{found}; |
||||||
|
|
||||||
|
my $xor = urxvt::RS_RVid | urxvt::RS_Blink; |
||||||
|
for (@{ $self->{found} }) { |
||||||
|
$self->scr_xor_span (@$_, $xor); |
||||||
|
$xor = urxvt::RS_RVid; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub key_press { |
||||||
|
my ($self, $event, $keysym, $string) = @_; |
||||||
|
|
||||||
|
delete $self->{manpage_overlay}; |
||||||
|
|
||||||
|
if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter |
||||||
|
if ($self->{found} && $event->{state} & urxvt::ShiftMask) { |
||||||
|
my ($br, $bc, $er, $ec) = @{ $self->{found}[0] }; |
||||||
|
$self->selection_beg ($br, $bc); |
||||||
|
$self->selection_end ($er, $ec); |
||||||
|
$self->selection_make ($event->{time}); |
||||||
|
} |
||||||
|
$self->leave; |
||||||
|
} elsif ($keysym == 0xff1b) { # escape |
||||||
|
$self->view_start ($self->{view_start}); |
||||||
|
$self->leave; |
||||||
|
} elsif ($keysym == 0xff57) { # end |
||||||
|
$self->{row} = $self->nrow - 1; |
||||||
|
$self->view_start (0); |
||||||
|
} elsif ($keysym == 0xff52) { # up |
||||||
|
my $line = $self->line ($self->{row}); |
||||||
|
$self->search (-1, $line->beg - 1) |
||||||
|
if $line->beg > $self->top_row; |
||||||
|
} elsif ($keysym == 0xff54) { # down |
||||||
|
my $line = $self->line ($self->{row}); |
||||||
|
$self->search (+1, $line->end + 1) |
||||||
|
if $line->end < $self->nrow; |
||||||
|
} elsif ($keysym == 0xff08) { # backspace |
||||||
|
substr $self->{search}, -1, 1, ""; |
||||||
|
$self->search (+1, $self->{row}); |
||||||
|
$self->idle; |
||||||
|
} elsif ($string !~ /[\x00-\x1f\x80-\xaf]/) { |
||||||
|
return; # pass to tt_write |
||||||
|
} |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub tt_write { |
||||||
|
my ($self, $data) = @_; |
||||||
|
|
||||||
|
$self->{search} .= $self->locale_decode ($data); |
||||||
|
|
||||||
|
$self->{search} =~ s/^\(\?i\)// |
||||||
|
if $self->{search} =~ /^\(.*[[:upper:]]/; |
||||||
|
|
||||||
|
delete $self->{found}; |
||||||
|
$self->search (-1, $self->{row}); |
||||||
|
$self->idle; |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,196 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
#:META:RESOURCE:%.pattern-0:string:first selection pattern |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
selection - more intelligent selection (enabled by default) |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
This extension tries to be more intelligent when the user extends |
||||||
|
selections (double-click and further clicks). Right now, it tries to |
||||||
|
select words, urls and complete shell-quoted arguments, which is very |
||||||
|
convenient, too, if your F<ls> supports C<--quoting-style=shell>. |
||||||
|
|
||||||
|
A double-click usually selects the word under the cursor, further clicks |
||||||
|
will enlarge the selection. |
||||||
|
|
||||||
|
The selection works by trying to match a number of regexes and displaying |
||||||
|
them in increasing order of length. You can add your own regexes by |
||||||
|
specifying resources of the form: |
||||||
|
|
||||||
|
URxvt.selection.pattern-0: perl-regex |
||||||
|
URxvt.selection.pattern-1: perl-regex |
||||||
|
... |
||||||
|
|
||||||
|
The index number (0, 1...) must not have any holes, and each regex must |
||||||
|
contain at least one pair of capturing parentheses, which will be used for |
||||||
|
the match. For example, the following adds a regex that matches everything |
||||||
|
between two vertical bars: |
||||||
|
|
||||||
|
URxvt.selection.pattern-0: \\|([^|]+)\\| |
||||||
|
|
||||||
|
Another example: Programs I use often output "absolute path: " at the |
||||||
|
beginning of a line when they process multiple files. The following |
||||||
|
pattern matches the filename (note, there is a single space at the very |
||||||
|
end): |
||||||
|
|
||||||
|
URxvt.selection.pattern-0: ^(/[^:]+):\ |
||||||
|
|
||||||
|
You can look at the source of the selection extension to see more |
||||||
|
interesting uses, such as parsing a line from beginning to end. |
||||||
|
|
||||||
|
This extension also offers the following actions: |
||||||
|
|
||||||
|
=over 4 |
||||||
|
|
||||||
|
=item rot13 |
||||||
|
|
||||||
|
Rot-13 the selection when activated. |
||||||
|
|
||||||
|
Example: |
||||||
|
|
||||||
|
URxvt.keysym.C-M-r: selection:rot13 |
||||||
|
|
||||||
|
=back |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_user_command { |
||||||
|
my ($self, $cmd) = @_; |
||||||
|
|
||||||
|
$cmd eq "selection:rot13" |
||||||
|
and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_action { |
||||||
|
my ($self, $action) = @_; |
||||||
|
|
||||||
|
$action eq "rot13" |
||||||
|
and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
if (defined (my $res = $self->resource ("cutchars"))) { |
||||||
|
$res = $self->locale_decode ($res); |
||||||
|
push @{ $self->{patterns} }, qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x; |
||||||
|
} |
||||||
|
|
||||||
|
for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) { |
||||||
|
$res = $self->locale_decode ($res); |
||||||
|
push @{ $self->{patterns} }, qr/$res/; |
||||||
|
} |
||||||
|
|
||||||
|
$self->{enabled} = 1; |
||||||
|
|
||||||
|
push @{ $self->{term}{option_popup_hook} }, sub { |
||||||
|
("new selection" => $self->{enabled}, sub { $self->{enabled} = shift }) |
||||||
|
}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
# "find interesting things"-patterns |
||||||
|
my @mark_patterns = ( |
||||||
|
# qr{ ([[:word:]]+) }x, |
||||||
|
qr{ ([^[:space:]]+) }x, |
||||||
|
|
||||||
|
# common types of "parentheses" |
||||||
|
qr{ (?<![^[:space:]]) [`'] ([^`']+) [`'] (?![^[:space:]]) }x, |
||||||
|
qr{ (?<![^[:space:]]) ‘ ([^‘’]+) ’ (?![^[:space:]]) }x, |
||||||
|
qr{ (?<![^[:space:]]) “ ([^“”]+) ” (?![^[:space:]]) }x, |
||||||
|
|
||||||
|
qr{ (?<![^[:space:]]) (' [^[:space:]] [^']* ') }x, |
||||||
|
qr{ (' [^']* [^[:space:]] ') (?![^[:space:]]) }x, |
||||||
|
qr{ (?<![^[:space:]]) (` [^[:space:]] [^']* ') }x, |
||||||
|
qr{ (` [^']* [^[:space:]] ') (?![^[:space:]]) }x, |
||||||
|
qr{ (?<![^[:space:]]) (" [^[:space:]] [^"]* ") }x, |
||||||
|
qr{ (" [^"]* [^[:space:]] ") (?![^[:space:]]) }x, |
||||||
|
|
||||||
|
qr{ \{ ([^\{\}]+) \} }x, |
||||||
|
qr{ \( ([^\(\)]+) \) }x, |
||||||
|
qr{ \[ ([^\[\]]+) \] }x, |
||||||
|
qr{ \< ([^\<\>]+) \> }x, |
||||||
|
|
||||||
|
# urls, just a heuristic |
||||||
|
qr{( |
||||||
|
(?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+ |
||||||
|
[ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~] # exclude some trailing characters (heuristic) |
||||||
|
)}x, |
||||||
|
|
||||||
|
# shell-like argument quoting, basically always matches |
||||||
|
qr{\G [\ \t|&;<>()]* ( |
||||||
|
(?: |
||||||
|
[^\\"'\ \t|&;<>()]+ |
||||||
|
| \\. |
||||||
|
| " (?: [^\\"]+ | \\. )* " |
||||||
|
| ' [^']* ' |
||||||
|
)+ |
||||||
|
)}x, |
||||||
|
); |
||||||
|
|
||||||
|
# "correct obvious? crap"-patterns |
||||||
|
my @simplify_patterns = ( |
||||||
|
qr{^"([^\\"'\ \t|&;<>()*?]+)"$}, # "simple" => simple |
||||||
|
qr{^(.*)[,\-]$}, # strip off trailing , and - |
||||||
|
); |
||||||
|
|
||||||
|
sub on_sel_extend { |
||||||
|
my ($self, $time) = @_; |
||||||
|
|
||||||
|
$self->{enabled} |
||||||
|
or return; |
||||||
|
|
||||||
|
my ($row, $col) = $self->selection_mark; |
||||||
|
my $line = $self->line ($row); |
||||||
|
my $text = $line->t; |
||||||
|
my $markofs = $line->offset_of ($row, $col); |
||||||
|
my $curlen = $line->offset_of ($self->selection_end) |
||||||
|
- $line->offset_of ($self->selection_beg); |
||||||
|
|
||||||
|
my @matches; |
||||||
|
|
||||||
|
if ($markofs < $line->l) { |
||||||
|
study $text; # _really_ helps, too :) |
||||||
|
|
||||||
|
for my $regex (@mark_patterns, @{ $self->{patterns} }) { |
||||||
|
while ($text =~ /$regex/g) { |
||||||
|
if ($-[1] <= $markofs and $markofs <= $+[1]) { |
||||||
|
my $ofs = $-[1]; |
||||||
|
my $match = $1; |
||||||
|
|
||||||
|
for my $regex (@simplify_patterns) { |
||||||
|
if ($match =~ $regex) { |
||||||
|
$match = $1; |
||||||
|
$ofs += $-[1]; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
push @matches, [$ofs, length $match]; |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
# whole line |
||||||
|
push @matches, [0, ($line->end - $line->beg + 1) * $self->ncol]; |
||||||
|
|
||||||
|
for (sort { $a->[1] <=> $b->[1] or $b->[0] <=> $a->[0] } @matches) { |
||||||
|
my ($ofs, $len) = @$_; |
||||||
|
|
||||||
|
next if $len <= $curlen; |
||||||
|
|
||||||
|
$self->selection_beg ($line->coord_of ($ofs)); |
||||||
|
$self->selection_end ($line->coord_of ($ofs + $len)); |
||||||
|
return 1; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
@ -0,0 +1,101 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
#:META:RESOURCE:%.:string:autotransform expression |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
selection-autotransform - automatically transform select text |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
This selection allows you to do automatic transforms on a selection |
||||||
|
whenever a selection is made. |
||||||
|
|
||||||
|
It works by specifying perl snippets (most useful is a single C<s///> |
||||||
|
operator) that modify C<$_> as resources: |
||||||
|
|
||||||
|
URxvt.selection-autotransform.0: transform |
||||||
|
URxvt.selection-autotransform.1: transform |
||||||
|
... |
||||||
|
|
||||||
|
For example, the following will transform selections of the form |
||||||
|
C<filename:number>, often seen in compiler messages, into C<vi +$filename |
||||||
|
$word>: |
||||||
|
|
||||||
|
URxvt.selection-autotransform.0: s/^([^:[:space:]]+):(\\d+):?$/vi +$2 \\Q$1\\E\\x0d/ |
||||||
|
|
||||||
|
And this example matches the same,but replaces it with vi-commands you can |
||||||
|
paste directly into your (vi :) editor: |
||||||
|
|
||||||
|
URxvt.selection-autotransform.0: s/^([^:[:space:]]+(\\d+):?$/:e \\Q$1\\E\\x0d:$2\\x0d/ |
||||||
|
|
||||||
|
Of course, this can be modified to suit your needs and your editor :) |
||||||
|
|
||||||
|
To expand the example above to typical perl error messages ("XXX at |
||||||
|
FILENAME line YYY."), you need a slightly more elaborate solution: |
||||||
|
|
||||||
|
URxvt.selection.pattern-0: ( at .*? line \\d+[,.]) |
||||||
|
URxvt.selection-autotransform.0: s/^ at (.*?) line (\\d+)[,.]$/:e \\Q$1\E\\x0d:$2\\x0d/ |
||||||
|
|
||||||
|
The first line tells the selection code to treat the unchanging part of |
||||||
|
every error message as a selection pattern, and the second line transforms |
||||||
|
the message into vi commands to load the file. |
||||||
|
|
||||||
|
=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 (2)->cb (sub { |
||||||
|
delete $self->{timer}; |
||||||
|
undef $overlay; |
||||||
|
}); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
for (my $idx = 0; defined (my $res = $self->x_resource ("%.$idx")); $idx++) { |
||||||
|
$res = $self->locale_decode ($res); |
||||||
|
my $transform = eval "sub { $res }"; |
||||||
|
|
||||||
|
if ($transform) { |
||||||
|
push @{ $self->{transforms} }, $transform; |
||||||
|
} else { |
||||||
|
warn "$res: $@"; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
$self->{enabled} = 1; |
||||||
|
|
||||||
|
push @{ $self->{term}{option_popup_hook} }, sub { |
||||||
|
("autotransform" => $self->{enabled}, sub { $self->{enabled} = shift }) |
||||||
|
}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_sel_grab { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{enabled} |
||||||
|
or return; |
||||||
|
|
||||||
|
my $text = $self->selection; |
||||||
|
local $_ = $text; |
||||||
|
|
||||||
|
for my $transform (@{ $self->{transforms} }) { |
||||||
|
$transform->(); |
||||||
|
if ($text ne $_) { |
||||||
|
$self->selection ($_); |
||||||
|
s/[\x00-\x1f\x80-\x9f]/·/g; |
||||||
|
$self->msg ($self->special_encode ("auto-transformed to $_")); |
||||||
|
last; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
@ -0,0 +1,136 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
#:META:RESOURCE:%.cmd:string:the command to run create a new pastebin |
||||||
|
#:META:RESOURCE:%.url:string:the url template for new pastebins |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
selection-pastebin - automatic pastebin upload |
||||||
|
|
||||||
|
=head1 EXAMPLES |
||||||
|
|
||||||
|
URxvt.keysym.C-M-e: selection-pastebin:remote-pastebin |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
This is a little rarely useful extension that uploads the selection as |
||||||
|
textfile to a remote site (or does other things). (The implementation is |
||||||
|
not currently secure for use in a multiuser environment as it writes to |
||||||
|
F</tmp> directly.). |
||||||
|
|
||||||
|
It listens to the C<selection-pastebin:remote-pastebin> action, which, |
||||||
|
when activated, runs a command with C<%> replaced by the name of the |
||||||
|
textfile. This command can be set via a resource: |
||||||
|
|
||||||
|
URxvt.selection-pastebin.cmd: rsync -apP % ruth:/var/www/www.ta-sa.org/files/txt/. |
||||||
|
|
||||||
|
And the default is likely not useful to anybody but the few people around |
||||||
|
here :) |
||||||
|
|
||||||
|
The name of the textfile is the hex encoded md5 sum of the selection, so |
||||||
|
the same content should lead to the same filename. |
||||||
|
|
||||||
|
After a successful upload the selection will be replaced by the text given |
||||||
|
in the C<selection-pastebin-url> resource (again, the % is the placeholder |
||||||
|
for the filename): |
||||||
|
|
||||||
|
URxvt.selection-pastebin.url: http://www.ta-sa.org/files/txt/% |
||||||
|
|
||||||
|
I<Note to xrdb users:> xrdb uses the C preprocessor, which might interpret |
||||||
|
the double C</> characters as comment start. Use C<\057\057> instead, |
||||||
|
which works regardless of whether xrdb is used to parse the resource file |
||||||
|
or not. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub upload_paste { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
require Digest::MD5; |
||||||
|
|
||||||
|
my $txt = $self->selection; |
||||||
|
|
||||||
|
my $filename = $txt; |
||||||
|
utf8::encode $filename; |
||||||
|
$filename = Digest::MD5::md5_hex ($filename) . ".txt"; |
||||||
|
|
||||||
|
my $tmpfile = "/tmp/$filename"; |
||||||
|
|
||||||
|
my $msg = "uploaded as $filename"; |
||||||
|
|
||||||
|
if (open my $o, ">:utf8", $tmpfile) { |
||||||
|
chmod 0644, $tmpfile; |
||||||
|
print $o $txt; |
||||||
|
close $o; |
||||||
|
} else { |
||||||
|
$msg = "couldn't write $tmpfile: $!"; |
||||||
|
} |
||||||
|
|
||||||
|
my $cmd = $self->{pastebin_cmd}; |
||||||
|
$cmd =~ s/%/$tmpfile/; |
||||||
|
|
||||||
|
my $pid = $self->exec_async ($cmd); |
||||||
|
|
||||||
|
$self->{pw} = urxvt::pw->new->start ($pid)->cb (sub { |
||||||
|
my (undef, $status) = @_; |
||||||
|
|
||||||
|
delete $self->{pw}; |
||||||
|
|
||||||
|
if ($status) { |
||||||
|
$status >>= 8; |
||||||
|
$msg = "ERROR: command returned status $status"; |
||||||
|
} else { |
||||||
|
my $url = $self->{pastebin_url}; |
||||||
|
$url =~ s/%/$filename/; |
||||||
|
|
||||||
|
$self->selection ($url); |
||||||
|
} |
||||||
|
|
||||||
|
unlink $tmpfile; |
||||||
|
|
||||||
|
my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0); |
||||||
|
$ov->set (0, 0, $msg); |
||||||
|
|
||||||
|
$self->{timer} = |
||||||
|
urxvt::timer |
||||||
|
->new |
||||||
|
->after (5) |
||||||
|
->cb (sub { delete $self->{timer}; undef $ov; }); |
||||||
|
}); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{pastebin_cmd} = $self->x_resource ("%.cmd") |
||||||
|
|| "rcp -p % ruth:/var/www/www.ta-sa.org/files/txt/"; |
||||||
|
|
||||||
|
$self->{pastebin_url} = $self->x_resource ("%.url") |
||||||
|
|| "http://www.ta-sa.org/files/txt/%"; |
||||||
|
|
||||||
|
push @{ $self->{term}{selection_popup_hook} }, sub { |
||||||
|
("pastebin upload" => sub { $self->upload_paste }) |
||||||
|
}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_user_command { |
||||||
|
my ($self, $cmd) = @_; |
||||||
|
|
||||||
|
if ($cmd eq "selection-pastebin:remote-pastebin") { |
||||||
|
$self->upload_paste; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_action { |
||||||
|
my ($self, $action) = @_; |
||||||
|
|
||||||
|
$action eq "remote-pastebin" |
||||||
|
and $self->upload_paste; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
@ -0,0 +1,147 @@ |
|||||||
|
#! 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; |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
@ -0,0 +1,27 @@ |
|||||||
|
#! perl -w |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
selection-to-clipboard - copy the selection to the clipboard each time a selection is made |
||||||
|
|
||||||
|
=head1 SYNOPSIS |
||||||
|
|
||||||
|
urxvt -pe selection-to-clipboard |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
This very simple extension copies the selection to the clipboard every |
||||||
|
time a selection is made. This, in effect, synchronises the clipboard with |
||||||
|
the selection for selections done by rxvt-unicode. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub on_sel_grab { |
||||||
|
my ($self, $time) = @_; |
||||||
|
|
||||||
|
$self->selection ($self->selection, 1); |
||||||
|
$self->selection_grab ($time, 1); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
@ -0,0 +1,423 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
#:META:RESOURCE:tabbar-fg:colour:tab bar foreground colour |
||||||
|
#:META:RESOURCE:tabbar-bg:colour:tab bar background colour |
||||||
|
#:META:RESOURCE:tab-fg:colour:tab foreground colour |
||||||
|
#:META:RESOURCE:tab-bg:colour:tab background colour |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
tabbed - tabbed interface to urxvt |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
This transforms the terminal into a tabbar with additional terminals, that |
||||||
|
is, it implements what is commonly referred to as "tabbed terminal". The topmost line |
||||||
|
displays a "[NEW]" button, which, when clicked, will add a new tab, followed by one |
||||||
|
button per tab. |
||||||
|
|
||||||
|
Clicking a button will activate that tab. Pressing B<Shift-Left> and |
||||||
|
B<Shift-Right> will switch to the tab left or right of the current one, |
||||||
|
while B<Shift-Down> creates a new tab. Pressing B<Ctrl-Left> and |
||||||
|
B<Ctrl-Right> will renumber the current tab by moving it to the left or |
||||||
|
to the right. |
||||||
|
|
||||||
|
The tabbar itself can be configured similarly to a normal terminal, but |
||||||
|
with a resource class of C<URxvt.tabbed>. In addition, it supports the |
||||||
|
following four resources (shown with defaults): |
||||||
|
|
||||||
|
URxvt.tabbed.tabbar-fg: <colour-index, default 3> |
||||||
|
URxvt.tabbed.tabbar-bg: <colour-index, default 0> |
||||||
|
URxvt.tabbed.tab-fg: <colour-index, default 0> |
||||||
|
URxvt.tabbed.tab-bg: <colour-index, default 1> |
||||||
|
|
||||||
|
See I<COLOR AND GRAPHICS> in the @@RXVT_NAME@@(1) manpage for valid |
||||||
|
indices. |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
sub refresh { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $ncol = $self->ncol; |
||||||
|
|
||||||
|
my $text = " " x $ncol; |
||||||
|
my $rend = [($self->{rs_tabbar}) x $ncol]; |
||||||
|
|
||||||
|
my @ofs; |
||||||
|
|
||||||
|
substr $text, 0, 7, "[NEW] |"; |
||||||
|
@$rend[0 .. 5] = ($self->{rs_tab}) x 6; |
||||||
|
push @ofs, [0, 6, sub { $_[0]->new_tab }]; |
||||||
|
|
||||||
|
my $ofs = 7; |
||||||
|
my $idx = 0; |
||||||
|
|
||||||
|
for my $tab (@{ $self->{tabs} }) { |
||||||
|
$idx++; |
||||||
|
|
||||||
|
my $act = $tab->{activity} && $tab != $self->{cur} |
||||||
|
? "*" : " "; |
||||||
|
|
||||||
|
my $txt = "$act$idx$act"; |
||||||
|
my $len = length $txt; |
||||||
|
|
||||||
|
substr $text, $ofs, $len + 1, "$txt|"; |
||||||
|
@$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len |
||||||
|
if $tab == $self->{cur}; |
||||||
|
|
||||||
|
push @ofs, [ $ofs, $ofs + $len, sub { $_[0]->make_current ($tab) } ]; |
||||||
|
|
||||||
|
$ofs += $len + 1; |
||||||
|
} |
||||||
|
|
||||||
|
$self->{tabofs} = \@ofs; |
||||||
|
|
||||||
|
$self->ROW_t (0, $text, 0, 0, $ncol); |
||||||
|
$self->ROW_r (0, $rend, 0, 0, $ncol); |
||||||
|
|
||||||
|
$self->want_refresh; |
||||||
|
} |
||||||
|
|
||||||
|
sub new_tab { |
||||||
|
my ($self, @argv) = @_; |
||||||
|
|
||||||
|
# save a backlink to us, make sure tabbed is inactive |
||||||
|
push @urxvt::TERM_INIT, sub { |
||||||
|
my ($term) = @_; |
||||||
|
$term->{parent} = $self; |
||||||
|
|
||||||
|
for (0 .. urxvt::NUM_RESOURCES - 1) { |
||||||
|
my $value = $self->{resource}[$_]; |
||||||
|
|
||||||
|
$term->resource ("+$_" => $value) |
||||||
|
if defined $value; |
||||||
|
} |
||||||
|
|
||||||
|
$term->resource (perl_ext_2 => $term->resource ("perl_ext_2") . ",-tabbed"); |
||||||
|
}; |
||||||
|
|
||||||
|
push @urxvt::TERM_EXT, urxvt::ext::tabbed::tab::; |
||||||
|
|
||||||
|
my $term = new urxvt::term |
||||||
|
$self->env, $urxvt::RXVTNAME, |
||||||
|
-embed => $self->parent, |
||||||
|
@argv, |
||||||
|
; |
||||||
|
} |
||||||
|
|
||||||
|
sub configure { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $tab = $self->{cur}; |
||||||
|
|
||||||
|
# this is an extremely dirty way to force a configurenotify, but who cares |
||||||
|
$tab->XMoveResizeWindow ( |
||||||
|
$tab->parent, |
||||||
|
0, $self->{tabheight} + 1, |
||||||
|
$self->width, $self->height - $self->{tabheight} |
||||||
|
); |
||||||
|
$tab->XMoveResizeWindow ( |
||||||
|
$tab->parent, |
||||||
|
0, $self->{tabheight}, |
||||||
|
$self->width, $self->height - $self->{tabheight} |
||||||
|
); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_resize_all_windows { |
||||||
|
my ($self, $width, $height) = @_; |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub copy_properties { |
||||||
|
my ($self) = @_; |
||||||
|
my $tab = $self->{cur}; |
||||||
|
|
||||||
|
my $wm_normal_hints = $self->XInternAtom ("WM_NORMAL_HINTS"); |
||||||
|
|
||||||
|
my $current = delete $self->{current_properties}; |
||||||
|
|
||||||
|
# pass 1: copy over properties different or nonexisting |
||||||
|
for my $atom ($tab->XListProperties ($tab->parent)) { |
||||||
|
my ($type, $format, $items) = $self->XGetWindowProperty ($tab->parent, $atom); |
||||||
|
|
||||||
|
# fix up size hints |
||||||
|
if ($atom == $wm_normal_hints) { |
||||||
|
my (@hints) = unpack "l!*", $items; |
||||||
|
|
||||||
|
$hints[$_] += $self->{tabheight} for (4, 6, 16); |
||||||
|
|
||||||
|
$items = pack "l!*", @hints; |
||||||
|
} |
||||||
|
|
||||||
|
my $cur = delete $current->{$atom}; |
||||||
|
|
||||||
|
# update if changed, we assume empty items and zero type and format will not happen |
||||||
|
$self->XChangeProperty ($self->parent, $atom, $type, $format, $items) |
||||||
|
if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items; |
||||||
|
|
||||||
|
$self->{current_properties}{$atom} = [$type, $format, $items]; |
||||||
|
} |
||||||
|
|
||||||
|
# pass 2, delete all extraneous properties |
||||||
|
$self->XDeleteProperty ($self->parent, $_) for keys %$current; |
||||||
|
} |
||||||
|
|
||||||
|
sub make_current { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
if (my $cur = $self->{cur}) { |
||||||
|
delete $cur->{activity}; |
||||||
|
$cur->XUnmapWindow ($cur->parent) if $cur->mapped; |
||||||
|
$cur->focus_out; |
||||||
|
} |
||||||
|
|
||||||
|
$self->{cur} = $tab; |
||||||
|
|
||||||
|
$self->configure; |
||||||
|
$self->copy_properties; |
||||||
|
|
||||||
|
$tab->focus_out; # just in case, should be a nop |
||||||
|
$tab->focus_in if $self->focus; |
||||||
|
|
||||||
|
$tab->XMapWindow ($tab->parent); |
||||||
|
delete $tab->{activity}; |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_focus_in { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->{cur}->focus_in; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_focus_out { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->{cur}->focus_out; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_tt_write { |
||||||
|
my ($self, $octets) = @_; |
||||||
|
|
||||||
|
$self->{cur}->tt_write ($octets); |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_key_press { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->{cur}->key_press ($event->{state}, $event->{keycode}, $event->{time}); |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_key_release { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->{cur}->key_release ($event->{state}, $event->{keycode}, $event->{time}); |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_press { |
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_release { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
if ($event->{row} == 0) { |
||||||
|
for my $button (@{ $self->{tabofs} }) { |
||||||
|
$button->[2]->($self, $event) |
||||||
|
if $event->{col} >= $button->[0] |
||||||
|
&& $event->{col} < $button->[1]; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_motion_notify { |
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{resource} = [map $self->resource ("+$_"), 0 .. urxvt::NUM_RESOURCES - 1]; |
||||||
|
|
||||||
|
$self->resource (int_bwidth => 0); |
||||||
|
$self->resource (name => "URxvt.tabbed"); |
||||||
|
$self->resource (pty_fd => -1); |
||||||
|
|
||||||
|
$self->option ($urxvt::OPTION{scrollBar}, 0); |
||||||
|
|
||||||
|
my $fg = $self->x_resource ("tabbar-fg"); |
||||||
|
my $bg = $self->x_resource ("tabbar-bg"); |
||||||
|
my $tabfg = $self->x_resource ("tab-fg"); |
||||||
|
my $tabbg = $self->x_resource ("tab-bg"); |
||||||
|
|
||||||
|
defined $fg or $fg = 3; |
||||||
|
defined $bg or $bg = 0; |
||||||
|
defined $tabfg or $tabfg = 0; |
||||||
|
defined $tabbg or $tabbg = 1; |
||||||
|
|
||||||
|
$self->{rs_tabbar} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2); |
||||||
|
$self->{rs_tab} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 2); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{tabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace; |
||||||
|
|
||||||
|
$self->cmd_parse ("\033[?25l"); |
||||||
|
|
||||||
|
my @argv = $self->argv; |
||||||
|
|
||||||
|
do { |
||||||
|
shift @argv; |
||||||
|
} while @argv && $argv[0] ne "-e"; |
||||||
|
|
||||||
|
$self->new_tab (@argv); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_configure_notify { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->configure; |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_wm_delete_window { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$_->destroy for @{ $self->{tabs} }; |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_start { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
$tab->XChangeInput ($tab->parent, urxvt::PropertyChangeMask); |
||||||
|
|
||||||
|
push @{ $self->{tabs} }, $tab; |
||||||
|
|
||||||
|
# $tab->{name} ||= scalar @{ $self->{tabs} }; |
||||||
|
$self->make_current ($tab); |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_destroy { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
$self->{tabs} = [ grep $_ != $tab, @{ $self->{tabs} } ]; |
||||||
|
|
||||||
|
if (@{ $self->{tabs} }) { |
||||||
|
if ($self->{cur} == $tab) { |
||||||
|
delete $self->{cur}; |
||||||
|
$self->make_current ($self->{tabs}[-1]); |
||||||
|
} else { |
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
} else { |
||||||
|
# delay destruction a tiny bit |
||||||
|
$self->{destroy} = urxvt::iw->new->start->cb (sub { $self->destroy }); |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_key_press { |
||||||
|
my ($self, $tab, $event, $keysym, $str) = @_; |
||||||
|
|
||||||
|
if ($event->{state} & urxvt::ShiftMask) { |
||||||
|
if ($keysym == 0xff51 || $keysym == 0xff53) { |
||||||
|
my ($idx) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; |
||||||
|
|
||||||
|
--$idx if $keysym == 0xff51; |
||||||
|
++$idx if $keysym == 0xff53; |
||||||
|
|
||||||
|
$self->make_current ($self->{tabs}[$idx % @{ $self->{tabs}}]); |
||||||
|
|
||||||
|
return 1; |
||||||
|
} elsif ($keysym == 0xff54) { |
||||||
|
$self->new_tab; |
||||||
|
|
||||||
|
return 1; |
||||||
|
} |
||||||
|
} |
||||||
|
elsif ($event->{state} & urxvt::ControlMask) { |
||||||
|
if ($keysym == 0xff51 || $keysym == 0xff53) { |
||||||
|
my ($idx1) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; |
||||||
|
my $idx2 = ($idx1 + ($keysym == 0xff51 ? -1 : +1)) % @{ $self->{tabs} }; |
||||||
|
|
||||||
|
($self->{tabs}[$idx1], $self->{tabs}[$idx2]) = |
||||||
|
($self->{tabs}[$idx2], $self->{tabs}[$idx1]); |
||||||
|
|
||||||
|
$self->make_current ($self->{tabs}[$idx2]); |
||||||
|
|
||||||
|
return 1; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_property_notify { |
||||||
|
my ($self, $tab, $event) = @_; |
||||||
|
|
||||||
|
$self->copy_properties |
||||||
|
if $event->{window} == $tab->parent; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_activity { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
|
||||||
|
package urxvt::ext::tabbed::tab; |
||||||
|
|
||||||
|
# helper extension implementing the subwindows of a tabbed terminal. |
||||||
|
# simply proxies all interesting calls back to the tabbed class. |
||||||
|
|
||||||
|
{ |
||||||
|
for my $hook (qw(start destroy key_press property_notify)) { |
||||||
|
eval qq{ |
||||||
|
sub on_$hook { |
||||||
|
my \$parent = \$_[0]{term}{parent} |
||||||
|
or return; |
||||||
|
\$parent->tab_$hook (\@_) |
||||||
|
} |
||||||
|
}; |
||||||
|
die if $@; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub on_add_lines { |
||||||
|
$_[0]->{activity}++ |
||||||
|
or $_[0]{term}{parent}->tab_activity ($_[0]); |
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,459 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
sub refresh { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $ncol = $self->ncol; |
||||||
|
|
||||||
|
my $text = ' ' x $ncol; |
||||||
|
my $rend = [($self->{rs_tabbar}) x $ncol]; |
||||||
|
|
||||||
|
my @ofs; |
||||||
|
my $ofs = 0; |
||||||
|
my $idx = 0; |
||||||
|
|
||||||
|
for my $tab (@{ $self->{tabs} }) { |
||||||
|
my $is_rename = defined $self->{tab_rename_started} && $self->{tab_rename_started} && $tab == $self->{cur}; |
||||||
|
|
||||||
|
my $txt = ' '.($tab->{manual_name} || $tab->{name}).' '; |
||||||
|
if ($is_rename) { |
||||||
|
$txt = ' '.$tab->{tab_new_name}.' '; |
||||||
|
$txt .= ' ' if $tab->{tab_new_pos} == length($tab->{tab_new_name}); |
||||||
|
} |
||||||
|
my $len = length($txt); |
||||||
|
|
||||||
|
unless ($idx++) { |
||||||
|
# first tab |
||||||
|
substr $text, $ofs, $len, $txt; |
||||||
|
if ($is_rename) { |
||||||
|
@$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len; |
||||||
|
@$rend[$ofs + $tab->{tab_new_pos} + 2] = $self->{rs_rename}; |
||||||
|
} elsif ($tab == $self->{cur}) { |
||||||
|
@$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len; |
||||||
|
} elsif ($tab->{activity} && $tab != $self->{cur}) { |
||||||
|
@$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tabsel}) x $len; |
||||||
|
} |
||||||
|
push @ofs, [ $ofs, $ofs + $len, sub { $_[0]->make_current($tab) } ]; |
||||||
|
$ofs += $len; |
||||||
|
} else { |
||||||
|
# other tabs |
||||||
|
substr $text, $ofs, $len + 1, '|'.$txt; |
||||||
|
@$rend[$ofs] = $self->{rs_tabdiv}; |
||||||
|
if ($tab == $self->{cur}) { |
||||||
|
@$rend[$ofs + 1 .. $ofs + $len] = ($self->{rs_tab}) x $len; |
||||||
|
} elsif ($tab->{activity} && $tab != $self->{cur}) { |
||||||
|
@$rend[$ofs + 1 .. $ofs + $len] = ($self->{rs_tabsel}) x $len; |
||||||
|
} |
||||||
|
push @ofs, [ $ofs + 1, $ofs + $len + 1, sub { $_[0]->make_current($tab) } ]; |
||||||
|
$ofs += $len + 1; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
$self->{tabofs} = \@ofs; |
||||||
|
$self->ROW_t(0, $text, 0, 0, $ncol); |
||||||
|
$self->ROW_r(0, $rend, 0, 0, $ncol); |
||||||
|
$self->want_refresh; |
||||||
|
} |
||||||
|
|
||||||
|
sub new_tab { |
||||||
|
my ($self, @argv) = @_; |
||||||
|
|
||||||
|
my $offset = $self->fheight; |
||||||
|
|
||||||
|
# save a backlink to us, make sure tabbed is inactive |
||||||
|
push @urxvt::TERM_INIT, sub { |
||||||
|
my ($term) = @_; |
||||||
|
$term->{parent} = $self; |
||||||
|
for (0 .. urxvt::NUM_RESOURCES - 1) { |
||||||
|
my $value = $self->{resource}[$_]; |
||||||
|
$term->resource("+$_" => $value) if defined $value; |
||||||
|
} |
||||||
|
$term->resource(perl_ext_2 => $term->resource("perl_ext_2") . ",-tabbed_new"); |
||||||
|
}; |
||||||
|
|
||||||
|
push @urxvt::TERM_EXT, urxvt::ext::tabbed_new::tab::; |
||||||
|
|
||||||
|
my $term = new urxvt::term $self->env, $urxvt::RXVTNAME, -embed => $self->parent, @argv,; |
||||||
|
} |
||||||
|
|
||||||
|
sub configure { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $tab = $self->{cur}; |
||||||
|
|
||||||
|
# this is an extremely dirty way to force a configurenotify, but who cares |
||||||
|
$tab->XMoveResizeWindow($tab->parent, 0, $self->{tabheight} + 1, $self->width, $self->height - $self->{tabheight}); |
||||||
|
$tab->XMoveResizeWindow($tab->parent, 0, $self->{tabheight}, $self->width, $self->height - $self->{tabheight}); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_resize_all_windows { |
||||||
|
my ($self, $width, $height) = @_; |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub copy_properties { |
||||||
|
my ($self) = @_; |
||||||
|
my $tab = $self->{cur}; |
||||||
|
|
||||||
|
my $wm_normal_hints = $self->XInternAtom("WM_NORMAL_HINTS"); |
||||||
|
|
||||||
|
my $current = delete $self->{current_properties}; |
||||||
|
|
||||||
|
# pass 1: copy over properties different or nonexisting |
||||||
|
for my $atom ($tab->XListProperties($tab->parent)) { |
||||||
|
my ($type, $format, $items) = $self->XGetWindowProperty($tab->parent, $atom); |
||||||
|
|
||||||
|
# fix up size hints |
||||||
|
if ($atom == $wm_normal_hints) { |
||||||
|
my (@hints) = unpack "l!*", $items; |
||||||
|
|
||||||
|
$hints[$_] += $self->{tabheight} for (4, 6, 16); |
||||||
|
|
||||||
|
$items = pack "l!*", @hints; |
||||||
|
} |
||||||
|
|
||||||
|
my $cur = delete $current->{$atom}; |
||||||
|
|
||||||
|
# update if changed, we assume empty items and zero type and format will not happen |
||||||
|
$self->XChangeProperty($self->parent, $atom, $type, $format, $items) |
||||||
|
if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items; |
||||||
|
|
||||||
|
$self->{current_properties}{$atom} = [$type, $format, $items]; |
||||||
|
} |
||||||
|
|
||||||
|
# pass 2, delete all extraneous properties |
||||||
|
$self->XDeleteProperty($self->parent, $_) for keys %$current; |
||||||
|
} |
||||||
|
|
||||||
|
sub make_current { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
if (my $cur = $self->{cur}) { |
||||||
|
delete $cur->{activity}; |
||||||
|
$cur->XUnmapWindow($cur->parent) if $cur->mapped; |
||||||
|
$cur->focus_out; |
||||||
|
} |
||||||
|
|
||||||
|
$self->{cur} = $tab; |
||||||
|
$self->configure; |
||||||
|
$self->copy_properties; |
||||||
|
$tab->focus_out; # just in case, should be a nop |
||||||
|
$tab->focus_in if $self->focus; |
||||||
|
$tab->XMapWindow($tab->parent); |
||||||
|
delete $tab->{activity}; |
||||||
|
$self->refresh; |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_focus_in { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->{cur}->focus_in; |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_focus_out { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->{cur}->focus_out; |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_key_press { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->{cur}->key_press($event->{state}, $event->{keycode}, $event->{time}); |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub on_key_release { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->{cur}->key_release($event->{state}, $event->{keycode}, $event->{time}); |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_press { |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_release { |
||||||
|
my ($self, $event) = @_; |
||||||
|
if ($event->{row} == 0) { |
||||||
|
for my $button (@{ $self->{tabofs} }) { |
||||||
|
$button->[2]->($self, $event) if $event->{col} >= $button->[0] && $event->{col} < $button->[1]; |
||||||
|
} |
||||||
|
} |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub on_motion_notify { |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{resource} = [map $self->resource("+$_"), 0 .. urxvt::NUM_RESOURCES - 1]; |
||||||
|
|
||||||
|
$self->resource(int_bwidth => 0); |
||||||
|
$self->resource(name => "URxvt.tabbed_new"); |
||||||
|
$self->resource(pty_fd => -1); |
||||||
|
|
||||||
|
$self->option($urxvt::OPTION{scrollBar}, 0); |
||||||
|
|
||||||
|
my $renamebg = $self->x_resource("tabren-bg"); |
||||||
|
my $divfg = $self->x_resource("tabdiv-fg"); |
||||||
|
my $fg = $self->x_resource("tabbar-fg"); |
||||||
|
my $bg = $self->x_resource("tabbar-bg"); |
||||||
|
my $selfg = $self->x_resource("tabsel-fg"); |
||||||
|
my $selbg = $self->x_resource("tabsel-bg"); |
||||||
|
my $tabfg = $self->x_resource("tab-fg"); |
||||||
|
my $tabbg = $self->x_resource("tab-bg"); |
||||||
|
|
||||||
|
defined $renamebg or $renamebg = 11; |
||||||
|
defined $divfg or $divfg = 8; |
||||||
|
defined $fg or $fg = 0; |
||||||
|
defined $bg or $bg = 15; |
||||||
|
defined $tabfg or $tabfg = 1; |
||||||
|
defined $tabbg or $tabbg = 15; |
||||||
|
defined $selfg or $selfg = 0; |
||||||
|
defined $selbg or $selbg = 7; |
||||||
|
|
||||||
|
$self->{rs_tabbar} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2); |
||||||
|
$self->{rs_tabdiv} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $divfg + 2, $bg + 2); |
||||||
|
$self->{rs_tabsel} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $selfg + 2, $selbg + 2); |
||||||
|
$self->{rs_tab} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 2); |
||||||
|
|
||||||
|
$self->{rs_rename} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $selfg + 2, $renamebg + 2); |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{tabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace; |
||||||
|
$self->cmd_parse("\033[?25l"); |
||||||
|
my @argv = $self->argv; |
||||||
|
|
||||||
|
do { shift @argv; } while @argv && $argv[0] ne "-e"; |
||||||
|
$self->new_tab(@argv); |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_configure_notify { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->configure; |
||||||
|
$self->refresh; |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_wm_delete_window { |
||||||
|
my ($self) = @_; |
||||||
|
$_->destroy for @{ $self->{tabs} }; |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_name { |
||||||
|
my ($self, $name) = @_; |
||||||
|
|
||||||
|
return unless $name =~ /\@/; |
||||||
|
my $tab = $self->{cur}; |
||||||
|
$tab->{name} = $name; |
||||||
|
$self->refresh; |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_start { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
$tab->XChangeInput($tab->parent, urxvt::PropertyChangeMask); |
||||||
|
push @{ $self->{tabs} }, $tab; |
||||||
|
$tab->{name} ||= 'tab '.scalar @{ $self->{tabs} }; |
||||||
|
$tab->{manual_name} = undef; |
||||||
|
$self->make_current($tab); |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_destroy { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
$self->{tabs} = [ grep $_ != $tab, @{ $self->{tabs} } ]; |
||||||
|
if (@{ $self->{tabs} }) { |
||||||
|
if ($self->{cur} == $tab) { |
||||||
|
delete $self->{cur}; |
||||||
|
$self->make_current($self->{tabs}[-1]); |
||||||
|
} else { |
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
} else { |
||||||
|
# delay destruction a tiny bit |
||||||
|
$self->{destroy} = urxvt::iw->new->start->cb(sub { $self->destroy }); |
||||||
|
} |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_key_press { |
||||||
|
my ($self, $tab, $event, $keysum, $str) = @_; |
||||||
|
my $action; |
||||||
|
|
||||||
|
if ($event->{state} & urxvt::Mod4Mask) { |
||||||
|
if ($event->{state} & urxvt::ControlMask) { |
||||||
|
$action = 'move-left' if $keysum == 0xff51; # Mod4+Ctrl+Left |
||||||
|
$action = 'move-right' if $keysum == 0xff53; # Mod4+Ctrl+Right |
||||||
|
} else { |
||||||
|
$action = 'prev-tab' if $keysum == 0xff51; # Mod4+Left |
||||||
|
$action = 'next-tab' if $keysum == 0xff53; # Mod4+Right |
||||||
|
$action = 'new-tab' if $keysum == 0x74; # Mod4+T |
||||||
|
$action = 'rename-start' if $keysum == 0x6e; # Mod4+N |
||||||
|
} |
||||||
|
} elsif ($event->{state} & urxvt::ControlMask) { |
||||||
|
$action = 'next-tab' if $keysum == 0xff09; # Ctrl+Tab |
||||||
|
} elsif (defined $self->{tab_rename_started} && $self->{tab_rename_started}) { |
||||||
|
if ($keysum == 0xff1b) { # Esc |
||||||
|
$action = 'cancel-rename'; |
||||||
|
} elsif ($keysum == 0xff0d || $keysum == 0xff8d) { # Enter |
||||||
|
$action = 'confirm-rename'; |
||||||
|
} elsif ($keysum == 0xff51) { # Left |
||||||
|
if ($tab->{tab_new_pos} > 0) { |
||||||
|
$tab->{tab_new_pos}--; |
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
return 1; |
||||||
|
} elsif ($keysum == 0xff53) { # Right |
||||||
|
if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) { |
||||||
|
$tab->{tab_new_pos}++; |
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
return 1; |
||||||
|
} elsif ($keysum == 0xff50) { # Home |
||||||
|
if ($tab->{tab_new_pos} > 0) { |
||||||
|
$tab->{tab_new_pos} = 0; |
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
return 1; |
||||||
|
} elsif ($keysum == 0xff57) { # End |
||||||
|
if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) { |
||||||
|
$tab->{tab_new_pos} = length($tab->{tab_new_name}); |
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
return 1; |
||||||
|
} elsif ($keysum == 0xff08) { # Backspace |
||||||
|
if ($tab->{tab_new_pos} > 0) { |
||||||
|
my $name = ''; |
||||||
|
$name .= substr($tab->{tab_new_name}, 0, $tab->{tab_new_pos} - 1) if $tab->{tab_new_pos} > 1; |
||||||
|
$name .= substr($tab->{tab_new_name}, $tab->{tab_new_pos}, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name}); |
||||||
|
$tab->{tab_new_name} = $name; |
||||||
|
$tab->{tab_new_pos}--; |
||||||
|
} |
||||||
|
$self->refresh; |
||||||
|
return 1; |
||||||
|
} elsif ($keysum == 0xffff) { # Delete |
||||||
|
if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) { |
||||||
|
my $name = ''; |
||||||
|
$name .= substr($tab->{tab_new_name}, 0, $tab->{tab_new_pos}) if $tab->{tab_new_pos} > 0; |
||||||
|
$name .= substr($tab->{tab_new_name}, $tab->{tab_new_pos} + 1, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name}) - 1; |
||||||
|
$tab->{tab_new_name} = $name; |
||||||
|
} |
||||||
|
$self->refresh; |
||||||
|
return 1; |
||||||
|
} else { |
||||||
|
if ($str =~ /^[\x20-\x7f]$/) { # printable symbols |
||||||
|
my $name = ''; |
||||||
|
$name .= substr($tab->{tab_new_name}, 0, $tab->{tab_new_pos}) if $tab->{tab_new_pos} > 0; |
||||||
|
$name .= $str; |
||||||
|
$name .= substr($tab->{tab_new_name}, $tab->{tab_new_pos}, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name}); |
||||||
|
$tab->{tab_new_name} = $name; |
||||||
|
$tab->{tab_new_pos}++; |
||||||
|
} |
||||||
|
$self->refresh; |
||||||
|
return 1; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
if (defined $action) { |
||||||
|
if ($action eq 'next-tab' || $action eq 'prev-tab') { |
||||||
|
my ($idx) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; |
||||||
|
--$idx if $action eq 'prev-tab'; |
||||||
|
++$idx if $action eq 'next-tab'; |
||||||
|
$self->make_current($self->{tabs}[$idx % @{ $self->{tabs}}]); |
||||||
|
return 1; |
||||||
|
} elsif ($action eq 'move-left' || $action eq 'move-right') { |
||||||
|
my ($idx1) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; |
||||||
|
if (($action eq 'move-left' && $idx1 > 0) || ($action eq 'move-right' && $idx1 < $#{ $self->{tabs} })) { |
||||||
|
my $idx2 = ($idx1 + ($action eq 'move-left' ? -1 : +1)) % @{ $self->{tabs} }; |
||||||
|
($self->{tabs}[$idx1], $self->{tabs}[$idx2]) = ($self->{tabs}[$idx2], $self->{tabs}[$idx1]); |
||||||
|
$self->make_current($self->{tabs}[$idx2]); |
||||||
|
} |
||||||
|
return 1; |
||||||
|
} elsif ($action eq 'new-tab') { |
||||||
|
$self->new_tab; |
||||||
|
return 1; |
||||||
|
} elsif ($action eq 'rename-start') { |
||||||
|
$self->{tab_rename_started} = 1; |
||||||
|
$tab->{tab_new_name} = $tab->{manual_name} || ''; |
||||||
|
$tab->{tab_new_pos} = length($tab->{tab_new_name}); |
||||||
|
$self->refresh; |
||||||
|
return 1; |
||||||
|
} elsif ($action eq 'cancel-rename') { |
||||||
|
undef $self->{tab_rename_started}; |
||||||
|
undef $tab->{tab_new_name}; |
||||||
|
undef $tab->{tab_new_pos}; |
||||||
|
$self->refresh; |
||||||
|
return 1; |
||||||
|
} elsif ($action eq 'confirm-rename') { |
||||||
|
$tab->{manual_name} = $tab->{tab_new_name} || undef; |
||||||
|
undef $self->{tab_rename_started}; |
||||||
|
undef $tab->{tab_new_name}; |
||||||
|
undef $tab->{tab_new_pos}; |
||||||
|
$self->refresh; |
||||||
|
return 1; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_property_notify { |
||||||
|
my ($self, $tab, $event) = @_; |
||||||
|
$self->copy_properties if $event->{window} == $tab->parent; |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub tab_activity { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
|
||||||
|
package urxvt::ext::tabbed_new::tab; |
||||||
|
|
||||||
|
# helper extension implementing the subwindows of a tabbed terminal. |
||||||
|
# simply proxies all interesting calls back to the tabbed class. |
||||||
|
|
||||||
|
{ |
||||||
|
for my $hook (qw(start destroy key_press property_notify)) { |
||||||
|
eval qq{ |
||||||
|
sub on_$hook \{ |
||||||
|
my \$parent = \$_[0]\{term\}\{parent\} or return; |
||||||
|
\$parent->tab_$hook(\@_); |
||||||
|
\} |
||||||
|
}; |
||||||
|
die if $@; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub on_add_lines { |
||||||
|
$_[0]->{activity}++ or $_[0]{term}{parent}->tab_activity($_[0]); |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_osc_seq { |
||||||
|
my ($self, $seq, $cmd, $resp) = @_; |
||||||
|
return unless $seq == 0; |
||||||
|
|
||||||
|
my $parent = $self->{term}->{parent}; |
||||||
|
return unless $parent; |
||||||
|
|
||||||
|
my ($name, undef) = split /:\s/, $cmd, 2; |
||||||
|
return unless $name; |
||||||
|
|
||||||
|
$parent->tab_name($name); |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
@ -0,0 +1,139 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
# this extension implements popup-menu functionality for urxvt. it works |
||||||
|
# together with the urxvt::popup class - "no user serviceable parts inside". |
||||||
|
|
||||||
|
sub refresh { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $cmd = "\x1b[H"; |
||||||
|
|
||||||
|
my $row = 1; |
||||||
|
for my $item (@{ $self->{data}{item} }) { |
||||||
|
my $rend = "normal"; |
||||||
|
|
||||||
|
if ($row == $self->{hover}) { |
||||||
|
$rend = $self->{press} ? "active" : "hover"; |
||||||
|
} |
||||||
|
|
||||||
|
$cmd .= "$item->{rend}{$rend}\x1b[K"; |
||||||
|
$cmd .= $self->locale_encode ($item->{render}->($item)); |
||||||
|
$cmd .= "\015\012"; |
||||||
|
|
||||||
|
$row++; |
||||||
|
} |
||||||
|
|
||||||
|
$self->cmd_parse (substr $cmd, 0, -2); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_motion_notify { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
delete $self->{hover}; |
||||||
|
|
||||||
|
my ($row, $col) = ($event->{row}, $event->{col}); |
||||||
|
if ($col >= 0 && $col < $self->ncol |
||||||
|
&& $row >= 0 && $row < @{ $self->{data}{item} }) { |
||||||
|
$self->{hover} = $event->{row} + 1; |
||||||
|
} |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_press { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->{press}[$event->{button}] = 1; |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_release { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->{press}[$event->{button}] = 0; |
||||||
|
|
||||||
|
my ($row, $col) = ($event->{row}, $event->{col}); |
||||||
|
if ($col >= 0 && $col < $self->ncol |
||||||
|
&& $row >= 0 && $row < @{ $self->{data}{item} }) { |
||||||
|
my $item = $self->{data}{item}[$row]; |
||||||
|
$item->{activate}->($event, $item); |
||||||
|
} |
||||||
|
|
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
if ($event->{button} == $self->{data}{event}{button}) { |
||||||
|
$self->ungrab; |
||||||
|
$self->destroy; |
||||||
|
} |
||||||
|
|
||||||
|
1 |
||||||
|
} |
||||||
|
|
||||||
|
sub on_focus_out { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
delete $self->{hover}; |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $data = $self->{data} = $urxvt::popup::self; |
||||||
|
|
||||||
|
$_->{width} = $self->strwidth ($_->{text}) |
||||||
|
for @{ $data->{item} }; |
||||||
|
|
||||||
|
$self->resource (title => "URxvt Popup Menu"); |
||||||
|
$self->resource (name => "URxvt.popup"); |
||||||
|
|
||||||
|
$self->resource ($_ => $data->{term}->resource ($_)) |
||||||
|
for qw(font boldFont italicFont boldItalicFont color+0 color+1); |
||||||
|
|
||||||
|
my $width = List::Util::max map $_->{width}, @{ $data->{item} }; |
||||||
|
my $height = @{ $data->{item} }; |
||||||
|
|
||||||
|
my $pos = ""; |
||||||
|
|
||||||
|
if ($data->{event}) { |
||||||
|
my $x = int List::Util::max 0, $data->{event}{x_root} - $width * $data->{term}->fwidth * 0.5; |
||||||
|
my $y = int List::Util::max 0, $data->{event}{y_root} - $data->{term}->fheight * 0.5; |
||||||
|
$pos = "+$x+$y"; |
||||||
|
} |
||||||
|
|
||||||
|
$self->resource (geometry => "${width}x${height}$pos"); |
||||||
|
|
||||||
|
$self->{term}{urxvt_popup_init_done} = 1; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->cmd_parse ("\x1b[?25l\x1b[?7l"); |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
# might fail, but try anyways |
||||||
|
$self->grab ($self->{data}{event}{time}, 1) |
||||||
|
and $self->allow_events_async; |
||||||
|
|
||||||
|
on_button_press $self, $self->{data}{event} if $self->{data}{event}{button}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_map_notify { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
# should definitely not fail |
||||||
|
$self->grab ($self->{data}{event}{time}, 1) |
||||||
|
and $self->allow_events_async; |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,90 @@ |
|||||||
|
#! perl |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
xim-onthespot - implement XIM "on-the-spot" behaviour |
||||||
|
|
||||||
|
=head1 DESCRIPTION |
||||||
|
|
||||||
|
This perl extension implements OnTheSpot editing. It does not work |
||||||
|
perfectly, and some input methods don't seem to work well with OnTheSpot |
||||||
|
editing in general, but it seems to work at least for SCIM and kinput2. |
||||||
|
|
||||||
|
You enable it by specifying this extension and a preedit style of |
||||||
|
C<OnTheSpot>, i.e.: |
||||||
|
|
||||||
|
urxvt -pt OnTheSpot -pe xim-onthespot |
||||||
|
|
||||||
|
=cut |
||||||
|
|
||||||
|
# |
||||||
|
# problems with this implementation include |
||||||
|
# |
||||||
|
# - primary, secondary, tertiary are NO different to other highlighting styles |
||||||
|
# - if rend values are missing, they are not being interpolated |
||||||
|
# |
||||||
|
|
||||||
|
my $SIZEOF_LONG = length pack "l!", 0; |
||||||
|
|
||||||
|
sub refresh { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
delete $self->{overlay}; |
||||||
|
|
||||||
|
my $text = $self->{text}; |
||||||
|
|
||||||
|
return unless length $text; |
||||||
|
|
||||||
|
my ($row, $col) = $self->screen_cur; |
||||||
|
|
||||||
|
my $idx = 0; |
||||||
|
|
||||||
|
my @rend = map { |
||||||
|
my $rstyle = $self->{caret} == $idx ? urxvt::OVERLAY_RSTYLE : $self->rstyle; |
||||||
|
|
||||||
|
$rstyle |= urxvt::RS_Uline if $_ & (urxvt::XIMUnderline | urxvt::XIMPrimary); |
||||||
|
$rstyle |= urxvt::RS_RVid if $_ & (urxvt::XIMReverse | urxvt::XIMSecondary); |
||||||
|
$rstyle |= urxvt::RS_Italic if $_ & (urxvt::XIMHighlight | urxvt::XIMTertiary); |
||||||
|
|
||||||
|
($rstyle) x ($self->strwidth (substr $text, $idx++, 1)) |
||||||
|
} unpack "l!*", $self->{rend}; |
||||||
|
|
||||||
|
if ($self->{caret} >= length $text) { |
||||||
|
$text .= " "; |
||||||
|
push @rend, urxvt::OVERLAY_RSTYLE; |
||||||
|
} |
||||||
|
|
||||||
|
$self->{overlay} = $self->overlay ($col, $row, $self->strwidth ($text), 1, $self->rstyle, 0); |
||||||
|
$self->{overlay}->set (0, 0, $self->special_encode ($text), \@rend); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_xim_preedit_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_xim_preedit_done { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
delete $self->{overlay}; |
||||||
|
delete $self->{text}; |
||||||
|
delete $self->{rend}; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
sub on_xim_preedit_draw { |
||||||
|
my ($self, $caret, $pos, $len, $feedback, $chars) = @_; |
||||||
|
|
||||||
|
$self->{caret} = $caret; |
||||||
|
|
||||||
|
substr $self->{rend}, $pos * $SIZEOF_LONG, $len * $SIZEOF_LONG, $feedback; |
||||||
|
substr $self->{text}, $pos , $len , $chars if defined $feedback || !defined $chars; |
||||||
|
|
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
() |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,678 @@ |
|||||||
|
#! perl |
||||||
|
# This program is free software: you can redistribute it and/or modify |
||||||
|
# it under the terms of the GNU General Public License as published by |
||||||
|
# the Free Software Foundation, either version 3 of the License, or |
||||||
|
# (at your option) any later version. |
||||||
|
|
||||||
|
# This program is distributed in the hope that it will be useful, |
||||||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||||
|
# GNU General Public License for more details. |
||||||
|
|
||||||
|
# You should have received a copy of the GNU General Public License |
||||||
|
# along with this program. If not, see <http://www.gnu.org/licenses/>. |
||||||
|
# |
||||||
|
## |
||||||
|
## Tabbed plugin for rxvt-unicode |
||||||
|
## Modified by Michal Nazarewicz (mina86/AT/mina86.com), StephenB |
||||||
|
## (mail4stb/AT/gmail.com), Steven Merrill |
||||||
|
## <steven dot merrill at gmail.com>, Mark Pustjens |
||||||
|
## <pustjens@dds.nl> and more... |
||||||
|
## |
||||||
|
## The following has been added: |
||||||
|
## |
||||||
|
## 1. Depending on time of last activity, activity character differs. |
||||||
|
## By default, after 4 seconds an asterisk becomes a plus sing, |
||||||
|
## after next 4 it becomes a colon, and finally, after another 8 |
||||||
|
## seconds it becomes a dot. This can be configured via |
||||||
|
## tabbar-timeouts resource. It's format is: |
||||||
|
## |
||||||
|
## ( <timeout> ":" <character> ":" )* <timeout> ":" <character> ":" |
||||||
|
## |
||||||
|
## where <timeout> is timeout in seconds and <character> is |
||||||
|
## a single activity character. |
||||||
|
## |
||||||
|
## 2. The "[NEW]" button can be disabled (who on Earth uses mouse to |
||||||
|
## create new tab anyways?) by setting new-button resource to yes. |
||||||
|
## |
||||||
|
## 3. If title resource is true, tab's title is displayed after last |
||||||
|
## button. This is handy if you have terminal with no window |
||||||
|
## decorations. Colours can be configured via title-fg and |
||||||
|
## title-bg. |
||||||
|
## |
||||||
|
## 4. Incorporated Alexey Semenko <asemenko at gmail.com> patch adding |
||||||
|
## autohide resource. If it's true tab bar is hidden if there is |
||||||
|
## no more then one tab opened. |
||||||
|
## |
||||||
|
## 5. Tabs are indexed in starting with zero hex. :] If you're such |
||||||
|
## a geek to use urxvt it shouldn't be a problem for you and it |
||||||
|
## saves few character when many tabs are opened. |
||||||
|
## |
||||||
|
## 6. As a minor modification: Final pipe character is removed (unless |
||||||
|
## title is displayed). This make tab bar look nicer. |
||||||
|
## |
||||||
|
## Added by StephenB: |
||||||
|
## |
||||||
|
## 7. Tabs can be named with Shift+Up (Enter to confirm, Escape to |
||||||
|
## cancel). |
||||||
|
## |
||||||
|
## 8. "[NEW]" button disabled by default. |
||||||
|
## |
||||||
|
## Added by Steven Merrill <steven dot merrill at gmail.com> |
||||||
|
## |
||||||
|
## 9. Ability to start a new tab or cycle through tabs via user |
||||||
|
## commands: tabbedex:(new|next|prev)_tab . |
||||||
|
## e.g. (in .Xdefaults) URxvt.keysym.M-t: perl:tabbedex:new_tab |
||||||
|
## (see the urxvt man file for more info about keysym) |
||||||
|
## |
||||||
|
## 10. Fix an issue whereby on_user_command would not properly get sent |
||||||
|
## to other extension packages if the mouse was not over the urxvt |
||||||
|
## window. |
||||||
|
## |
||||||
|
## Added by Thomas Jost: |
||||||
|
## |
||||||
|
## 11. Add several user commands: tabbedex:rename_tab, |
||||||
|
## tabbedex:move_tab_(left|right). |
||||||
|
## e.g. (see 9.) URxvt.keysym.C-S-Left: perl:tabbex:move_tab_left |
||||||
|
## |
||||||
|
## 12. Ability to disable the default keybindings using the |
||||||
|
## no-tabbedex-keys resource. |
||||||
|
## |
||||||
|
## Added by xanf (Illya Klymov): |
||||||
|
## |
||||||
|
## 13. Ability to display non-latin characters in tab title. |
||||||
|
## |
||||||
|
## Added by jpkotta: |
||||||
|
## |
||||||
|
## 14. Tabs inherit command line options. |
||||||
|
## |
||||||
|
## Added by Mark Pustjens <pustjens@dds.nl> |
||||||
|
## |
||||||
|
## 15. Resources are now read respecting the -name option. |
||||||
|
## |
||||||
|
## 16. Ability to prevent the last tab from closing. |
||||||
|
## Use the following in your ~/.Xdefaults to enable: |
||||||
|
## URXvt.tabbed.reopen-on-close: yes |
||||||
|
## |
||||||
|
|
||||||
|
use Encode qw(decode); |
||||||
|
|
||||||
|
sub update_autohide { |
||||||
|
my ($self, $reconfigure) = @_; |
||||||
|
my $oldh = $self->{tabheight}; |
||||||
|
if ($self->{autohide} && @{ $self->{tabs} } <= 1 && |
||||||
|
! (@{ $self->{tabs} } == 1 && $self->{tabs}[-1]->{name})) { |
||||||
|
$self->{tabheight} = 0; |
||||||
|
} else { |
||||||
|
$self->{tabheight} = $self->{maxtabheight}; |
||||||
|
} |
||||||
|
if ($reconfigure && $self->{tabheight} != $oldh) { |
||||||
|
$self->configure; |
||||||
|
$self->copy_properties; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub tab_activity_mark ($$) { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
return ' ' unless defined $tab->{lastActivity}; |
||||||
|
return ' ' if $tab == $self->{cur}; |
||||||
|
if (defined $self->{timeouts}) { |
||||||
|
my $diff = int urxvt::NOW - $tab->{lastActivity}; |
||||||
|
for my $spec (@{ $self->{timeouts} }) { |
||||||
|
return $spec->[1] if $diff > $spec->[0]; |
||||||
|
} |
||||||
|
} |
||||||
|
'*'; |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub refresh { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
# autohide makes it zero |
||||||
|
return unless $self->{tabheight}; |
||||||
|
|
||||||
|
my $ncol = $self->ncol; |
||||||
|
|
||||||
|
my $text = " " x $ncol; |
||||||
|
my $rend = [($self->{rs_tabbar}) x $ncol]; |
||||||
|
|
||||||
|
my ($ofs, $idx, @ofs) = (0, 0); |
||||||
|
|
||||||
|
if ($self->{new_button}) { |
||||||
|
substr $text, 0, 7, "[NEW] |"; |
||||||
|
@$rend[0 .. 5] = ($self->{rs_tab}) x 6; |
||||||
|
push @ofs, [0, 6, -1 ]; |
||||||
|
$ofs = 7; |
||||||
|
} |
||||||
|
|
||||||
|
for my $tab (@{ $self->{tabs} }) { |
||||||
|
my $name = $tab->{name} ? $tab->{name} : $idx; |
||||||
|
my $act = $self->tab_activity_mark($tab); |
||||||
|
my $txt = sprintf "%s%s%s", $act, $name, $act; |
||||||
|
my $len = length $txt; |
||||||
|
|
||||||
|
substr $text, $ofs, $len + 1, "$txt|"; |
||||||
|
@$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len |
||||||
|
if $tab == $self->{cur}; |
||||||
|
|
||||||
|
push @ofs, [ $ofs, $ofs + $len, $idx ]; |
||||||
|
++$idx; |
||||||
|
$ofs += $len + 1; |
||||||
|
} |
||||||
|
|
||||||
|
substr $text, --$ofs, 1, ' '; # remove last '|' |
||||||
|
|
||||||
|
if ($self->{tab_title} && $ofs + 3 < $ncol) { |
||||||
|
my $term = $self->{term}; |
||||||
|
my @str = $term->XGetWindowProperty($term->parent, $self->{tab_title}); |
||||||
|
if (@str && $str[2]) { |
||||||
|
my $str = '| ' . decode("utf8", $str[2]); |
||||||
|
my $len = length $str; |
||||||
|
$len = $ncol - $ofs if $ofs + $len > $ncol; |
||||||
|
substr $text, $ofs, $len, substr $str, 0, $len; |
||||||
|
@$rend[$ofs + 2 .. $ofs + $len - 1] = ($self->{rs_title}) x ($len - 2); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
$self->{tabofs} = \@ofs; |
||||||
|
|
||||||
|
$self->ROW_t (0, $text, 0, 0, $ncol); |
||||||
|
$self->ROW_r (0, $rend, 0, 0, $ncol); |
||||||
|
|
||||||
|
$self->want_refresh; |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub new_tab { |
||||||
|
my ($self, @argv) = @_; |
||||||
|
|
||||||
|
my $offset = $self->fheight; |
||||||
|
|
||||||
|
$self->{tabheight} = $self->{maxtabheight} |
||||||
|
unless $self->{autohide} && !(defined $self->{tabs} && @{ $self->{tabs} }); |
||||||
|
|
||||||
|
# save a backlink to us, make sure tabbedex is inactive |
||||||
|
push @urxvt::TERM_INIT, sub { |
||||||
|
my ($term) = @_; |
||||||
|
$term->{parent} = $self; |
||||||
|
|
||||||
|
for (0 .. urxvt::NUM_RESOURCES - 1) { |
||||||
|
my $value = $self->{resource}[$_]; |
||||||
|
|
||||||
|
$term->resource ("+$_" => $value) |
||||||
|
if defined $value; |
||||||
|
} |
||||||
|
|
||||||
|
foreach my $opt (keys %urxvt::OPTION) { |
||||||
|
my $value = $self->{option}{$opt}; |
||||||
|
$term->option($urxvt::OPTION{$opt}, $value); |
||||||
|
} |
||||||
|
|
||||||
|
$term->resource (perl_ext_2 => $term->resource ("perl_ext_2") . ",-tabbedex"); |
||||||
|
}; |
||||||
|
|
||||||
|
push @urxvt::TERM_EXT, urxvt::ext::tabbedex::tab::; |
||||||
|
|
||||||
|
my $term = new urxvt::term |
||||||
|
$self->env, $urxvt::RXVTNAME, |
||||||
|
-embed => $self->parent, |
||||||
|
@argv; |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub configure { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
my $tab = $self->{cur}; |
||||||
|
|
||||||
|
# this is an extremely dirty way to force a configurenotify, but who cares |
||||||
|
$tab->XMoveResizeWindow ( |
||||||
|
$tab->parent, |
||||||
|
0, $self->{tabheight} + 1, |
||||||
|
$self->width, $self->height - $self->{tabheight} |
||||||
|
); |
||||||
|
$tab->XMoveResizeWindow ( |
||||||
|
$tab->parent, |
||||||
|
0, $self->{tabheight}, |
||||||
|
$self->width, $self->height - $self->{tabheight} |
||||||
|
); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub copy_properties { |
||||||
|
my ($self) = @_; |
||||||
|
my $tab = $self->{cur}; |
||||||
|
|
||||||
|
my $wm_normal_hints = $self->XInternAtom ("WM_NORMAL_HINTS"); |
||||||
|
|
||||||
|
my $current = delete $self->{current_properties}; |
||||||
|
|
||||||
|
# pass 1: copy over properties different or nonexisting |
||||||
|
for my $atom ($tab->XListProperties ($tab->parent)) { |
||||||
|
my ($type, $format, $items) = $self->XGetWindowProperty ($tab->parent, $atom); |
||||||
|
|
||||||
|
# fix up size hints |
||||||
|
if ($atom == $wm_normal_hints) { |
||||||
|
my (@hints) = unpack "l!*", $items; |
||||||
|
|
||||||
|
$hints[$_] += $self->{tabheight} for (4, 6, 16); |
||||||
|
|
||||||
|
$items = pack "l!*", @hints; |
||||||
|
} |
||||||
|
|
||||||
|
my $cur = delete $current->{$atom}; |
||||||
|
|
||||||
|
# update if changed, we assume empty items and zero type and format will not happen |
||||||
|
$self->XChangeProperty ($self->parent, $atom, $type, $format, $items) |
||||||
|
if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items; |
||||||
|
|
||||||
|
$self->{current_properties}{$atom} = [$type, $format, $items]; |
||||||
|
} |
||||||
|
|
||||||
|
# pass 2, delete all extraneous properties |
||||||
|
$self->XDeleteProperty ($self->parent, $_) for keys %$current; |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub my_resource { |
||||||
|
my $self = shift; |
||||||
|
$self->x_resource ("tabbed.$_[0]"); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub make_current { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
if (my $cur = $self->{cur}) { |
||||||
|
delete $cur->{lastActivity}; |
||||||
|
$cur->XUnmapWindow ($cur->parent) if $cur->mapped; |
||||||
|
$cur->focus_out; |
||||||
|
} |
||||||
|
|
||||||
|
$self->{cur} = $tab; |
||||||
|
|
||||||
|
$self->configure; |
||||||
|
$self->copy_properties; |
||||||
|
|
||||||
|
$tab->focus_out; # just in case, should be a nop |
||||||
|
$tab->focus_in if $self->focus; |
||||||
|
|
||||||
|
$tab->XMapWindow ($tab->parent); |
||||||
|
delete $tab->{lastActivity}; |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub on_focus_in { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->{cur}->focus_in; |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_focus_out { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->{cur}->focus_out; |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_key_press { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->{cur}->key_press ($event->{state}, $event->{keycode}, $event->{time}); |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub on_key_release { |
||||||
|
my ($self, $event) = @_; |
||||||
|
$self->{cur}->key_release ($event->{state}, $event->{keycode}, $event->{time}); |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
sub on_button_release { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
if ($event->{row} == 0) { |
||||||
|
my $col = $event->{col}; |
||||||
|
for my $button (@{ $self->{tabofs} }) { |
||||||
|
last if $col < $button->[0]; |
||||||
|
next unless $col <= $button->[1]; |
||||||
|
if ($button->[2] == -1) { |
||||||
|
$self->new_tab; |
||||||
|
} else { |
||||||
|
$self->make_current($self->{tabs}[$button->[2]]); |
||||||
|
} |
||||||
|
} |
||||||
|
return 1; |
||||||
|
} |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub on_init { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{resource} = [map $self->resource ("+$_"), 0 .. urxvt::NUM_RESOURCES - 1]; |
||||||
|
|
||||||
|
$self->resource (int_bwidth => 0); |
||||||
|
$self->resource (pty_fd => -1); |
||||||
|
|
||||||
|
$self->{option} = {}; |
||||||
|
for my $key (keys %urxvt::OPTION) { |
||||||
|
$self->{option}{$key} = $self->option($urxvt::OPTION{$key}); |
||||||
|
} |
||||||
|
|
||||||
|
# this is for the tabs terminal; order is important |
||||||
|
$self->option ($urxvt::OPTION{scrollBar}, 0); |
||||||
|
|
||||||
|
my $fg = $self->my_resource ("tabbar-fg"); |
||||||
|
my $bg = $self->my_resource ("tabbar-bg"); |
||||||
|
my $tabfg = $self->my_resource ("tab-fg"); |
||||||
|
my $tabbg = $self->my_resource ("tab-bg"); |
||||||
|
my $titfg = $self->my_resource ("title-fg"); |
||||||
|
my $titbg = $self->my_resource ("title-bg"); |
||||||
|
|
||||||
|
defined $fg or $fg = 3; |
||||||
|
defined $bg or $bg = 0; |
||||||
|
defined $tabfg or $tabfg = 0; |
||||||
|
defined $tabbg or $tabbg = 1; |
||||||
|
defined $titfg or $titfg = 2; |
||||||
|
defined $titbg or $titbg = 0; |
||||||
|
|
||||||
|
$self->{rs_tabbar} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2); |
||||||
|
$self->{rs_tab} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 2); |
||||||
|
$self->{rs_title} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $titfg + 2, $titbg + 2); |
||||||
|
|
||||||
|
|
||||||
|
my $timeouts = $self->my_resource ("tabbar-timeouts"); |
||||||
|
$timeouts = '16:.:8:::4:+' unless defined $timeouts; |
||||||
|
if ($timeouts ne '') { |
||||||
|
my @timeouts; |
||||||
|
while ($timeouts =~ /^(\d+):(.)(?::(.*))?$/) { |
||||||
|
push @timeouts, [ int $1, $2 ]; |
||||||
|
$timeouts = defined $3 ? $3 : ''; |
||||||
|
} |
||||||
|
if (@timeouts) { |
||||||
|
$self->{timeouts} = [ sort { $b->[0] <=> $a-> [0] } @timeouts ]; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
$self->{new_button} = |
||||||
|
($self->my_resource ('new-button') or 'false') !~ /^(?:false|0|no)/i; |
||||||
|
$self->{tab_title} = |
||||||
|
($self->my_resource ('title') or 'true') !~ /^(?:false|0|no)/i; |
||||||
|
$self->{autohide} = |
||||||
|
($self->my_resource ('autohide') or 'false') !~ /^(?:false|0|no)/i; |
||||||
|
$self->{no_default_keys} = |
||||||
|
($self->my_resource ('no-tabbedex-keys') or 'false') !~ /^(?:false|0|no)/i; |
||||||
|
$self->{reopen_on_close} = |
||||||
|
($self->my_resource ('reopen-on-close') or 'false') !~ /^(?:false|0|no)/i; |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub on_start { |
||||||
|
my ($self) = @_; |
||||||
|
|
||||||
|
$self->{maxtabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace; |
||||||
|
$self->{tabheight} = $self->{autohide} ? 0 : $self->{maxtabheight}; |
||||||
|
|
||||||
|
$self->{running_user_command} = 0; |
||||||
|
|
||||||
|
$self->cmd_parse ("\033[?25l"); |
||||||
|
|
||||||
|
my @argv = $self->argv; |
||||||
|
|
||||||
|
do { |
||||||
|
shift @argv; |
||||||
|
} while @argv && $argv[0] ne "-e"; |
||||||
|
|
||||||
|
if ($self->{tab_title}) { |
||||||
|
$self->{tab_title} = $self->{term}->XInternAtom("_NET_WM_NAME", 1); |
||||||
|
} |
||||||
|
|
||||||
|
$self->new_tab (@argv); |
||||||
|
|
||||||
|
if (defined $self->{timeouts}) { |
||||||
|
my $interval = ($self->{timeouts}[@{ $self->{timeouts} } - 1]->[0]); |
||||||
|
$interval = int($interval / 4); |
||||||
|
$self->{timer} = urxvt::timer->new |
||||||
|
->interval($interval < 1 ? 1 : $interval) |
||||||
|
->cb ( sub { $self->refresh; } ); |
||||||
|
} |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub on_configure_notify { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->configure; |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub on_user_command { |
||||||
|
my ($self, $event) = @_; |
||||||
|
|
||||||
|
$self->{cur}->{term}->{parent}->tab_user_command($self->{cur}, $event, 1); |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub on_wm_delete_window { |
||||||
|
my ($self) = @_; |
||||||
|
$_->destroy for @{ $self->{tabs} }; |
||||||
|
1; |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub tab_start { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
$tab->XChangeInput ($tab->parent, urxvt::PropertyChangeMask); |
||||||
|
|
||||||
|
push @{ $self->{tabs} }, $tab; |
||||||
|
|
||||||
|
# $tab->{name} ||= scalar @{ $self->{tabs} }; |
||||||
|
$self->make_current ($tab); |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub tab_destroy { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
if ($self->{reopen_on_close} && $#{ $self->{tabs} } == 0) { |
||||||
|
$self->new_tab; |
||||||
|
$self->make_current ($self->{tabs}[-1]); |
||||||
|
} |
||||||
|
|
||||||
|
$self->{tabs} = [ grep $_ != $tab, @{ $self->{tabs} } ]; |
||||||
|
$self->update_autohide (); |
||||||
|
|
||||||
|
if (@{ $self->{tabs} }) { |
||||||
|
if ($self->{cur} == $tab) { |
||||||
|
delete $self->{cur}; |
||||||
|
$self->make_current ($self->{tabs}[-1]); |
||||||
|
} else { |
||||||
|
$self->refresh; |
||||||
|
} |
||||||
|
} else { |
||||||
|
# delay destruction a tiny bit |
||||||
|
$self->{destroy} = urxvt::iw->new->start->cb (sub { $self->destroy }); |
||||||
|
} |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub tab_key_press { |
||||||
|
my ($self, $tab, $event, $keysym, $str) = @_; |
||||||
|
|
||||||
|
if ($tab->{is_inputting_name}) { |
||||||
|
if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter |
||||||
|
$tab->{name} = $tab->{new_name}; |
||||||
|
$tab->{is_inputting_name} = 0; |
||||||
|
$self->update_autohide (1); |
||||||
|
} elsif ($keysym == 0xff1b) { # escape |
||||||
|
$tab->{name} = $tab->{old_name}; |
||||||
|
$tab->{is_inputting_name} = 0; |
||||||
|
$self->update_autohide (1); |
||||||
|
} elsif ($keysym == 0xff08) { # backspace |
||||||
|
substr $tab->{new_name}, -1, 1, ""; |
||||||
|
$tab->{name} = "$tab->{new_name}█"; |
||||||
|
} elsif ($str !~ /[\x00-\x1f\x80-\xaf]/) { |
||||||
|
$tab->{new_name} .= $str; |
||||||
|
$tab->{name} = "$tab->{new_name}█"; |
||||||
|
} |
||||||
|
$self->refresh; |
||||||
|
return 1; |
||||||
|
} |
||||||
|
|
||||||
|
return () if ($self->{no_default_keys}); |
||||||
|
|
||||||
|
if ($event->{state} & urxvt::ShiftMask) { |
||||||
|
if ($keysym == 0xff51 || $keysym == 0xff53) { |
||||||
|
if (@{ $self->{tabs} } > 1) { |
||||||
|
$self->change_tab($tab, $keysym - 0xff52); |
||||||
|
} |
||||||
|
return 1; |
||||||
|
|
||||||
|
} elsif ($keysym == 0xff54) { |
||||||
|
$self->new_tab; |
||||||
|
return 1; |
||||||
|
|
||||||
|
} elsif ($keysym == 0xff52) { |
||||||
|
$self->rename_tab($tab); |
||||||
|
return 1; |
||||||
|
} |
||||||
|
} elsif ($event->{state} & urxvt::ControlMask) { |
||||||
|
if ($keysym == 0xff51 || $keysym == 0xff53) { |
||||||
|
$self->move_tab($tab, $keysym - 0xff52); |
||||||
|
return 1; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub tab_property_notify { |
||||||
|
my ($self, $tab, $event) = @_; |
||||||
|
|
||||||
|
$self->copy_properties |
||||||
|
if $event->{window} == $tab->parent; |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub tab_add_lines { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
my $mark = $self->tab_activity_mark($tab); |
||||||
|
$tab->{lastActivity} = int urxvt::NOW; |
||||||
|
$self->refresh if $mark ne $self->tab_activity_mark($tab); |
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub tab_user_command { |
||||||
|
my ($self, $tab, $cmd, $proxy_events) = @_; |
||||||
|
|
||||||
|
if ($cmd eq 'tabbedex:new_tab') { |
||||||
|
$self->new_tab; |
||||||
|
} |
||||||
|
elsif ($cmd eq 'tabbedex:next_tab') { |
||||||
|
$self->change_tab($tab, 1); |
||||||
|
} |
||||||
|
elsif ($cmd eq 'tabbedex:prev_tab') { |
||||||
|
$self->change_tab($tab, -1); |
||||||
|
} |
||||||
|
elsif ($cmd eq 'tabbedex:move_tab_left') { |
||||||
|
$self->move_tab($tab, -1); |
||||||
|
} |
||||||
|
elsif ($cmd eq 'tabbedex:move_tab_right') { |
||||||
|
$self->move_tab($tab, 1); |
||||||
|
} |
||||||
|
elsif ($cmd eq 'tabbedex:rename_tab') { |
||||||
|
$self->rename_tab($tab); |
||||||
|
} |
||||||
|
else { |
||||||
|
# Proxy the user command through to the tab's term, while taking care not |
||||||
|
# to get caught in an infinite loop. |
||||||
|
if ($proxy_events && $self->{running_user_command} == 0) { |
||||||
|
$self->{running_user_command} = 1; |
||||||
|
urxvt::invoke($tab->{term}, 20, $cmd); |
||||||
|
$self->{running_user_command} = 0; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub change_tab { |
||||||
|
my ($self, $tab, $direction) = @_; |
||||||
|
|
||||||
|
my $idx = 0; |
||||||
|
++$idx while $self->{tabs}[$idx] != $tab; |
||||||
|
$idx += $direction; |
||||||
|
$self->make_current ($self->{tabs}[$idx % @{ $self->{tabs}}]); |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub move_tab { |
||||||
|
my ($self, $tab, $direction) = @_; |
||||||
|
|
||||||
|
if (@{ $self->{tabs} } > 1) { |
||||||
|
my $idx1 = 0; |
||||||
|
++$idx1 while $self->{tabs}[$idx1] != $tab; |
||||||
|
my $idx2 = ($idx1 + $direction) % @{ $self->{tabs} }; |
||||||
|
|
||||||
|
($self->{tabs}[$idx1], $self->{tabs}[$idx2]) = |
||||||
|
($self->{tabs}[$idx2], $self->{tabs}[$idx1]); |
||||||
|
$self->make_current ($self->{tabs}[$idx2]); |
||||||
|
} |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
sub rename_tab { |
||||||
|
my ($self, $tab) = @_; |
||||||
|
|
||||||
|
$tab->{is_inputting_name} = 1; |
||||||
|
$tab->{old_name} = $tab->{name} ? $tab->{name} : ""; |
||||||
|
$tab->{new_name} = ""; |
||||||
|
$tab->{name} = "█"; |
||||||
|
$self->update_autohide (1); |
||||||
|
$self->refresh; |
||||||
|
|
||||||
|
(); |
||||||
|
} |
||||||
|
|
||||||
|
package urxvt::ext::tabbedex::tab; |
||||||
|
|
||||||
|
# helper extension implementing the subwindows of a tabbed terminal. |
||||||
|
# simply proxies all interesting calls back to the tabbedex class. |
||||||
|
|
||||||
|
{ |
||||||
|
for my $hook (qw(start destroy user_command key_press property_notify add_lines)) { |
||||||
|
eval qq{ |
||||||
|
sub on_$hook { |
||||||
|
my \$parent = \$_[0]{term}{parent} |
||||||
|
or return; |
||||||
|
\$parent->tab_$hook (\@_) |
||||||
|
} |
||||||
|
}; |
||||||
|
die if $@; |
||||||
|
} |
||||||
|
} |
||||||
Loading…
Reference in new issue