☰

urxvtを呼び出すウィンドウでurxvt perl拡張を実行する子プロセス

tag-icon • tag-icon rxvt
urxvtを呼び出すウィンドウでurxvt perl拡張を実行する子プロセス

私は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");
    ()
}

両方の問題は、caturxvtの親（たとえば、拡張開発中に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"

私がどれだけ離れてきたかについての@gebの質問に答えて、2022年12月10日を編集します。警告する：数年前に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"&'

おすすめ記事