dim_nicks.pl

   1 use strict;
   2 use warnings;
   3
   4 our $VERSION = '0.4.8'; # baf75f08d3d32c9
   5 our %IRSSI = (
   6     authors     => 'Nei',
   7     contact     => 'Nei @ anti@conference.jabber.teamidiot.de',
   8     url         => "http://anti.teamidiot.de/",
   9     name        => 'dim_nicks',
  10     description => 'Dims nicks that are not in channel anymore.',
  11     license     => 'GNU GPLv2 or later',
  12    );
  13
  14 # Usage
  15 # =====
  16 # Once loaded, this script will record the nicks of each new
  17 # message. If the user leaves the room, the messages will be rewritten
  18 # with the nick in another colour/style.
  19 #
  20 # Depending on your theme, tweaking the forms settings may be
  21 # necessary. With the default irssi theme, this script should just
  22 # work.
  23
  24 # Options
  25 # =======
  26 # /set dim_nicks_color <colour>
  27 # * the colour code to use for dimming the nick, or a string of format
  28 #   codes with the special token $* in place of the nick (e.g. %I$*%I
  29 #   for italic)
  30 #
  31 # /set dim_nicks_history_lines <num>
  32 # * only this many lines of messages are remembered/rewritten (per
  33 #   window)
  34 #
  35 # /set dim_nicks_ignore_hilights <ON|OFF>
  36 # * ignore lines with hilight when dimming
  37 #
  38 # /set dim_nicks_forms_skip <num>
  39 # /set dim_nicks_forms_search_max <num>
  40 # * these two settings limit the range where to search for the
  41 #   nick.
  42 #   It sets how many forms (blocks of irssi format codes or
  43 #   non-letters) to skip at the beginning of line before starting to
  44 #   search for the nick, and from then on how many forms to search
  45 #   before stopping.
  46 #   You should set this to the appropriate values to avoid (a) dimming
  47 #   your timestamp (b) dimming message content instead of the nick.
  48 #   To check your settings, you can use the command
  49 #     /script exec Irssi::Script::dim_nicks::debug_forms
  50
  51
  52 no warnings 'redefine';
  53 use constant IN_IRSSI => __PACKAGE__ ne 'main' || $ENV{IRSSI_MOCK};
  54 use Irssi 20140701;
  55 use Irssi::TextUI;
  56 use Encode;
  57
  58
  59 sub setc () {
  60     $IRSSI{name}
  61 }
  62
  63 sub set ($) {
  64     setc . '_' . $_[0]
  65 }
  66
  67 my $history_lines = 100;
  68 my $skip_forms = 1;
  69 my $search_forms_max = 5;
  70 my $ignore_hilights = 1;
  71 my $color_letter = 'K';
  72
  73 # nick object cache, chan object cache, line id cache, line id -> window map, -> channel, -> nick, -> nickname, channel -> line ids, channel->nickname->departure time, channel->nickname->{parts of line}
  74 my (%nick_reg, %chan_reg, %history_w, %history_c, %history_n, %history_nn, %history_st, %lost_nicks, %lost_nicks_fs, %lost_nicks_fc, %lost_nicks_bc, %lost_nicks_bs);
  75
  76 our ($dest, $chanref, $nickref);
  77
  78
  79 sub msg_line_tag {
  80     my ($srv, $msg, $nick, $addr, $targ) = @_;
  81     local $chanref = $srv->channel_find($targ);
  82     local $nickref = ref $chanref ? $chanref->nick_find($nick) : undef;
  83     &Irssi::signal_continue;
  84 }
  85
  86 my @color_code;
  87
  88 sub color_to_code {
  89     my $win = Irssi::active_win;
  90     my $view = $win->view;
  91     my $cl = $color_letter;
  92     if (-1 == index $cl, '$*') {
  93         $cl = "%$cl\$*";
  94     }
  95     $win->print_after(undef, MSGLEVEL_NEVER, "$cl ");
  96     my $lp = $win->last_line_insert;
  97     my $color_code = $lp->get_text(1);
  98     $color_code =~ s/ $//;
  99     $view->remove_line($lp);
 100     @color_code = split /\$\*/, $color_code, 2;
 101 }
 102
 103 sub setup_changed {
 104     $history_lines = Irssi::settings_get_int( set 'history_lines' );
 105     $skip_forms = Irssi::settings_get_int( set 'forms_skip' );
 106     $search_forms_max = Irssi::settings_get_int( set 'forms_search_max' );
 107     $ignore_hilights = Irssi::settings_get_bool( set 'ignore_hilights' );
 108     my $new_color = Irssi::settings_get_str( set 'color' );
 109     if ($new_color ne $color_letter) {
 110         $color_letter = $new_color;
 111         color_to_code();
 112     }
 113 }
 114
 115 sub init_dim_nicks {
 116     setup_changed();
 117 }
 118
 119 sub prt_text_issue {
 120     my ($ld) = @_;
 121     local $dest = $ld;
 122     &Irssi::signal_continue;
 123 }
 124
 125 sub expire_hist {
 126     for my $ch (keys %history_st) {
 127         if (@{$history_st{$ch}} > 2 * $history_lines) {
 128             my @del = splice @{$history_st{$ch}}, 0, $history_lines;
 129             delete @history_w{ @del };
 130             delete @history_c{ @del };
 131             delete @history_n{ @del };
 132             delete @history_nn{ @del };
 133         }
 134     }
 135 }
 136
 137 sub prt_text_ref {
 138     return unless $nickref;
 139     return unless $dest && defined $dest->{target};
 140     return unless $dest->{level} & MSGLEVEL_PUBLIC;
 141     return if $ignore_hilights && $dest->{level} & MSGLEVEL_HILIGHT;
 142
 143     my ($win) = @_;
 144     my $view = $win->view;
 145     my $line_id = $view->{buffer}{_irssi} .','. $view->{buffer}{cur_line}{_irssi};
 146     $chan_reg{ $chanref->{_irssi} } = $chanref;
 147     $nick_reg{ $nickref->{_irssi} } = $nickref;
 148     if (exists $history_w{ $line_id }) {
 149     }
 150     $history_w{ $line_id } = $win->{_irssi};
 151     $history_c{ $line_id } = $chanref->{_irssi};
 152     $history_n{ $line_id } = $nickref->{_irssi};
 153     $history_nn{ $line_id } = $nickref->{nick};
 154     push @{$history_st{ $chanref->{_irssi} }}, $line_id;
 155     expire_hist();
 156     my @lost_forever = grep { $view->{buffer}{first_line}{info}{time} > $lost_nicks{ $chanref->{_irssi} }{ $_ } }
 157         keys %{$lost_nicks{ $chanref->{_irssi} }};
 158     delete @{$lost_nicks{ $chanref->{_irssi} }}{ @lost_forever };
 159     delete @{$lost_nicks_fs{ $chanref->{_irssi} }}{ @lost_forever };
 160     delete @{$lost_nicks_fc{ $chanref->{_irssi} }}{ @lost_forever };
 161     delete @{$lost_nicks_bc{ $chanref->{_irssi} }}{ @lost_forever };
 162     delete @{$lost_nicks_bs{ $chanref->{_irssi} }}{ @lost_forever };
 163     return;
 164 }
 165
 166 sub win_del {
 167     my ($win) = @_;
 168     for my $ch (keys %history_st) {
 169         @{$history_st{$ch}} = grep { exists $history_w{ $_ } &&
 170                                      $history_w{ $_ } != $win->{_irssi} } @{$history_st{$ch}};
 171     }
 172     my @del = grep { $history_w{ $_ } == $win->{_irssi} } keys %history_w;
 173     delete @history_w{ @del };
 174     delete @history_c{ @del };
 175     delete @history_n{ @del };
 176     delete @history_nn{ @del };
 177     return;
 178 }
 179
 180 sub _alter_lines {
 181     my ($chan, $check_lr, $ad) = @_;
 182     my $win = $chan->window;
 183     return unless ref $win;
 184     my $view = $win->view;
 185     my $count = $history_lines;
 186     my $buffer_id = $view->{buffer}{_irssi} .',';
 187     my $lp = $view->{buffer}{cur_line};
 188     my %check_lr = map { $_ => undef } @$check_lr;
 189     my $redraw;
 190         my $bottom = $view->{bottom};
 191     while ($lp && $count) {
 192         my $line_id = $buffer_id . $lp->{_irssi};
 193         if (exists $check_lr{ $line_id }) {
 194             $lp = _alter_line($buffer_id, $line_id, $win, $view, $lp, $chan->{_irssi}, $ad);
 195             unless ($lp) {
 196                 last;
 197             }
 198             $redraw = 1;
 199         }
 200     } continue {
 201         --$count;
 202         $lp = $lp->prev;
 203     }
 204     if ($redraw) {
 205         $win->command('^scrollback end') if $bottom && !$win->view->{bottom};
 206         $view->redraw;
 207     }
 208 }
 209
 210 my $irssi_mumbo = qr/\cD[`-i]|\cD[&-@\xff]./;
 211 my $irssi_mumbo_no_partial = qr/(?<!\cD)(?<!\cD[&-@\xff])/;
 212 my $irssi_skip_form_re = qr/((?:$irssi_mumbo|[.,*@%+&!#$()=~'";:?\/><]+(?=$irssi_mumbo|\s))+|\s+)/;
 213
 214 sub debug_forms {
 215     my $win = Irssi::active_win;
 216     my $view = $win->view;
 217     my $lp = $view->{buffer}{cur_line};
 218     my $count = $history_lines;
 219     my $buffer_id = $view->{buffer}{_irssi} .',';
 220     while ($lp && $count) {
 221         my $line_id = $buffer_id . $lp->{_irssi};
 222         if (exists $history_w{ $line_id }) {
 223             my $line_nick = $history_nn{ $line_id };
 224             my $text = $lp->get_text(1);
 225             pos $text = 0;
 226             my $from = 0;
 227             for (my $i = 0; $i < $skip_forms; ++$i) {
 228                 last unless
 229                     scalar $text =~ /$irssi_skip_form_re/g;
 230                 $from = pos $text;
 231             }
 232             my $to = $from;
 233             for (my $i = 0; $i < $search_forms_max; ++$i) {
 234                 last unless
 235                     scalar $text =~ /$irssi_skip_form_re/g;
 236                 $to = pos $text;
 237             }
 238             my $pre = substr $text, 0, $from;
 239             my $search = substr $text, $from, $to-$from;
 240             my $post = substr $text, $to;
 241             unless ($to > $from) {
 242             } else {
 243                 my @nick_reg;
 244                 unshift @nick_reg, quotemeta substr $line_nick, 0, $_ for 1 .. length $line_nick;
 245                 no warnings 'uninitialized';
 246                 for my $nick_reg (@nick_reg) {
 247                     last if $search
 248                         =~ s/(\Q$color_code[0]\E\s*)?((?:$irssi_mumbo)+)?$irssi_mumbo_no_partial($nick_reg)((?:$irssi_mumbo)+)?(\s*\Q$color_code[0]\E)?/<match>$1$2<nick>$3<\/nick>$4$5<\/match>/;
 249                     last if $search
 250                         =~ s/(?:\Q$color_code[0]\E)?(?:(?:$irssi_mumbo)+?)?$irssi_mumbo_no_partial($nick_reg)(?:(?:$irssi_mumbo)+?)?(?:\Q$color_code[1]\E)?/<nick>$1<\/nick>/;
 251                 }
 252             }
 253             my $msg = "$pre<search>$search</search>$post";
 254             #$msg =~ s/([^[:print:]])/sprintf '\\x%02x', ord $1/ge;
 255             $msg =~ s/\cDe/%|/g; $msg =~ s/%/%%/g;
 256             $win->print(setc." form debug: [$msg]", MSGLEVEL_CLIENTCRAP);
 257             return;
 258         }
 259     } continue {
 260         --$count;
 261         $lp = $lp->prev;
 262     }
 263     $win->print(setc." form debug: no usable line found", MSGLEVEL_CLIENTCRAP);
 264 }
 265
 266 sub _alter_line {
 267     my ($buffer_id, $lrp, $win, $view, $lp, $cid, $ad) = @_;
 268     my $line_nick = $history_nn{ $lrp };
 269     my $text = $lp->get_text(1);
 270     pos $text = 0;
 271     my $from = 0;
 272     for (my $i = 0; $i < $skip_forms; ++$i) {
 273         last unless
 274             scalar $text =~ /$irssi_skip_form_re/g;
 275         $from = pos $text;
 276     }
 277     my $to = $from;
 278     for (my $i = 0; $i < $search_forms_max; ++$i) {
 279         last unless
 280             scalar $text =~ /$irssi_skip_form_re/g;
 281         $to = pos $text;
 282     }
 283     return $lp unless $to > $from;
 284     my @nick_reg;
 285     unshift @nick_reg, quotemeta substr $line_nick, 0, $_ for 1 .. length $line_nick;
 286     { no warnings 'uninitialized';
 287     if ($ad) {
 288         if (exists $lost_nicks_fs{ $cid }{ $line_nick }) {
 289             my ($fs, $fc, $bc, $bs) = ($lost_nicks_fs{ $cid }{ $line_nick }, $lost_nicks_fc{ $cid }{ $line_nick }, $lost_nicks_bc{ $cid }{ $line_nick }, $lost_nicks_bs{ $cid }{ $line_nick });
 290             my $sen = length $bs ? $color_code[0] : '';
 291             for my $nick_reg (@nick_reg) {
 292                 last if
 293                     (substr $text, $from, $to-$from)
 294                         =~ s/(?:\Q$color_code[0]\E)?(?:(?:$irssi_mumbo)+?)?$irssi_mumbo_no_partial($nick_reg)(?:(?:$irssi_mumbo)+?)?(?:\Q$color_code[1]\E)?/$fc$1$bc$sen/;
 295             }
 296         }
 297     }
 298     else {
 299         for my $nick_reg (@nick_reg) {
 300             if (
 301                 (substr $text, $from, $to-$from)
 302                     =~ s/(\Q$color_code[0]\E\s*)?((?:$irssi_mumbo)+)?$irssi_mumbo_no_partial($nick_reg)((?:$irssi_mumbo)+)?(\s*\Q$color_code[0]\E)?/$1$2$color_code[0]$3$color_code[1]$4$5/) {
 303                 $lost_nicks_fs{ $cid }{ $line_nick } = $1;
 304                 $lost_nicks_fc{ $cid }{ $line_nick } = $2;
 305                 $lost_nicks_bc{ $cid }{ $line_nick } = $4;
 306                 $lost_nicks_bs{ $cid }{ $line_nick } = $5;
 307                 last;
 308             }
 309         }
 310     } }
 311     $win->gui_printtext_after($lp->prev, $lp->{info}{level} | MSGLEVEL_NEVER, "$text\n", $lp->{info}{time});
 312     my $ll = $win->last_line_insert;
 313     my $line_id = $buffer_id . $ll->{_irssi};
 314     if (exists $history_w{ $line_id }) {
 315     }
 316     grep { $_ eq $lrp and $_ = $line_id } @{$history_st{ $cid }};
 317     $history_w{ $line_id } = delete $history_w{ $lrp };
 318     $history_c{ $line_id } = delete $history_c{ $lrp };
 319     $history_n{ $line_id } = delete $history_n{ $lrp };
 320     $history_nn{ $line_id } = delete $history_nn{ $lrp };
 321     $view->remove_line($lp);
 322     $ll;
 323 }
 324
 325 sub nick_add {
 326     my ($chan, $nick) = @_;
 327     if (delete $lost_nicks{ $chan->{_irssi} }{ $nick->{nick} }) {
 328         my @check_lr = grep { $history_c{ $_ } == $chan->{_irssi} &&
 329                               $history_n{ $_ } eq $nick->{nick} } keys %history_w;
 330         if (@check_lr) {
 331             $nick_reg{ $nick->{_irssi} } = $nick;
 332             for my $li (@check_lr) {
 333                 $history_n{ $li } = $nick->{_irssi};
 334             }
 335             _alter_lines($chan, \@check_lr, 1);
 336         }
 337     }
 338     delete $lost_nicks_fs{ $chan->{_irssi} }{ $nick->{nick} };
 339     delete $lost_nicks_fc{ $chan->{_irssi} }{ $nick->{nick} };
 340     delete $lost_nicks_bc{ $chan->{_irssi} }{ $nick->{nick} };
 341     delete $lost_nicks_bs{ $chan->{_irssi} }{ $nick->{nick} };
 342     return;
 343 }
 344
 345 sub nick_del {
 346     my ($chan, $nick) = @_;
 347     my @check_lr = grep { $history_n{ $_ } eq $nick->{_irssi} } keys %history_w;
 348     for my $li (@check_lr) {
 349         $history_n{ $li } = $nick->{nick};
 350     }
 351     if (@check_lr) {
 352         $lost_nicks{ $chan->{_irssi} }{ $nick->{nick} } = time;
 353         _alter_lines($chan, \@check_lr, 0);
 354     }
 355     delete $nick_reg{ $nick->{_irssi} };
 356     return;
 357 }
 358
 359 sub nick_change {
 360     my ($chan, $nick, $oldnick) = @_;
 361     nick_add($chan, $nick);
 362 }
 363
 364 sub chan_del {
 365     my ($chan) = @_;
 366     if (my $del = delete $history_st{ $chan->{_irssi} }) {
 367         delete @history_w{ @$del };
 368         delete @history_c{ @$del };
 369         delete @history_n{ @$del };
 370         delete @history_nn{ @$del };
 371     }
 372     delete $chan_reg{ $chan->{_irssi} };
 373     delete $lost_nicks{$chan->{_irssi}};
 374     delete $lost_nicks_fs{$chan->{_irssi}};
 375     delete $lost_nicks_fc{$chan->{_irssi}};
 376     delete $lost_nicks_bc{$chan->{_irssi}};
 377     delete $lost_nicks_bs{$chan->{_irssi}};
 378     return;
 379 }
 380
 381 Irssi::settings_add_int( setc, set 'history_lines',     $history_lines);
 382 Irssi::settings_add_bool( setc, set 'ignore_hilights',  $ignore_hilights);
 383 Irssi::signal_add_last({
 384     'setup changed'    => 'setup_changed',
 385 });
 386 Irssi::signal_add({
 387     'print text'              => 'prt_text_issue',
 388     'gui print text finished' => 'prt_text_ref',
 389     'nicklist new'            => 'nick_add',
 390     'nicklist changed'        => 'nick_change',
 391     'nicklist remove'         => 'nick_del',
 392     'window destroyed'        => 'win_del',
 393     'message public'          => 'msg_line_tag',
 394     'channel destroyed'       => 'chan_del',
 395 });
 396
 397 sub dumphist {
 398     my $win = Irssi::active_win;
 399     my $view = $win->view;
 400     my $buffer_id = $view->{buffer}{_irssi} .',';
 401     for (my $lp = $view->{buffer}{first_line}; $lp; $lp = $lp->next) {
 402         my $line_id = $buffer_id . $lp->{_irssi};
 403         if (exists $history_w{ $line_id }) {
 404             my $k = $history_c{ $line_id };
 405             my $kn = $history_n{ $line_id };
 406             if (exists $chan_reg{ $k }) {
 407             }
 408             if (exists $nick_reg{ $kn }) {
 409             }
 410             if (exists $lost_nicks{ $k } && exists $lost_nicks{ $k }{ $kn }) {
 411             }
 412         }
 413     }
 414 }
 415 Irssi::settings_add_str( setc, set 'color', $color_letter);
 416 Irssi::settings_add_int( setc, set 'forms_skip', $skip_forms);
 417 Irssi::settings_add_int( setc, set 'forms_search_max', $search_forms_max);
 418
 419 init_dim_nicks();
 420
 421 { package Irssi::Nick }
 422
 423 # Changelog
 424 # =========
 425 # 0.4.8
 426 # - optionally ignore hilighted lines
 427 # 0.4.7
 428 # - fix useless re-reading of settings colour
 429 # 0.4.6
 430 # - fix crash on some lines reported by pierrot