30 changed files with 6877 additions and 13 deletions
@ -0,0 +1,33 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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 @@
@@ -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