perl による端末上でのハイライト方法

背景

端末の上を走る bash などの出力は基本白い文字である。
しかしこれらは
print "\e[", $_, "m$_\e[m " for 1..108;
のような呪文的構文によりハイライトなどで視認性を高めることができる。
この呪文を簡単に扱えるよう cpan などには投稿されてきたものが沢山あるが
たまたま最初に触ったものは重たかった。
ゆえに自分の環境の中で使うものだけハッシュなどで使いやすくした

概要

パイプを通して着色フィルターとして使う dye.pl と
perl コードの中で require することで着色関数を使えるようにする dye.pm
の2つを書いた。
dye.pl は、下のような構文に失敗すると、構文やサポートしている着色が表示される。
cat flower_names | dye.pl "Rose" red back_shade_green Itaric
dye.pm は perldoc で Colorlizer::dye($word, @colors); などの例文が見られる。
vim の 'thinca/vim-ref' ならば K でおそらくそれが表示される。

使用例

以下のように条件に合わせて着色させることで読みやすくなります

環境

perl v5.26.3
mintty 3.0.2

コード

dye.pl

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use File::Basename;

sub say {print "@_", "\n"};
my %color_map = (
    bold              => 1,
    gray              => 2,
    itaric            => 3,
    underline         => 4,
    blink             => 5,
    blink_quick       => 6,
    back_gray         => 7,
    invisible         => 8,
    center_bar        => 9,
    tall              => 12,
    underline_w       => 21,
    black             => 30,
    red               => 31,
    green             => 32,
    orange            => 33,
    blue              => 34,
    purple            => 35,
    cyan              => 36,
    back_shade_red    => 41,
    back_shade_green  => 42,
    back_orange       => 43,
    back_tint_blue    => 44,
    back_tint_purple  => 45,
    back_shade_cyan   => 46,
    back_whitey       => 47,
    top_bar           => 53,
    left_up           => 73,
    right_down        => 74,
    tint_red          => 91,
    tint_green        => 92,
    yellow            => 93,
    tint_blue         => 94,
    magenta           => 95,
    water             => 96,
    back_dark_gray    => 100,
    back_pink         => 101,
    back_light_green  => 102,
    back_light_yellow => 103,
    back_light_blue   => 104,
    back_light_purple => 105,
    back_light_cyan   => 106,
    back_white        => 107,
);

sub dye {
    my $color_letter_set = shift;
    my $words = shift;
    "\e[" . $color_letter_set . "m" . $words . "\e[0m";
};

my @color_words  = sort keys %color_map;
my @color_digits = @color_map{@color_words};

my $i = 0;
my @supported;
for (@color_digits) {
    push @supported, dye($color_digits[$i], $color_words[$i]);
    $i++;
}

my $this_script = basename($0, '');
my $USAGE = << "EOL";
This filter program do highlight words in STDIN
inputs | this_script "words" color
cat flower_names | $this_script "Rose" red
cat flower_names | $this_script "Rose" red back_shade_green Itaric

supported visible colors are
@supported

EOL


die "$USAGE\n [@ARGV] found. More than 2 args needed.\n" if @ARGV < 2;
my $words = shift @ARGV;
my $color_letter_set;
for (1 .. @ARGV) {
    my $color_letter = $color_map{lc shift @ARGV};
    if ($color_letter) {
        $color_letter_set .= $color_letter;
    } 
    else {
        die "$USAGE\nThe color may not be supported.\n";
    }
    $color_letter_set .= q(;) if @ARGV;
};

while (<>) {
    s/$words/dye($color_letter_set, $&)/eg;
    print;
}

dye.pm

#!/usr/bin/env perl
=head1 SAMPLE
require Colorlizer;
my $line = "CONST growing_weapon_at  = VK_g";
my $from = "o";
my @c = qw( bold red blink underline);
my $to = Colorlizer::dye($from, @c);
say $line =~ s/$from/$to/r;

=head2 COLORS
    bold gray itaric underline blink blink_quick back_gray invisible center_bar
    tall underline_w black red green orange blue purple cyan back_shade_red
    back_shade_green back_orange back_tint_blue back_tint_purple back_shade_cyan
    back_whitey top_bar left_up right_down tint_red tint_green yellow tint_blue
    magenta water back_dark_gray back_pink back_light_green back_light_yellow
    back_light_blue back_light_purple back_light_cyan back_white 
=cut

use Smart::Comments;
use strict;
use warnings;
use utf8;
package Colorlizer;

my %color_map = (
    bold              => 1,
    gray              => 2,
    itaric            => 3,
    underline         => 4,
    blink             => 5,
    blink_quick       => 6,
    back_gray         => 7,
    invisible         => 8,
    center_bar        => 9,
    tall              => 12,
    underline_w       => 21,
    black             => 30,
    red               => 31,
    green             => 32,
    orange            => 33,
    blue              => 34,
    purple            => 35,
    cyan              => 36,
    back_shade_red    => 41,
    back_shade_green  => 42,
    back_orange       => 43,
    back_tint_blue    => 44,
    back_tint_purple  => 45,
    back_shade_cyan   => 46,
    back_whitey       => 47,
    top_bar           => 53,
    left_up           => 73,
    right_down        => 74,
    tint_red          => 91,
    tint_green        => 92,
    yellow            => 93,
    tint_blue         => 94,
    magenta           => 95,
    water             => 96,
    back_dark_gray    => 100,
    back_pink         => 101,
    back_light_green  => 102,
    back_light_yellow => 103,
    back_light_blue   => 104,
    back_light_purple => 105,
    back_light_cyan   => 106,
    back_white        => 107,
);

sub dye {
    my ($words, @color_letters) = @_;
    my @color_letter_set = map { $color_map{lc $_} } @color_letters;

    local $"= q(;);
    sprintf "\e[%sm%s\e[0m", "@color_letter_set" , $words ;
};

1;