我正在尝试编写一个 rxvt-unicode perl 扩展来做什么mrxvt 打印屏幕做。即，扩展应该将 urxvt 的内容通过管道传递给用户定义的命令。主要目的是查看以less -S.
这是我的第一次尝试。 （该命令仍然是硬编码的cat -n，并且仍然缺少颜色转义码和换行连接。）
#! perl -w
use strict;
sub on_user_command {
my ($self, $cmd) = @_;
open PIPE, "|cat -n" or die "urxvt-pipe: error opening pipe: $^E\n";
for (my $i = $self->top_row; $i < $self->nrow; $i++) {
print PIPE $self->ROW_t($i), "\n";
}
close PIPE or warn "urxvt-pipe: error closing pipe: $^E\n";
()
}
更换管道exec_async没有帮助：
#! perl -w
use strict;
sub on_user_command {
my ($self, $cmd) = @_;
open FH, ">/tmp/urxvt.txt" or die "urxvt-pipe: error opening file: $^E\n";
for (my $i = $self->top_row; $i < $self->nrow; $i++) {
print FH $self->ROW_t($i), "\n";
}
close FH or warn "urxvt-pipe: error closing file: $^E\n";
$self->exec_async("cat", "-n", "/tmp/urxvt.txt");
()
}
两者的问题是cat在 urxvt 的父级内部运行（例如，如果我在扩展开发期间将 urxvt 称为“编译”命令，则另一个 urxvt 或 emacs 缓冲区）。我希望它在我正在管道传输其内容的实例或其新选项卡中运行。那可能吗？
显然，作为一种解决方法，exec_async可以修改为打开一个新窗口：$self->exec_async("urxvt", "-title", "less urxvt scrollback", "-e", "less", "-S", "/tmp/urxvt.txt");但我更喜欢同一个窗口，同时也避免创建临时文件。
答案1
这并没有回答真正的问题，但不幸的是它因太长而无法发表评论而被拒绝。
我使解决方法变得不那么难看，将新窗口部分移出扩展：
- 该扩展使用 IPC::Run3::run3 捕获子进程的 stdout 和 stderr，并使用
$term->special_encode和将其写入“正确的”urxvt$term->cmd_parse。 （并不是less有任何有用的输出，只是为了使其成为通用扩展。） - 配置的命令（在 ~/.Xdefaults 中的 URxvt.keysym... 行中）是：
zsh -c 'stdin2fifo | read -r p && urxvt -e less -SNRfI -- "$p"' - 脚本 stdin2fifo 读取 stdin 并将其写入临时命名管道。
less -f显示管道。因此，希望没有针对真实数据的磁盘 I/O，仅针对文件系统条目。
脚本 stdin2fifo：
#!/bin/zsh
if [ $# -ne 0 ]; then
cat <<EOF
Usage: $(basename "$0")
Reads stdin, writes it to a new named pipe (in the background), and prints the
pipe's pathname.
Can be used (in zsh, at least) to "send stdin to another terminal". For example:
... | $(basename "$0") | read -r p && urxvt -e less -f -- "\$p"
EOF
exit 4
fi
set -e
dir=$(mktemp -d "/tmp/$(basename "$0")_XXXXXX")
pipe=$dir/pipe
mkfifo "$pipe"
(cat > "$pipe")&
echo "$pipe"
编辑 2022 年 12 月 10 日，回应 @geb 的问题我走了多远。警告：我几年前就停止使用 urxvt，不知道这在当前版本中是否有效，甚至不知道它在当时有多少作用。它的最后一次编辑似乎是在 2016 年 5 月。因此，在没有保证的情况下，使用风险自负。
脚本 stdin2fifo：见上文，未更改。
脚本 urxvt-pipe：
#! perl -w
use strict;
use Env;
use IPC::Run3;
use feature qw(current_sub);
use constant EXT_NAME => 'urxvt-pipe';
use constant INFO => 8;
use constant DEBUG => 13;
use constant TRACE => 16;
sub msgLevelEnabled { my ($level) = @_; $ENV{URXVT_PERL_VERBOSITY} >= $level; }
sub msg { my $level = shift @_; printf STDERR @_ if msgLevelEnabled($level); }
sub errorMsg { die(sprintf("%s: %s\n", EXT_NAME, join(", ", @_))); }
sub warnMsg { warn(sprintf("%s: %s\n", EXT_NAME, join(", ", @_))); }
sub on_start {
my ($t) = @_;
# corresponding .Xdefaults line: URxvt.pipe.stdout-format: \033[34m%s\033[0m\015\n
$t->{stdoutFormat} = $t->conf("stdout-format", "\e[34m%s\e[0m\r\n");
msg(DEBUG, "{stdoutFormat} == '%s'\n", $t->{stdoutFormat});
$t->{stderrFormat} = $t->conf("stderr-format", "\e[31m%s\e[0m\r\n");
msg(DEBUG, "{stderrFormat} == '%s'\n", $t->{stderrFormat});
$t->{statusFormat} = $t->conf("status-format", "\e[41;37;1m Status: %s \e[0m\r\n");
msg(DEBUG, "{statusFormat} == '%s'\n", $t->{statusFormat});
$t->{echoFormat} = $t->conf("echo-format", "\r\n\e[34m" . EXT_NAME . "> %s\e[0m\r\n");
msg(DEBUG, "{echoFormat} == '%s'\n", $t->{echoFormat});
$t->{promptPattern} = $t->conf("prompt-pattern", '.*?[>$#]\s*+(.+)');
msg(DEBUG, "{promptPattern} == '%s'\n", $t->{promptPattern});
$t->{sendBeforeCommand} = $t->conf("send-before-cmd", '');
msg(DEBUG, "{sendBeforeCommand} == '%s'\n", $t->{sendBeforeCommand});
$t->{sendAfterCommand} = $t->conf("send-after-cmd", '');
msg(DEBUG, "{sendAfterCommand} == '%s'\n", $t->{sendAfterCommand});
msg(TRACE, "DEFAULT_RSTYLE == %032b (%s)\n", urxvt::DEFAULT_RSTYLE, describeRendition(urxvt::DEFAULT_RSTYLE));
msg(TRACE, "RS_Bold == %032b\n", urxvt::RS_Bold);
msg(TRACE, "RS_Italic == %032b\n", urxvt::RS_Italic);
msg(TRACE, "RS_Blink == %032b\n", urxvt::RS_Blink);
msg(TRACE, "RS_RVid == %032b\n", urxvt::RS_RVid);
msg(TRACE, "RS_Uline == %032b\n", urxvt::RS_Uline);
}
sub conf {
my ($term, $name, $defaultValue) = @_;
defined $term->x_resource("%.$name") ? $term->x_resource("%.$name") : $defaultValue;
}
sub on_user_command {
my ($term, $arg) = @_;
# === parse $arg ===
msg(DEBUG, "on_user_command(.., '%s')\n", $arg);
my (undef, $options, $cmd) = $arg =~ m{.*?:(.)(.*?)\1(.*)} or errorMsg("expected arg format ...:[<options>]:<command>");
msg(DEBUG, "\$options == '%s', \$cmd == '%s'\n", $options, $cmd);
my %options = ();
for (split /,/, $options) { m{(.*?)=(.*)} or errorMsg("options: expected comma-separated key=value pairs"); $options{$1} = $2; };
msg(DEBUG, "%%options == (%s)\n", join("; ", map { "$_ = $options{$_}" } keys(%options))) if msgLevelEnabled(DEBUG);
# === prepare $cmd's input ===
my ($rowNum, $maxRowNum) = selectRows($term, $options{start}, $options{end});
my $nextLine = sub {
return undef if $rowNum > $maxRowNum;
my $l = $term->line($rowNum);
msg(TRACE, "\nline(%d)->t == \"%s\"\n", $rowNum, $l->t);
msg(TRACE, "line(%d)->beg == %d, ->end == %d\n", $rowNum, $l->beg, $l->end);
$rowNum += $l->end - $l->beg + 1;
return line2string($term, $l, \%options) . "\n";
};
$nextLine = logFunction($nextLine, 'nextLine') if msgLevelEnabled(DEBUG);
# wrap $nextLine() to discard trailing empty results
my $bufferedEmptyResultsCount = 0; #buffered empty lines returned by nextLine()
my $bufferedResult; #buffered non-empty line after $bufferedEmptyResultsCount
my $nextLineTruncated = sub {
# prefer buffered results to new $nextLine() invocation
if ($bufferedEmptyResultsCount > 0) {
msg(TRACE, "returning buffered empty line\n");
$bufferedEmptyResultsCount--;
return "\n";
}
if (defined($bufferedResult)) {
msg(TRACE, "returning buffered non-empty line\n");
my $result = $bufferedResult;
$bufferedResult = undef;
return $result;
}
my $origResult = &$nextLine(@_);
if ($origResult ne "\n") {
msg(TRACE, "returning original line\n");
return $origResult;
}
msg(TRACE, "buffering empty line; looking for next non-empty line\n");
$bufferedEmptyResultsCount++;
# after empty result, search for next non-empty result (or stop at undef)
while (1) {
$origResult = &$nextLine(@_);
if (!defined($origResult)) {
msg(DEBUG, "discarding %d trailing empty lines\n", $bufferedEmptyResultsCount);
$bufferedEmptyResultsCount = 0;
$bufferedResult = undef;
return undef;
}
if ($origResult eq "\n") {
msg(TRACE, "buffering empty line\n");
$bufferedEmptyResultsCount++;
} else { #found non-empty
msg(TRACE, "buffering non-empty line, re-invoking %s\n", __SUB__);
$bufferedResult = $origResult;
return __SUB__->(@_);
}
}
};
$nextLineTruncated = logFunction($nextLineTruncated, 'nextLineTruncated') if msgLevelEnabled(DEBUG);
# === read $cmd from terminal if empty ===
if (length($cmd) == 0) {
$cmd = readCommandFromTerminal($term);
if (!defined($cmd)) { return (); }
}
# === sub to e.g. cut current input line (only before 1st output) ===
my $hasOutput = 0;
my $beforeOutput = sub {
if (!$hasOutput) {
$hasOutput = 1;
$term->tt_write($term->{sendBeforeCommand}) if length($term->{sendBeforeCommand}) > 0;
}
};
# === print $cmd ===
if ($options{'echo'}) {
&$beforeOutput;
$term->cmd_parse(sprintf($term->{echoFormat}, $term->special_encode($cmd)));
}
# === execute $cmd ===
my($cmdIn, $cmdOut, $cmdErr, %run3options);
$run3options{binmode_stdin} = $run3options{binmode_stdout} = $run3options{binmode_stderr} = ':utf8';
my $run = run3($cmd, $nextLineTruncated, \$cmdOut, \$cmdErr, \%run3options)
or errorMsg("failed to start ${cmd}: $^E");
my $status = $? >> 8;
msg(DEBUG, "\$? == %d, \$status == %d\n", $?, $status);
# === print $cmd's output and status ===
unless ($options{'quiet'}) {
if (length($term->{stdoutFormat}) > 0 && length($cmdOut) > 0) {
msg(DEBUG, "printing stdout\n");
for (split /\r?\n/, $cmdOut) {
&$beforeOutput;
$term->cmd_parse(sprintf($term->{stdoutFormat}, $term->special_encode($_)));
}
}
if (length($term->{stderrFormat}) > 0 && length($cmdErr) > 0) {
msg(DEBUG, "printing stderr\n");
for (split /\r?\n/, $cmdErr) {
&$beforeOutput;
$term->cmd_parse(sprintf($term->{stderrFormat}, $term->special_encode($_)));
}
}
if ($status != 0 && length($term->{statusFormat}) > 0) {
msg(DEBUG, "printing status\n");
&$beforeOutput;
$term->cmd_parse(sprintf($term->{statusFormat}, $status));
}
}
# === try to correct prompt (e.g. paste current input) ===
if ($hasOutput && length($term->{sendAfterCommand}) > 0) {
msg(DEBUG, "printing {sendAfterCommand}\n");
$term->tt_write($term->{sendAfterCommand});
}
msg(DEBUG, "on_user_command returns\n");
()
}
sub selectRows {
my ($term, $startPage, $endPage) = @_;
msg(DEBUG, "nrow=%d, saveL.=%d, total_rows=%d, view_start=%d [%s], top_row=%d [%s]\n",
$term->nrow, $term->saveLines, $term->total_rows,
$term->view_start, substr($term->ROW_t($term->view_start), 0, 30),
$term->top_row, substr($term->ROW_t($term->top_row), 0, 30))
if msgLevelEnabled(DEBUG);
if (!defined $startPage && !defined $endPage) { #neither start nor end set => only current page
$startPage = 0;
$endPage = 0;
}
# only one of start or end set
$startPage = '^' unless defined $startPage;
$endPage = '$' unless defined $endPage;
my $startRow = selectRow($term, $startPage, 0);
my $endRow = selectRow($term, $endPage, 1);
msg(DEBUG, "selectRows(.., %s, %s) == (%s, %s)\n", $startPage, $endPage, $startRow, $endRow);
return ($startRow, $endRow);
}
sub selectRow {
my ($term, $page, $bottom) = @_;
my $min = $term->top_row;
my $max = $term->total_rows - $term->nrow + 1;
my $row;
if ($page eq '^') {
$row = $min;
} elsif ($page eq '$') {
$row = $max;
} else {
$row = $term->view_start + $page * $term->nrow;
if ($row < $min) { $row = $min; }
if ($row > $max) { $row = $max; }
}
if ($bottom) {
$row += $term->nrow - 1;
} else {
# TODO Set environment variable according to (logical) line, not (wrapped) row
my $envLineNo = $term->view_start - $row;
msg(DEBUG, "URXVT_PIPE_LINENO = %s\n", $envLineNo);
$ENV{URXVT_PIPE_LINENO} = $envLineNo if $envLineNo >= 0;
}
return $row;
}
sub readLastTerminalLine {
my ($term) = @_;
my $lastLineText = '';
for (my $rowNum = $term->total_rows; $rowNum >= $term->top_row; $rowNum--) {
my $line = $term->line($rowNum);
msg(TRACE, "readLastTerminalLine: [%d] \$line->t = '%s'\n", $rowNum, $line->t);
$lastLineText = $term->special_decode($line->t) . $lastLineText;
last if $line->l > 0;
$rowNum -= $line->end - $line->beg;
}
$lastLineText =~ s{\n+$}{}g;
msg(DEBUG, "readLastTerminalLine() == '%s'\n", $lastLineText);
return $lastLineText;
}
sub readCommandFromTerminal {
my ($term) = @_;
my $lastLineText = readLastTerminalLine($term);
if ($lastLineText =~ m{$term->{promptPattern}}s && length($1) > 0) {
msg(INFO, "found command '%s'\n", $1);
return $1;
}
warnMsg('No command found using prompt pattern ' . $term->{promptPattern}
. ' (did you forget a capturing group?)');
return undef;
}
# converts a urxvt->line object into the string to write to the pipe
sub line2string {
my ($term, $line, $optionsRef) = @_;
my %options = %$optionsRef;
my $text = $line->t;
if (!$options{'color'}) {
return $term->special_decode($text);
}
my @rendsArray = @{$line->r};
my $textEsc = ''; # $text with escapes
my $len = length($text);
my $prevRend;
my $resetSuffix = '';
for (my $i = 0; $i < $len; $i++) {
my $char = substr($text, $i, 1);
my $rend = $rendsArray[$i];
msg(TRACE, "[%d]\t'%s': \$rend == %032b (%s)\n", $i, $char, $rend,
$rend == $prevRend ? '...' : describeRendition($rend)) if msgLevelEnabled(TRACE);
if ($i == 0 || $rend != $prevRend) {
$textEsc .= "\e[m" if $i > 0; #TODO make escapes configurable
my $escape = rendition2Escape($rend);
$resetSuffix = "\e[m" if '' ne $escape; #TODO make escapes configurable
$textEsc .= $escape;
}
$textEsc .= $char;
$prevRend = $rend;
}
return $term->special_decode($textEsc . $resetSuffix);
}
#TODO make escapes configurable
sub rendition2Escape {
my ($rend) = @_;
if ($rend == 0) {
msg(TRACE, "rendition2Escape(0) == ''\n");
return '';
}
my @escapes = ();
# WTF? GET_BASEFG == 0 / GET_BASEBG == 1 seem to mean default color; otherwise they are color index + 2.
# TODO: But GET_BASEBG == 1 can also be color 1 (red). How to distinguish?
# Example (showing output of /usr/share/screen/256colors.pl):
# "S" in "System colors:" header, default colors:
# -> $rend == 00000000000010000000000000000001 (fg: 0, bg: 1, bold: 0, it: 0, ul: 0, rv: 0, bl: 0, custom: 0)
# 3rd " " in line 2, red background:
# -> $rend == 00000000000010000000000000000011 (fg: 0, bg: 3, bold: 0, it: 0, ul: 0, rv: 0, bl: 0, custom: 0)
my $bg = urxvt::GET_BASEBG $rend;
my $fg = urxvt::GET_BASEFG $rend;
push @escapes, ('38;5;' . ($fg - 2)) if $fg != 0;
push @escapes, ('48;5;' . ($bg - 2)) if $bg != 1;
push @escapes, '1' if $rend & urxvt::RS_Bold;
push @escapes, '3' if $rend & urxvt::RS_Italic;
push @escapes, '5' if $rend & urxvt::RS_Blink;
push @escapes, '7' if $rend & urxvt::RS_RVid;
push @escapes, '4' if $rend & urxvt::RS_Uline;
# my $escapeSeq = "\e[" . join(';', @escapes) . 'm';
my $escapeSeq = join('', map { "\e[" . $_ . 'm' } @escapes);
msg(TRACE, "rendition2Escape(%s): %sxyz\e[0m\n", $rend, $escapeSeq) if @escapes > 0 && msgLevelEnabled(TRACE);
return $escapeSeq;
}
sub describeRendition {
my ($rend) = @_;
sprintf("fg: %d, bg: %d, bold: %d, it: %d, ul: %d, rv: %d, bl: %d, custom: %d",
urxvt::GET_BASEFG $rend,
urxvt::GET_BASEBG $rend,
$rend & urxvt::RS_Bold,
$rend & urxvt::RS_Italic,
$rend & urxvt::RS_Uline,
$rend & urxvt::RS_RVid,
$rend & urxvt::RS_Blink,
urxvt::GET_CUSTOM $rend);
}
sub logFunction {
my ($funcRef, $funcName) = @_;
my $logF = sub {
my $res = &$funcRef(@_);
msg(DEBUG, "%s(..) == '%s'\n", $funcName, defined($res) ? $res : '<undef>');
return $res;
};
msg(TRACE, "logFunction(%s) == %s\n", $funcRef, $logF);
return $logF;
}
# TODO: documentation
~/.Xdefaults 条目（查找“pipe”，名为“URxvt.print-pipe”的条目可能不相关）：
URxvt.print-pipe: cat > /tmp/urxvt.pp
URxvt.perl-ext-common: default,keyboard-select,pipe
URxvt.pipe.stdout-format: \033[90m[%s]\033[0m\015\n
URxvt.pipe.stderr-format: \033[31m[%s]\033[0m\015\n
URxvt.pipe.status-format: \040\033[101;37;1m\!%d\!\033[0m\040\015\n
urxvt.perl-ext-common: default,pipe
urxvt.keysym.F5: perl:pipe::start=-2,end=0,color=1: zsh -c 'stdin2fifo | read -r f && env URXVT_PERL_VERBOSITY= mintty -t "less urxvt" -s 270x73 -p 0,0 -o BackgroundColour=255,249,216 -i /c/windows/system32/shell32.dll,56 -e less -SRf +${URXVT_PIPE_LINENO:-0}g "$f"&'
urxvt.keysym.S-F5: perl:pipe::start=-4,end=0,color=1: zsh -c 'stdin2fifo | read -r f && env URXVT_PERL_VERBOSITY= mintty -t "less urxvt" -s 270x73 -p 0,0 -o BackgroundColour=255,249,216 -i /c/windows/system32/shell32.dll,56 -e less -SRf +${URXVT_PIPE_LINENO:-0}g "$f"&'
urxvt.keysym.F6: perl:pipe::start=-20,end=$,color=1: zsh -c 'stdin2fifo | read -r f && env URXVT_PERL_VERBOSITY= mintty -t "less urxvt" -s 270x73 -p 0,0 -o BackgroundColour=255,249,216 -i /c/windows/system32/shell32.dll,56 -e less -SRf +G "$f"&'
urxvt.keysym.S-F6: perl:pipe::start=^,end=$,color=1: zsh -c 'stdin2fifo | read -r f && env URXVT_PERL_VERBOSITY= mintty -t "less urxvt" -s 270x73 -p 0,0 -o BackgroundColour=255,249,216 -i /c/windows/system32/shell32.dll,56 -e less -SRf +G "$f"&'