Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
1066 lines (967 sloc) 32 KB
use strict;
use warnings;
our $VERSION = '0.4.0'; # c274f630aff9967
our %IRSSI = (
authors => 'Nei',
name => 'nickcolor_expando',
description => 'colourise nicks',
license => 'GPL v2',
);
# inspired by bc-bd's nm.pl and mrwright's nickcolor.pl
# Usage
# =====
# after loading the script, add the colour expando to the format
# (themes' abstracts are not supported)
#
# /format pubmsg {pubmsgnick $2 {pubnick $nickcolor$0}}$1
#
# alternatively, use it together with nm2 script
# Options
# =======
# /set neat_colors <list of colours>
# * the list of colours for automatic colouring (you can edit it more
# conveniently with /neatcolor colors)
#
# /set neat_ignorechars <regex>
# * regular expression of characters to remove from nick before
# calculating the hash function
#
# /set neat_color_reassign_time <time>
# * if the user has not spoken for so long, the assigned colour is
# forgotten and another colour may be picked next time the user
# speaks
#
# /set neat_global_colors <ON|OFF>
# * more strongly prefer one global colour per nickname regardless of
# channel
# Commands
# ========
# /neatcolor
# * show the current colour distribution of nicks
#
# /neatcolor set [<network>/<#channel>] <nick> <colour>
# * set a fixed colour for nick
#
# /neatcolor reset [<network>/<#channel>] <nick>
# * remove a set colour of nick
#
# /neatcolor get [<network>/<#channel>] <nick>
# * query the current or set colour of nick
#
# /neatcolor re [<network>/<#channel>] <nick>
# * force change the colour of nick to a random other colour (to
# manually resolve clashes)
#
# /neatcolor save
# * save the colours to ~/.irssi/saved_nick_colors
#
# /neatcolor reset --all
# * re-set all colours
#
# /neatcolor colors
# * show currently configured colours, in colour
#
# /neatcolor colors add <list of colours>
# /neatcolor colors remove <list of colours>
# * add or remove these colours from the neat_colors setting
sub cmd_help_neatcolor {
print CLIENTCRAP <<HELP
%9Syntax:%9
NEATCOLOR
NEATCOLOR SET [<network>/<#channel>] <nick> <colour>
NEATCOLOR RESET [<network>/<#channel>] <nick>
NEATCOLOR GET [<network>/<#channel>] <nick>
NEATCOLOR RE [<network>/<#channel>] <nick>
NEATCOLOR SAVE
NEATCOLOR RESET --all
NEATCOLOR COLORS
NEATCOLOR COLORS ADD <list of colours>
NEATCOLOR COLORS REMOVE <list of colours>
%9Parameters:%9
SET: set a fixed colour for nick
RESET: remove a set colour of nick
GET: query the current or set colour of nick
RE: force change the colour of nick to a random other
colour (to manually resolve clashes)
SAVE: save the colours to ~/.irssi/saved_nick_colors
RESET --all: re-set all colours
COLORS: show currently configured colours, in colour
COLORS ADD/REMOVE: add or remove these colours from the
neat_colors setting
If no parameters are given, the current colour distribution of
nicks is shown.
%9Description:%9
Manages nick based colouring
HELP
}
use Hash::Util qw(lock_keys);
use Irssi;
{ package Irssi::Nick }
my @action_protos = qw(irc silc xmpp);
my (%set_colour, %avoid_colour, %has_colour, %last_time, %netchan_hist);
my ($expando, $iexpando, $ignore_re, $ignore_setting, $global_colours, $retain_colour_time, @colours, $exited, $session_load_time);
($expando, $iexpando) = ('', ''); # Initialise to empty
# the numbers for the scoring system, highest colour value will be chosen
my %scores = (
set => 200,
keep => 5,
global => 4,
hash => 3,
avoid => -20,
hist => -10,
used => -2,
);
lock_keys(%scores);
my $history_lines = 40;
my $global_mode = 1; # start out with global nick colour
my @colour_bags = (
[qw[20 30 40 50 04 66 0C 61 60 67 6L]], # RED
[qw[37 3D 36 4C 46 5C 56 6C 6J 47 5D 6K 6D 57 6E 5E 4E 4K 4J 5J 4D 5K 6R]], # ORANGE
[qw[3C 4I 5I 6O 6I 06 4O 5O 3U 0E 5U 6U 6V 6P 6Q 6W 5P 4P 4V 4W 5W 4Q 5Q 5R 6Y 6X]], # YELLOW
[qw[26 2D 2C 3I 3O 4U 5V 2J 3V 3P 3J 5X]], # YELLOW-GREEN
[qw[16 1C 2I 2U 2O 1I 1O 1V 1P 02 0A 1U 2V 4X]], # GREEN
[qw[1D 1J 1Q 1W 1X 2Y 2S 2R 3Y 3Z 3S 3R 2K 3K 4S 5Z 5Y 4R 3Q 2Q 2X 2W 3X 3W 2P 4Y]], # GREEN-TURQUOIS
[qw[17 1E 1L 1K 1R 1S 03 1M 1N 1T 0B 1Y 1Z 2Z 4Z]], # TURQUOIS
[qw[28 2E 18 1F 19 1G 1A 1B 1H 2N 2H 09 3H 3N 2T 3T 2M 2G 2A 2F 2L 3L 3F 4M 3M 3G 29 4T 5T]], # LIGHT-BLUE
[qw[11 12 23 25 24 13 14 01 15 2B 4N]], # DARK-BLUE
[qw[22 33 44 0D 45 5B 6A 5A 5H 3B 4H 3A 4G 39 4F 6S 6T 5L 5N]], # VIOLET
[qw[21 32 42 53 63 52 43 34 35 55 65 6B 4B 4A 48 5G 6H 5M 6M 6N]], # PINK
[qw[38 31 05 64 54 41 51 62 69 68 59 5F 6F 58 49 6G]], # ROSE
[qw[7A 00 10 7B 7C 7D 7E 7G 7F]], # DARK-GRAY
[qw[7H 7I 27 7K 7J 08 7L 3E 7O 7Q 7N 7M 7P]], # GRAY
[qw[7S 7T 7R 4L 7W 7U 7V 5S 07 7X 6Z 0F]], # LIGHT-GRAY
);
my %colour_bags;
{ my $idx = 0;
for my $bag (@colour_bags) {
@colour_bags{ @$bag } = ($idx)x@$bag;
}
continue {
++$idx;
}
}
my @colour_list = map { @$_ } @colour_bags;
my @bases = split //, 'kbgcrmywKBGCRMYW04261537';
my %base_map = map { $bases[$_] => sprintf '%02X', ($_ % 0x10) } 0..$#bases;
my %ext_to_base_map = map { (sprintf '%02X', $_) => $bases[$_] } 0..15;
sub expando_neatcolour {
return $expando;
}
sub expando_neatcolour_inv {
return $iexpando;
}
# one-at-a-time hash
sub simple_hash {
use integer;
my $hash = 0x5065526c + length $_[0];
for my $ord (unpack 'U*', $_[0]) {
$hash += $ord;
$hash += $hash << 10;
$hash &= 0xffffffff;
$hash ^= $hash >> 6;
}
$hash += $hash << 3;
$hash &= 0xffffffff;
$hash ^= $hash >> 11;
$hash = $hash + ($hash << 15);
$hash &= 0xffffffff;
}
{ my %lut1;
my @z = (0 .. 9, 'A' .. 'Z');
for my $x (16..255) {
my $idx = $x - 16;
my $col = 1+int($idx / @z);
$lut1{ $col . @z[(($col > 6 ? 10 : 0) + $idx) % @z] } = $x;
}
for my $idx (0..15) {
$lut1{ (sprintf "%02X", $idx) } = ($idx&8) | ($idx&4)>>2 | ($idx&2) | ($idx&1)<<2;
}
sub debug_ansicolour {
my ($col, $bg) = @_;
return '' unless defined $col && exists $lut1{$col};
$bg = $bg ? 48 : 38;
"\e[$bg;5;$lut1{$col}m"
}
}
sub debug_colour {
my ($col, $bg) = @_;
defined $col ? (debug_ansicolour($col, $bg) . $col . "\e[0m") : '(none)'
}
sub debug_score {
my ($score) = @_;
if ($score == 0) {
return $score
}
my @scale = $score > 0 ? (qw(16 1C 1I 1U 2V 4X)) : (qw(20 30 40 60 67 6L));;
my $v = (log 1+ abs $score)*(log 20);
debug_ansicolour($scale[$v >= $#scale ? -1 : $v], 1) . $score . "\e[0m"
}
sub debug_reused {
my ($netchan, $nick, $col) = @_;
my $chc = simple_hash($netchan);
my $hashcolour = @colours ? $colours[ $chc % @colours ] : 0;
}
sub debug_scores {
my ($netchan, $nick, $col, $prios, $colours) = @_;
my $inprogress;
unless (ref $prios) {
$inprogress = $prios;
$prios = [ sort { $colours->{$b} <=> $colours->{$a} } grep { exists $colours->{$_} } @colour_list ];
}
my $chc = simple_hash($netchan);
my $hashcolour = @colours ? $colours[ $chc % @colours ] : 0;
unless ($inprogress) {
}
else {
}
for my $i (0..$#$prios) {
}
}
sub colourise_nt {
my ($netchan, $nick, $weak) = @_;
my $time = time;
my $g_or_n = $global_colours ? '' : $netchan;
my $old_colour = $has_colour{$g_or_n}{$nick} // $has_colour{$netchan}{$nick};
my $last_time = $last_time{$g_or_n}{$nick} // $last_time{$netchan}{$nick};
my $keep_score = $weak ? $scores{keep} + $scores{set} : $scores{keep};
unless ($weak) {
$last_time{$netchan}{$nick}
= $last_time{''}{$nick} = $time;
}
else {
$last_time{$netchan}{$nick} ||= 0;
}
my $colour;
if (defined $old_colour && ($weak || (defined $last_time
&& ($last_time + $retain_colour_time > $time
|| ($last_time > 0 && grep { $_->[0] eq $nick } @{ $netchan_hist{$netchan} // [] }))))) {
$colour = $old_colour;
}
else {
# search for a suitable colour
my %colours = map { $_ => 0 } @colours;
my $hashnick = $nick;
$hashnick =~ s/$ignore_re//g if (defined $ignore_re && length $ignore_re);
my $hash = simple_hash($global_mode ? "/$hashnick" : "$netchan/$hashnick");
if (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$nick}) {
$colours{ $set_colour{$netchan}{$nick} } += $scores{set};
}
elsif (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$hashnick}) {
$colours{ $set_colour{$netchan}{$hashnick} } += $scores{set};
}
elsif (exists $set_colour{''} && exists $set_colour{''}{$nick}) {
$colours{ $set_colour{''}{$nick} } += $scores{set};
}
elsif (exists $set_colour{''} && exists $set_colour{''}{$hashnick}) {
$colours{ $set_colour{''}{$hashnick} } += $scores{set};
}
if (exists $avoid_colour{$netchan} && exists $avoid_colour{$netchan}{$nick}) {
for (@{ $avoid_colour{$netchan}{$nick} }) {
$colours{ $_ } += $scores{avoid} if exists $colours{ $_ };
}
}
elsif (exists $avoid_colour{$g_or_n} && exists $avoid_colour{$g_or_n}{$nick}) {
for (@{ $avoid_colour{$g_or_n}{$nick} }) {
$colours{ $_ } += $scores{avoid} if exists $colours{ $_ };
}
}
if (defined $old_colour) {
$colours{$old_colour} += $keep_score
if exists $colours{$old_colour};
}
elsif (exists $has_colour{''}{$nick}) {
$colours{ $has_colour{''}{$nick} } += $scores{global}
if exists $colours{ $has_colour{''}{$nick} };
}
if (@colours) {
my $hashcolour = $colours[ $hash % @colours ];
if (!defined $old_colour || $hashcolour ne $old_colour) {
$colours{ $hashcolour } += $scores{hash};
}
}
{ my @netchans = $global_mode ? keys %has_colour : $netchan;
my $total;
my %colour_pens;
for my $gnc (@netchans) {
for my $onick (keys %{ $has_colour{$gnc} }) {
next if $gnc ne $netchan && exists $has_colour{$netchan}{$onick};
next unless exists $last_time{$gnc}{$onick};
if ($last_time{$gnc}{$onick} + $retain_colour_time > $time # XXX
|| ($last_time{$gnc}{$onick} == 0 && $session_load_time + $retain_colour_time > $time)) {
if (exists $colours{ $has_colour{$gnc}{$onick} }) {
$colour_pens{ $has_colour{$gnc}{$onick} } += $scores{used};
++$total;
}
}
}
}
for (keys %colour_pens) {
$colours{ $_ } += $colour_pens{ $_ } / $total * @colours
if @colours;
}
}
{ my $fac = 1;
for my $gnetchan ($netchan, '') {
my $idx = exp(-log($history_lines)/$scores{hist});
for my $hent (reverse @{ $netchan_hist{$gnetchan} // [] }) {
next unless defined $hent->[1];
if ($hent->[0] ne $nick) {
my $pen = 1;
$pen *= 3 if length $nick == length $hent->[0];
$pen *= 2 if (substr $nick, 0, 1) eq (substr $hent->[0], 0, 1)
|| 1 == abs +(length $nick) - (length $hent->[0]);
$colours{ $hent->[1] } -= log($pen*$history_lines)/log($idx) / $fac
if exists $colours{ $hent->[1] };
}
++$idx;
last if $idx > $history_lines;
}
++$fac;
}
}
{ my %bag_pens;
for my $co (keys %colours) {
$bag_pens{ $colour_bags{$co} } -= $colours{$co}/2 if $colours{$co} < 0;
}
for my $bag (keys %bag_pens) {
for my $co (@{ $colour_bags[$bag] }) {
$colours{$co} -= $bag_pens{$bag} / @colours
if @colours && exists $colours{$co};
}
}
}
my @prio_colours = sort { $colours{$b} <=> $colours{$a} } grep { exists $colours{$_} } @colour_list;
my $stop_at = 0;
while ($stop_at < $#prio_colours
&& $colours{ $prio_colours[$stop_at] } <= $colours{ $prio_colours[$stop_at + 1] }) {
++$stop_at;
}
$colour = $prio_colours[ $hash % ($stop_at + 1) ]
if @prio_colours;
}
unless ($weak) {
expire_hist($netchan, '');
my $ent = [$nick, $colour];
push @{ $netchan_hist{$netchan} }, $ent;
push @{ $netchan_hist{''} }, $ent;
}
defined $colour ? ($has_colour{$g_or_n}{$nick} = $has_colour{$netchan}{$nick} = $colour) : $colour
}
sub expire_hist {
for my $ch (@_) {
if ($netchan_hist{$ch}
&& @{$netchan_hist{$ch}} > 2 * $history_lines) {
splice @{$netchan_hist{$ch}}, 0, $history_lines;
}
}
}
sub msg_line_tag {
my ($srv, $msg, $nick, $addr, $targ) = @_;
my $obj = $srv->channel_find($targ);
clear_ref(), return unless $obj;
my $nickobj = $obj->nick_find($nick);
$nick = $nickobj->{nick} if $nickobj;
my $colour = colourise_nt($srv->{tag}.'/'.$obj->{name}, $nick);
$expando = $colour ? format_expand('%X'.$colour) : '';
$iexpando = $colour ? format_expand('%x'.$colour) : '';
}
sub msg_line_tag_xmppaction {
clear_ref(), return unless @_;
my ($srv, $msg, $nick, $targ) = @_;
msg_line_tag($srv, $msg, $nick, undef, $targ);
}
sub msg_line_clear {
clear_ref();
}
sub prnt_clear_public {
my ($dest) = @_;
clear_ref() if $dest->{level} & MSGLEVEL_PUBLIC;
}
sub clear_ref {
$expando = '';
$iexpando = '';
}
sub nicklist_changed {
my ($chanobj, $nickobj, $old_nick) = @_;
my $netchan = $chanobj->{server}{tag}.'/'.$chanobj->{name};
my $nickstr = $nickobj->{nick};
if (!exists $has_colour{''}{$nickstr} && exists $has_colour{''}{$old_nick}) {
$has_colour{''}{$nickstr} = delete $has_colour{''}{$old_nick};
}
if (exists $has_colour{$netchan}{$old_nick}) {
$has_colour{$netchan}{$nickstr} = delete $has_colour{$netchan}{$old_nick};
}
$last_time{$netchan}{$nickstr}
= $last_time{''}{$nickstr} = time;
for my $old_ent (@{ $netchan_hist{$netchan} }) {
$old_ent->[0] = $nickstr if $old_ent->[0] eq $old_nick;
}
}
{
my %format2control = (
'F' => "\cDa", '_' => "\cDc", '|' => "\cDe", '#' => "\cDi", "n" => "\cDg", "N" => "\cDg",
'U' => "\c_", '8' => "\cV", 'I' => "\cDf",
);
my %bg_base = (
'0' => '0', '4' => '1', '2' => '2', '6' => '3', '1' => '4', '5' => '5', '3' => '6', '7' => '7',
'x08' => '8', 'x09' => '9', 'x0a' => ':', 'x0b' => ';', 'x0c' => '<', 'x0d' => '=', 'x0e' => '>', 'x0f' => '?',
);
my %fg_base = (
'k' => '0', 'b' => '1', 'g' => '2', 'c' => '3', 'r' => '4', 'm' => '5', 'p' => '5', 'y' => '6', 'w' => '7',
'K' => '8', 'B' => '9', 'G' => ':', 'C' => ';', 'R' => '<', 'M' => '=', 'P' => '=', 'Y' => '>', 'W' => '?',
);
my @ext_colour_off = (
'.', '-', ',',
'+', "'", '&',
);
sub format_expand {
my $copy = $_[0];
$copy =~ s{%(Z.{6}|z.{6}|X..|x..|.)}{
my $c = $1;
if (exists $format2control{$c}) {
$format2control{$c}
}
elsif (exists $bg_base{$c}) {
"\cD/$bg_base{$c}"
}
elsif (exists $fg_base{$c}) {
"\cD$fg_base{$c}/"
}
elsif ($c =~ /^[{}%]$/) {
$c
}
elsif ($c =~ /^(z|Z)([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})$/) {
my $bg = $1 eq 'z';
my (@rgb) = map { hex $_ } $2, $3, $4;
my $x = $bg ? 0x1 : 0;
my $out = "\cD" . (chr -13 + ord '0');
for (my $i = 0; $i < 3; ++$i) {
if ($rgb[$i] > 0x20) {
$out .= chr $rgb[$i];
}
else {
$x |= 0x10 << $i; $out .= chr 0x20 + $rgb[$i];
}
}
$out .= chr 0x20 + $x;
$out
}
elsif ($c =~ /^(x)(?:0([[:xdigit:]])|([1-6])(?:([0-9])|([a-z]))|7([a-x]))$/i) {
my $bg = $1 eq 'x';
my $col = defined $2 ? hex $2
: defined $6 ? 232 + (ord lc $6) - (ord 'a')
: 16 + 36 * ($3 - 1) + (defined $4 ? $4 : 10 + (ord lc $5) - (ord 'a'));
if ($col < 0x10) {
my $chr = chr $col + ord '0';
"\cD" . ($bg ? "/$chr" : "$chr/")
}
else {
"\cD" . $ext_colour_off[($col - 0x10) / 0x50 + $bg * 3] . chr (($col - 0x10) % 0x50 - 1 + ord '0')
}
}
else {
"%$c"
}
}ge;
$copy
}
}
sub save_colours {
open my $fid, '>', Irssi::get_irssi_dir() . '/saved_nick_colors'
or do {
Irssi::print("Error saving nick colours: $!", MSGLEVEL_CLIENTERROR)
unless $exited;
return;
};
local $\ = "\n";
if (%set_colour) {
print $fid '[set]';
for my $netch (sort keys %set_colour) {
for my $nick (sort keys %{ $set_colour{$netch} }) {
print $fid "$netch/$nick:".$set_colour{$netch}{$nick};
}
}
print $fid '';
}
my $time = time;
print $fid '[session]';
my %session_colour;
for my $netch (sort keys %last_time) {
for my $nick (sort keys %{ $last_time{$netch} }) {
if (exists $has_colour{$netch} && exists $has_colour{$netch}{$nick}
&& ($last_time{$netch}{$nick} + $retain_colour_time > $time
|| ($last_time{$netch}{$nick} == 0 && $session_load_time + $retain_colour_time > $time)
|| grep { $_->[0] eq $nick } @{ $netchan_hist{$netch} // [] })) {
$session_colour{$netch}{$nick} = $has_colour{$netch}{$nick};
if (exists $session_colour{''}{$nick}) {
if (defined $session_colour{''}{$nick}
&& $session_colour{''}{$nick} ne $session_colour{$netch}{$nick}) {
$session_colour{''}{$nick} = undef;
}
}
else {
$session_colour{''}{$nick} = $session_colour{$netch}{$nick};
}
}
}
}
for my $nick (sort keys %{ $session_colour{''} }) {
if (defined $session_colour{''}{$nick}) {
print $fid "/$nick:".$session_colour{''}{$nick};
}
else {
for my $netch (sort keys %session_colour) {
print $fid "$netch/$nick:".$session_colour{$netch}{$nick}
if exists $session_colour{$netch}{$nick} && defined $session_colour{$netch}{$nick};
}
}
}
close $fid;
}
sub load_colours {
$session_load_time = time;
open my $fid, '<', Irssi::get_irssi_dir() . '/saved_nick_colors'
or return;
my $mode;
while (my $line = <$fid>) {
chomp $line;
if ($line =~ /^\[(.*)\]$/) {
$mode = $1;
next;
}
my $colon = rindex $line, ':';
next if $colon < 0;
my $slash = rindex $line, '/', $colon;
next if $slash < 0;
my $col = substr $line, $colon +1;
next unless length $col;
my $netch = substr $line, 0, $slash;
my $nick = substr $line, $slash +1, $colon-$slash -1;
if ($mode eq 'set') {
$set_colour{$netch}{$nick} = $col;
}
elsif ($mode eq 'session') {
$has_colour{$netch}{$nick} = $col;
$last_time{$netch}{$nick} = 0;
}
}
close $fid;
}
sub UNLOAD {
return if $exited;
exit_save();
}
sub exit_save {
$exited = 1;
save_colours() if Irssi::settings_get_bool('settings_autosave');
}
sub get_nick_color2 {
my ($tag, $chan, $nick, $format) = @_;
my $col = colourise_nt($tag.'/'.$chan, $nick, 1);
$col ? $format ? format_expand('%X'.$col) : $col : ''
}
sub _cmd_colours_check {
my ($add, $data) = @_;
my @to_check = grep { defined && length } map {
length == 1 ? $base_map{$_}
: length == 3 ? substr $_, 1
: $_ } map { /(?|x(..)|([0-7].)|(.))/gi }
split ' ', $data;
my @valid;
my %scolours = map { $_ => undef } @colours;
for my $c (@to_check) {
if ((grep { $_ eq $c } @colour_list)) {
if ($add) { next if exists $scolours{$c} }
else { next if !exists $scolours{$c} }
push @valid, $c;
if ($add) { $scolours{$c} = undef; }
else { delete $scolours{$c}; }
}
}
(\@valid, \%scolours)
}
sub _cmd_colours_set {
my $scolours = shift;
Irssi::settings_set_str('neat_colors', join '', map { $ext_to_base_map{$_} // "X$_" } grep { exists $scolours->{$_} } @colour_list);
}
sub _cmd_colours_list {
map { "%X$_".($ext_to_base_map{$_} // "X$_").'%n' } @{+shift}
}
sub cmd_neatcolor_colors_add {
my ($data, $server, $witem) = @_;
my ($added, $scolours) = _cmd_colours_check(1, $data);
if (@$added) {
_cmd_colours_set($scolours);
Irssi::print("%_nce2%_: added @{[ _cmd_colours_list($added) ]} to neat_colors", MSGLEVEL_CLIENTCRAP);
setup_changed();
}
else {
Irssi::print("%_nce2%_: nothing added", MSGLEVEL_CLIENTCRAP);
}
}
sub cmd_neatcolor_colors_remove {
my ($data, $server, $witem) = @_;
my ($removed, $scolours) = _cmd_colours_check(0, $data);
if (@$removed) {
_cmd_colours_set($scolours);
Irssi::print("%_nce2%_: removed @{[ _cmd_colours_list($removed) ]} from neat_colors", MSGLEVEL_CLIENTCRAP);
setup_changed();
}
else {
Irssi::print("%_nce2%_: nothing removed", MSGLEVEL_CLIENTCRAP);
}
}
sub cmd_neatcolor_colors {
my ($data, $server, $witem) = @_;
$data =~ s/\s+$//;
unless (length $data) {
Irssi::print("%_nce2%_: current colours: @{[ @colours ? _cmd_colours_list(\@colours) : '(none)' ]}");
}
Irssi::command_runsub('neatcolor colors', $data, $server, $witem);
}
sub cmd_neatcolor {
my ($data, $server, $witem) = @_;
$data =~ s/\s+$//;
unless (length $data) {
$witem ||= Irssi::active_win;
my $time = time;
my %distribution = map { $_ => 0 } @colours;
for my $netch (keys %has_colour) {
next unless length $netch;
for my $nick (keys %{ $has_colour{$netch} }) {
if (exists $last_time{$netch}{$nick}
&& ($last_time{$netch}{$nick} + $retain_colour_time > $time
|| grep { $_->[0] eq $nick } @{ $netchan_hist{$netch} // [] })) {
$distribution{ $has_colour{$netch}{$nick} }++
}
}
}
$witem->print('%_nce2%_ Colour distribution: '.
(join ', ',
map { "%X$_$_:$distribution{$_}" }
sort { $distribution{$b} <=> $distribution{$a} }
grep { exists $distribution{$_} } @colour_list), MSGLEVEL_CLIENTCRAP);
}
Irssi::command_runsub('neatcolor', $data, $server, $witem);
}
sub _cmd_check_netchan_arg {
my ($cmd, $netchan, $nick) = @_;
my %global = map { $_ => undef } qw(set get reset);
unless (length $netchan) {
Irssi::print('%_nce2%_: no network/channel argument given for neatcolor '.$cmd
.(exists $global{$cmd} ? ', use / to '.$cmd.' global colours' : ''),
MSGLEVEL_CLIENTERROR);
return;
}
elsif (-1 == index $netchan, '/') {
Irssi::print('%_nce2%_: missing network/ in argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
return;
}
elsif ($netchan =~ m\^[^/]+/$\) {
Irssi::print('%_nce2%_: missing /channel in argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
return;
}
unless (length $nick) {
Irssi::print('%_nce2%_: no nick argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
return;
}
elsif (-1 != index $nick, '/') {
Irssi::print('%_nce2%_: / not supported in nicks in argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
return;
}
return 1;
}
sub _cmd_check_colour {
my ($cmd, $colour) = @_;
$colour = substr $colour, 1 if length $colour == 3;
$colour = $base_map{$colour} if length $colour == 1;
unless (length $colour && grep { $_ eq $colour } @colour_list) {
Irssi::print('%_nce2%_: no colour or invalid colour argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
return;
}
return $colour;
}
sub cmd_neatcolor_set {
my ($data, $server, $witem) = @_;
my @args = split ' ', $data;
if (@args < 2) {
Irssi::print('%_nce2%_: not enough arguments for neatcolor set', MSGLEVEL_CLIENTERROR);
return;
}
my $netchan;
if (ref $witem) {
$netchan = $witem->{server}{tag}.'/'.$witem->{name};
}
my $nick;
my $colour;
if (@args < 3) {
($nick, $colour) = @args;
}
else {
($netchan, $nick, $colour) = @args;
}
return unless _cmd_check_netchan_arg('set', $netchan, $nick);
return unless defined ($colour = _cmd_check_colour('set', $colour));
$set_colour{$netchan eq '/' ? '' : $netchan}{$nick} = $colour;
for my $netch ($netchan eq '/' ? keys %has_colour
: $global_colours ? ('', $netchan)
: $netchan) {
delete $has_colour{$netch}{$nick} unless
exists $has_colour{$netch}{$nick} && $has_colour{$netch}{$nick} eq $colour;
}
Irssi::print("%_nce2%_: %X$colour$nick%n colour set to: %X$colour$colour%n ".($netchan eq '/' ? 'globally' : "in $netchan"), MSGLEVEL_CLIENTCRAP);
}
sub cmd_neatcolor_get {
my ($data, $server, $witem) = @_;
my @args = split ' ', $data;
if (@args < 1) {
Irssi::print('%_nce2%_: not enough arguments for neatcolor get', MSGLEVEL_CLIENTERROR);
return;
}
my $netchan;
if (ref $witem) {
$netchan = $witem->{server}{tag}.'/'.$witem->{name};
}
my $nick;
if (@args < 2) {
$nick = $args[0];
}
else {
($netchan, $nick) = @args;
}
return unless _cmd_check_netchan_arg('get', $netchan, $nick);
if ($netchan ne '/') {
unless (exists $has_colour{$netchan} && exists $has_colour{$netchan}{$nick}) {
Irssi::print("%_nce2%_: $nick is not coloured (yet) in $netchan", MSGLEVEL_CLIENTCRAP);
}
else {
my $colour = $has_colour{$netchan}{$nick};
Irssi::print("%_nce2%_: %X$colour$nick%n has colour: %X$colour$colour%n in $netchan", MSGLEVEL_CLIENTCRAP);
}
}
my $hashnick = $nick;
$hashnick =~ s/$ignore_re//g if (defined $ignore_re && length $ignore_re);
if (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$nick}) {
my $colour = $set_colour{$netchan}{$nick};
Irssi::print("%_nce2%_: set colour for %X$colour$nick%n in $netchan: %X$colour$colour%n ", MSGLEVEL_CLIENTCRAP);
}
elsif (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$hashnick}) {
my $colour = $set_colour{$netchan}{$hashnick};
Irssi::print("%_nce2%_: set colour for %X$colour$hashnick%n in $netchan: %X$colour$colour%n ", MSGLEVEL_CLIENTCRAP);
}
elsif (exists $set_colour{''} && exists $set_colour{''}{$nick}) {
my $colour = $set_colour{''}{$nick};
Irssi::print("%_nce2%_: set colour for %X$colour$nick%n (global): %X$colour$colour%n ", MSGLEVEL_CLIENTCRAP);
}
elsif (exists $set_colour{''} && exists $set_colour{''}{$hashnick}) {
my $colour = $set_colour{''}{$hashnick};
Irssi::print("%_nce2%_: set colour for %X$colour$hashnick%n (global): %X$colour$colour%n ", MSGLEVEL_CLIENTCRAP);
}
elsif ($netchan eq '/') {
Irssi::print("%_nce2%_: no global colour set for $nick", MSGLEVEL_CLIENTCRAP);
}
}
sub cmd_neatcolor_reset {
my ($data, $server, $witem) = @_;
my @args = split ' ', $data;
if (@args < 1) {
Irssi::print('%_nce2%_: not enough arguments for neatcolor reset', MSGLEVEL_CLIENTERROR);
return;
}
my $netchan;
if (ref $witem) {
$netchan = $witem->{server}{tag}.'/'.$witem->{name};
}
my $nick;
if (@args == 1 && $args[0] eq '--all') {
%set_colour = %avoid_colour = %has_colour = ();
Irssi::print("%_nce2%_: re-set all colouring");
return;
}
if (@args < 2) {
$nick = $args[0];
}
else {
($netchan, $nick) = @args;
}
return unless _cmd_check_netchan_arg('reset', $netchan, $nick);
$netchan = '' if $netchan eq '/';
unless (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$nick}) {
Irssi::print("%_nce2%_: $nick has no colour set ". (length $netchan ? "in $netchan" : "globally"), MSGLEVEL_CLIENTERROR);
return;
}
my $colour = delete $set_colour{$netchan}{$nick};
for my $netch ($netchan eq '' ? keys %has_colour
: $global_colours ? ('', $netchan)
: $netchan) {
delete $has_colour{$netch}{$nick} if exists $has_colour{$netch} && exists $has_colour{$netch}{$nick}
&& $has_colour{$netch}{$nick} eq $colour;
}
Irssi::print("%_nce2%_: ".($netchan eq '' ? 'global ' : '')."colouring re-set for $nick".($netchan eq '' ? '' : " in $netchan"), MSGLEVEL_CLIENTERROR);
}
sub cmd_neatcolor_re {
my ($data, $server, $witem) = @_;
my @args = split ' ', $data;
if (@args < 1) {
Irssi::print('%_nce2%_: not enough arguments for neatcolor re', MSGLEVEL_CLIENTERROR);
return;
}
my $netchan;
if (ref $witem) {
$netchan = $witem->{server}{tag}.'/'.$witem->{name};
}
my $nick;
if (@args < 2) {
$nick = $args[0];
}
else {
($netchan, $nick) = @args;
}
return unless _cmd_check_netchan_arg('re', $netchan, $nick);
unless (exists $has_colour{$netchan} && exists $has_colour{$netchan}{$nick}) {
Irssi::print("%_nce2%_: could not find $nick in $netchan", MSGLEVEL_CLIENTERROR);
return;
}
my $colour = delete $has_colour{$netchan}{$nick};
if (grep { $colour eq $_ } @{ $avoid_colour{$netchan}{$nick} || [] }) {
$avoid_colour{$netchan}{$nick} = [ $colour ]
}
else {
push @{ $avoid_colour{$netchan}{$nick} }, $colour;
}
if ($global_colours) {
delete $has_colour{''}{$nick} if defined $colour;
if (grep { $colour eq $_ } @{ $avoid_colour{''}{$nick} || [] }) {
$avoid_colour{''}{$nick} = [ $colour ]
}
else {
push @{ $avoid_colour{''}{$nick} }, $colour;
}
}
Irssi::print("%_nce2%_: re-colouring $nick in $netchan", MSGLEVEL_CLIENTERROR);
}
sub cmd_neatcolor_save {
Irssi::print("%_nce2%_: saving colours to file", MSGLEVEL_CLIENTCRAP);
save_colours();
}
sub setup_changed {
$global_colours = Irssi::settings_get_bool('neat_global_colors');
$retain_colour_time = int( abs( Irssi::settings_get_time('neat_color_reassign_time') ) / 1000 );
my $old_ignore = $ignore_setting // '';
$ignore_setting = Irssi::settings_get_str('neat_ignorechars');
if ($old_ignore ne $ignore_setting) {
local $@;
eval { $ignore_re = qr/$ignore_setting/ };
if ($@) {
$@ =~ /^(.*)/;
print '%_neat_ignorechars%_ did not compile: '.$1;
}
}
my $old_colours = "@colours";
my %scolours = map { ($base_map{$_} // $_) => undef } Irssi::settings_get_str('neat_colors') =~ /(?|x(..)|(.))/ig;
@colours = grep { exists $scolours{$_} } @colour_list;
if ($old_colours ne "@colours") {
my $time = time;
for my $netch (sort keys %last_time) {
for my $nick (sort keys %{ $last_time{$netch} }) {
if (exists $has_colour{$netch} && exists $has_colour{$netch}{$nick}) {
if ($last_time{$netch}{$nick} + $retain_colour_time > $time
|| ($last_time{$netch}{$nick} == 0 && $session_load_time + $retain_colour_time > $time)) {
$last_time{$netch}{$nick} = 0;
}
else {
delete $last_time{$netch}{$nick};
}
}
}
$session_load_time = $time;
}
}
}
sub internals {
+{
set => \%set_colour,
avoid => \%avoid_colour,
has => \%has_colour,
time => \%last_time,
hist => \%netchan_hist,
colours => \@colours
}
}
sub init_nickcolour {
setup_changed();
load_colours();
}
Irssi::settings_add_str('misc', 'neat_colors', 'rRgGybBmMcCX42X3AX5EX4NX3HX3CX32');
Irssi::settings_add_str('misc', 'neat_ignorechars', '');
Irssi::settings_add_time('misc', 'neat_color_reassign_time', '30min');
Irssi::settings_add_bool('misc', 'neat_global_colors', 0);
init_nickcolour();
Irssi::expando_create('nickcolor', \&expando_neatcolour, {
'message public' => 'none',
'message own_public' => 'none',
(map { ("message $_ action" => 'none',
"message $_ own_action" => 'none')
} @action_protos),
});
Irssi::expando_create('inickcolor', \&expando_neatcolour_inv, {
'message public' => 'none',
'message own_public' => 'none',
(map { ("message $_ action" => 'none',
"message $_ own_action" => 'none')
} @action_protos),
});
Irssi::signal_add({
'message public' => 'msg_line_tag',
'message own_public' => 'msg_line_clear',
(map { ("message $_ action" => 'msg_line_tag',
"message $_ own_action" => 'msg_line_clear')
} qw(irc silc)),
"message xmpp action" => 'msg_line_tag_xmppaction',
"message xmpp own_action" => 'msg_line_clear',
'print text' => 'prnt_clear_public',
'nicklist changed' => 'nicklist_changed',
'gui exit' => 'exit_save',
});
Irssi::command_bind({
'help' => sub { &cmd_help_neatcolor if $_[0] =~ /^neatcolor\s*$/i;},
'neatcolor' => 'cmd_neatcolor',
'neatcolor save' => 'cmd_neatcolor_save',
'neatcolor set' => 'cmd_neatcolor_set',
'neatcolor get' => 'cmd_neatcolor_get',
'neatcolor reset' => 'cmd_neatcolor_reset',
'neatcolor re' => 'cmd_neatcolor_re',
'neatcolor colors' => 'cmd_neatcolor_colors',
'neatcolor colors add' => 'cmd_neatcolor_colors_add',
'neatcolor colors remove' => 'cmd_neatcolor_colors_remove',
});
Irssi::signal_add_last('setup changed' => 'setup_changed');
# Changelog
# =========
# 0.4.0
# - Allow usage of the colour as a background (using $inickcolor)
# 0.3.7
# - fix crash if xmpp action signal is not registered (just ignore it)
# 0.3.6
# - also look up ignorechars in set colours
# 0.3.5
# - bug fix release
# 0.3.4
# - re/set/reset-colouring was affected by the global colour
# - set colour score too weak
# 0.3.3
# - fix error with get / reported by Meicceli
# - now possible to reset global colour
# - check for invalid colours
# 0.3.2
# - add global colour option
# - respect save settings setting
# - add action handling
# 0.3.1
# - regression: reset colours after removing colour
# 0.3.0
# - save some more colours
# 0.2.9
# - fix incorrect calculation of used colours
# - add some sanity checks to set/get command
# - avoid random colour changes