use strict; # use warnings;
# FIXME COULD SOMEONE PLEASE TELL ME HOW TO SHUT UP
#
# ...
# Variable "*" will not stay shared at (eval *) line *.
# Variable "*" will not stay shared at (eval *) line *.
# ...
# Can't locate package Irssi::Nick for @Irssi::Irc::Nick::ISA at (eval *) line *.
# ...
#
# THANKS
use Irssi (); # which is the minimum required version of Irssi ?
use Irssi::TextUI;
use vars qw($VERSION %IRSSI);
$VERSION = '0.5';
%IRSSI = (
authors => 'BC-bd, Veli, Timo \'cras\' Sirainen, Wouter Coekaerts, Nei',
contact => 'bd@bc-bd.org, veli@piipiip.net, tss@iki.fi, wouter@coekaerts.be, Nei@QuakeNet',
name => 'wlstat',
description => 'Adds a window list in the status area. Based on chanact.pl by above authors.',
license => 'GNU GPLv2 or later',
);
# adapted by Nei
###############
# original comment
# ###########
# # Adds new powerful and customizable [Act: ...] item (chanelnames,modes,alias).
# # Lets you give alias characters to windows so that you can select those with
# # meta-<char>.
# #
# # for irssi 0.8.2 by bd@bc-bd.org
# #
# # inspired by chanlist.pl by 'cumol@hammerhart.de'
# #
# #########
# # Contributors
# #########
# #
# # veli@piipiip.net /window_alias code
# # qrczak@knm.org.pl chanact_abbreviate_names
# # qerub@home.se Extra chanact_show_mode and chanact_chop_status
# #
#
# FURTHER THANKS TO
# ############
# # buu, fxn, Somni, Khisanth, integral, tybalt89 for much support in any aspect perl
# # and the channel in general ( #perl @ freenode ) and especially the ir_* functions
# #
# # Valentin 'senneth' Batz ( vb@g-23.org ) for the pointer to grep.pl, continuous support
# # and help in digging up ir_strip_codes
# #
# # OnetrixNET technology networks for the debian environment
# #
# # Monkey-Pirate.com / Spaceman Spiff for the webspace
# #
#
######
# M A I N P R O B L E M
#####
#
# It is impossible to place the wlstat on a statusbar together with other items, because I
# do not know how to calculate the size that it is going to get granted, and therefore I
# cannot do the linebreaks properly.
# This is what is missing to make a nice script out of wlstat.
# If you have any ideas, please contact me ASAP :).
#
######
######
# UTF-8 PROBLEM
#####
#
# Please help me find a solution to this:
# this be your statusbar, it is using up the maximum term size
# [[1=1]#abc [2=2]#defghi]
#
# now consider this example: "ascii" characters are marked with ., utf-8 characters with *
# [[1=1]#... [2=2]#...***]
#
# you should think that this is how it would be displayed? WRONG!
# [[1=1]#... [2=2]#...*** ]
#
# this is what Irssi does.. I believe my length calculating code to be correct, however, I'd
# love to be proven wrong (or receive any other fix, too, of course!)
#
######
#########
# USAGE
###
#
# copy the script to ~/.irssi/scripts/
#
# In irssi:
#
# /script load wlstat
#
#
# Hint: to get rid of the old [Act:] display
# /statusbar window remove act
#
# to get it back:
# /statusbar window add -after lag -priority 10 act
#
##########
# OPTIONS
########
#
# /set wlstat_display_nokey <string>
# /set wlstat_display_key <string>
# * string : Format String for one window. The following $'s are expanded:
# $C : Name
# $N : Number of the Window
# $Q : meta-Keymap
# $H : Start highlighting
# $S : Stop highlighting
# IMPORTANT: don't forget to use $S if you used $H before!
#
# /set wlstat_separator <string>
# * string : Charater to use between the channel entries
# you'll need to escape " " space and "$" like this:
# "/set wlstat_separator \ "
# "/set wlstat_separator \$"
# and {}% like this:
# "/set wlstat_separator %{"
# "/set wlstat_separator %}"
# "/set wlstat_separator %%"
# (reason being, that the separator is used inside a {format })
#
# /set wlstat_hide_data <num>
# * num : hide the window if its data_level is below num
# set it to 0 to basically disable this feature,
# 1 if you don't want windows without activity to be shown
# 2 to show only those windows with channel text or hilight
# 3 to show only windows with hilight
#
# /set wlstat_maxlines <num>
# * num : number of lines to use for the window list (0 to disable)
#
# /set wlstat_sort <-data_level|-last_line|refnum>
# * you can change the window sort order with this variable
# -data_level : sort windows with hilight first
# -last_line : sort windows in order of activity
# refnum : sort windows by window number
#
# /set wlstat_placement <top|bottom>
# /set wlstat_position <num>
# * these settings correspond to /statusbar because wlstat will create
# statusbars for you
# (see /help statusbar to learn more)
#
# /set wlstat_all_disable <ON|OFF>
# * if you set wlstat_all_disable to ON, wlstat will also remove the
# last statusbar it created if it is empty.
# As you might guess, this only makes sense with wlstat_hide_data > 0 ;)
#
###
# WISHES
####
#
# if you fiddle with my mess, provide me with your fixes so I can benefit as well
#
# Nei =^.^= ( QuakeNet accountname: ailin )
#
my $actString = []; # statusbar texts
my $currentLines = 0;
my $resetNeeded; # layout/screen has changed, redo everything
my $needRemake; # "normal" changes
#my $callcount = 0;
my $globTime = undef; # timer to limit remake() calls
my %statusbars; # currently active statusbars
# maybe I should just tie the array ?
sub add_statusbar {
for (@_) {
# add subs
for my $l ($_) { eval {
no strict 'refs'; # :P
*{"wlstat$l"} = sub { wlstat($l, @_) };
}; }
Irssi::command("statusbar wl$_ reset");
Irssi::command("statusbar wl$_ enable");
if (lc Irssi::settings_get_str('wlstat_placement') eq 'top') {
Irssi::command("statusbar wl$_ placement top");
}
if ((my $x = int Irssi::settings_get_int('wlstat_position')) != 0) {
Irssi::command("statusbar wl$_ position $x");
}
Irssi::command("statusbar wl$_ add -priority 100 -alignment left barstar");
Irssi::command("statusbar wl$_ add wlstat$_");
Irssi::command("statusbar wl$_ add -priority 100 -alignment right barend");
Irssi::command("statusbar wl$_ disable");
Irssi::statusbar_item_register("wlstat$_", '$0', "wlstat$_");
$statusbars{$_} = {};
}
}
sub remove_statusbar {
for (@_) {
Irssi::command("statusbar wl$_ reset");
Irssi::statusbar_item_unregister("wlstat$_"); # XXX does this actually work ?
# DO NOT REMOVE the sub before you have unregistered it :))
for my $l ($_) { eval {
no strict 'refs';
undef &{"wlstat$l"};
}; }
delete $statusbars{$_};
}
}
sub syncLines {
my $temp = $currentLines;
$currentLines = @$actString;
#Irssi::print("current lines: $temp new lines: $currentLines");
my $currMaxLines = Irssi::settings_get_int('wlstat_maxlines');
if ($currMaxLines > 0 and @$actString > $currMaxLines) {
$currentLines = $currMaxLines;
}
return if ($temp == $currentLines);
if ($currentLines > $temp) {
for ($temp .. ($currentLines - 1)) {
add_statusbar($_);
Irssi::command("statusbar wl$_ enable");
}
}
else {
for ($_ = ($temp - 1); $_ >= $currentLines; $_--) {
Irssi::command("statusbar wl$_ disable");
remove_statusbar($_);
}
}
}
my %keymap;
sub get_keymap {
my ($textDest, undef, $cont_stripped) = @_;
if ($textDest->{'level'} == 524288 and $textDest->{'target'} eq '' and !defined($textDest->{'server'})) {
if ($cont_stripped =~ m/meta-(.)\s+change_window (\d+)/) { $keymap{$2} = "$1"; }
Irssi::signal_stop();
}
}
sub update_keymap {
%keymap = ();
Irssi::signal_remove('command bind' => 'watch_keymap');
Irssi::signal_add_first('print text' => 'get_keymap');
Irssi::command('bind'); # stolen from grep
Irssi::signal_remove('print text' => 'get_keymap');
Irssi::signal_add('command bind' => 'watch_keymap');
Irssi::timeout_add_once(100, 'eventChanged', undef);
}
# watch keymap changes
sub watch_keymap {
Irssi::timeout_add_once(1000, 'update_keymap', undef);
}
update_keymap();
sub expand {
my ($string, %format) = @_;
my ($exp, $repl);
$string =~ s/\$$exp/$repl/g while (($exp, $repl) = each(%format));
return $string;
}
# FIXME implement $get_size_only check, and user $item->{min|max-size} ??
sub wlstat {
my ($line, $item, $get_size_only) = @_;
if ($needRemake) {
$needRemake = undef;
remake();
}
my $text = $actString->[$line]; # DO NOT set the actual $actString->[$line] to '' here or
$text = '' unless defined $text; # you'll screw up the statusbar counter ($currentLines)
$item->default_handler($get_size_only, $text, '', 1);
}
my %strip_table = (
# fe-common::core::formats.c:format_expand_styles
# delete format_backs format_fores bold_fores other stuff
(map { $_ => '' } (split //, '04261537' . 'kbgcrmyw' . 'KBGCRMYW' . 'U9_8:|FnN>#[')),
# escape
(map { $_ => $_ } (split //, '{}%')),
);
sub ir_strip_codes { # strip %codes
my $o = shift;
$o =~ s/(%(.))/exists $strip_table{$2} ? $strip_table{$2} : $1/gex;
$o
}
sub ir_parse_special {
my $o; my $i = shift;
my $win = Irssi::active_win();
my $server = Irssi::active_server();
if (ref $win and ref $win->{'active'}) {
$o = $win->{'active'}->parse_special($i);
}
elsif (ref $win and ref $win->{'active_server'}) {
$o = $win->{'active_server'}->parse_special($i);
}
elsif (ref $server) {
$o = $server->parse_special($i);
}
else {
$o = Irssi::parse_special($i);
}
$o
}
sub sb_expand { # expand {format }s (and apply parse_special for $vars)
ir_parse_special(
Irssi::current_theme->format_expand(
shift,
(
Irssi::EXPAND_FLAG_IGNORE_REPLACES
|
Irssi::EXPAND_FLAG_IGNORE_EMPTY
)
)
)
}
sub sb_strip {
ir_strip_codes(
sb_expand(shift)
); # does this get us the actual length of that s*ty bar :P ?
}
sub sb_length {
# unicode cludge, d*mn broken Irssi
# screw it, this will fail from broken joining anyway (and cause warnings)
if (lc Irssi::settings_get_str('term_type') eq 'utf-8') {
my $temp = sb_strip(shift);
# try to switch on utf8
eval {
no warnings;
require Encode;
#$temp = Encode::decode_utf8($temp); # thanks for the hint, but I have my reasons for _utf8_on
Encode::_utf8_on($temp);
};
length($temp)
}
else {
length(sb_strip(shift))
}
}
# !!! G*DD*MN Irssi is adding an additional layer of backslashitis per { } layer
# !!! AND I still don't know what I need to escape.
# !!! and NOONE else seems to know or care either.
# !!! f*ck open source. I mean it.
# XXX any Irssi::print debug statement leads to SEGFAULT - why ?
# major parts of the idea by buu (#perl @ freenode)
# thanks to fxn and Somni for debugging
# while ($_[0] =~ /(.)/g) {
# my $c = $1; # XXX sooo... goto kills $1
# if ($q eq '%') { goto ESC; }
## <freenode:#perl:tybalt89> s/%(.)|(\{)|(\})|(\\|\$)/$1?$1:$2?($level++,$2):$3?($level>$min_level&&$level--,$3):'\\'x(2**$level-1).$4/ge; # untested...
sub ir_escape {
my $min_level = $_[1] || 0; my $level = $min_level;
my $o = shift;
$o =~ s/
( %. ) | # $1
( \{ ) | # $2
( \} ) | # $3
( \\ ) | # $4
( \$(?=.) ) | # $5
( \$ ) # $6
/
if ($1) { $1 } # %. escape
elsif ($2) { $level++; $2 } # { nesting start
elsif ($3) { if ($level > $min_level) { $level--; } $3 } # } nesting end
elsif ($4) { '\\'x(2**$level) } # \ needs \\escaping
elsif ($5) { '\\'x(2**$level-1) . '$' . '\\'x(2**$level-1) } # and $ needs even more because of "parse_special"
else { '\\'x(2**$level-1) . '$' } # $ needs \$ escaping
/gex;
$o
}
#sub ir_escape {
# my $min_level = $_[1] || 0; my $level = $min_level;
# my $o = shift;
# $o =~ s/
# ( %. ) | # $1
# ( \{ ) | # $2
# ( \} ) | # $3
# ( \\ | \$ ) # $4
# /
# if ($1) { $1 } # %. escape
# elsif ($2) { $level++; $2 } # { nesting start
# elsif ($3) { if ($level > $min_level) { $level--; } $3 } # } nesting end
# else { '\\'x(2**($level-1)-1) . $4 } # \ or $ needs \\escaping
# /gex;
# $o
#}
sub ir_fe { # try to fix format stuff
my $x = shift;
# XXX why do I have to use two/four % here instead of one/two ?? answer: you screwed up in ir_escape
$x =~ s/([%{}])/%$1/g;
$x =~ s/(\\|\$)/\\$1/g;
#$x =~ s/(\$(?=.))|(\$)/$1?"\\\$\\":"\\\$"/ge; # I think this should be here (logic), but it doesn't work that way :P
#$x =~ s/\\/\\\\/g; # that's right, escape escapes
$x
}
sub remake () {
#$callcount++;
#my $xx = $callcount; Irssi::print("starting remake [ $xx ]");
my ($hilight, $number, $display);
my $separator = '{sb_act_sep ' . Irssi::settings_get_str('wlstat_separator') . '}';
my $custSort = Irssi::settings_get_str('wlstat_sort');
my $custSortDir = 1;
if ($custSort =~ /^[-!](.*)/) {
$custSortDir = -1;
$custSort = $1;
}
$actString = [];
my ($line, $width) = (0, [Irssi::windows]->[0]{'width'} - sb_length('{sb x}'));
foreach my $win (
sort {
(
( (int($a->{$custSort}) <=> int($b->{$custSort})) * $custSortDir )
||
($a->{'refnum'} <=> $b->{'refnum'})
)
} Irssi::windows
) {
$actString->[$line] = '' unless defined $actString->[$line] or Irssi::settings_get_bool('wlstat_all_disable');
# all stolen from chanact, what does this code do and why do we need it ?
!ref($win) && next;
my $name = $win->get_active_name;
my $active = $win->{'active'};
my $colour = $win->{'hilight_color'};
if (!defined $colour) { $colour = ''; }
if ($win->{'data_level'} < Irssi::settings_get_int('wlstat_hide_data')) { next; } # for Geert
if ($win->{'data_level'} == 0) { $hilight = '{sb_act_none '; }
elsif ($win->{'data_level'} == 1) { $hilight = '{sb_act_text '; }
elsif ($win->{'data_level'} == 2) { $hilight = '{sb_act_msg '; }
elsif ($colour ne '') { $hilight = "{sb_act_hilight_color $colour "; }
elsif ($win->{'data_level'} == 3) { $hilight = '{sb_act_hilight '; }
else { $hilight = '{sb_act_special '; }
$number = $win->{'refnum'};
$display = (defined $keymap{$number} and $keymap{$number} ne '')
?
(
Irssi::settings_get_str('wlstat_display_key')
||
Irssi::settings_get_str('wlstat_display_nokey')
)
:
Irssi::settings_get_str('wlstat_display_nokey')
;
my $add = expand($display,
C => ir_fe($name),
N => $number,
Q => ir_fe($keymap{$number}),
H => $hilight,
S => '}{sb_background}'
);
#$temp =~ s/\{\S+?(?:\s(.*?))?\}/$1/g;
#$temp =~ s/\\\\\\\\/\\/g; # XXX I'm actually guessing here, someone point me to docs please
$actString->[$line] = '' unless defined $actString->[$line];
# XXX how can I check whether the content still fits in the bar? this would allow
# XXX wlstatus to reside on a statusbar together with other items...
if (sb_length(ir_escape($actString->[$line] . $add)) >= $width) { # XXX doesn't correctly handle utf-8 multibyte ... help !!?
$actString->[$line] .= ' ' x ($width - sb_length(ir_escape($actString->[$line])));
$line++;
}
$actString->[$line] .= $add . $separator;
# XXX if I use these prints, output layout gets screwed up... why ?
#Irssi::print("line $line: ".$actString->[$line]);
#Irssi::print("temp $line: ".$temp);
}
# XXX the Irssi::print statements lead to the MOST WEIRD results
# e.g.: the loop gets executed TWICE for p > 0 ?!?
for (my $p = 0; $p < @$actString; $p++) { # wrap each line in {sb }, escape it properly, etc.
my $x = $actString->[$p];
$x =~ s/\Q$separator\E([ ]*)$/$1/;
#Irssi::print("[$p]".'current:'.join'.',split//,sb_strip(ir_escape($x,0)));
#Irssi::print("assumed length before:".sb_length(ir_escape($x,0)));
$x = "{sb $x}";
#Irssi::print("[$p]".'new:'.join'.',split//,sb_expand(ir_escape($x,0)));
#Irssi::print("[$p]".'new:'.join'.',split//,ir_escape($x,0));
#Irssi::print("assumed length after:".sb_length(ir_escape($x,0)));
$x = ir_escape($x);
#Irssi::print("[$p]".'REALnew:'.join'.',split//,sb_strip($x));
$actString->[$p] = $x;
# XXX any Irssi::print debug statement leads to SEGFAULT (sometimes) - why ?
}
#Irssi::print("remake [ $xx ] finished");
}
sub wlstatHasChanged () {
$globTime = undef;
my $temp = Irssi::settings_get_str('wlstat_placement').Irssi::settings_get_int('wlstat_position');
if ($temp ne $resetNeeded) { wlreset(); return; }
#Irssi::print("wlstat has changed, calls to remake so far: $callcount");
$needRemake = 1;
#remake();
if (
($needRemake and Irssi::settings_get_bool('wlstat_all_disable'))
or
(!Irssi::settings_get_bool('wlstat_all_disable') and $currentLines < 1)
) {
$needRemake = undef;
remake();
}
# XXX Irssi crashes if I try to do this without timer, why ? What's the minimum delay I need to use in the timer ?
Irssi::timeout_add_once(100, 'syncLines', undef);
for (keys %statusbars) {
Irssi::statusbar_items_redraw("wlstat$_");
}
}
sub eventChanged () { # Implement a change queue/blocker -.-)
if (defined $globTime) {
Irssi::timeout_remove($globTime);
} # delay the update further
$globTime = Irssi::timeout_add_once(10, 'wlstatHasChanged', undef);
}
#$needRemake = 1;
sub resizeTerm () {
Irssi::timeout_add_once(100, 'eventChanged', undef);
}
Irssi::settings_add_str('wlstat', 'wlstat_display_nokey', '[$N]$H$C$S');
Irssi::settings_add_str('wlstat', 'wlstat_display_key', '[$Q=$N]$H$C$S');
Irssi::settings_add_str('wlstat', 'wlstat_separator', "\\ ");
Irssi::settings_add_int('wlstat', 'wlstat_hide_data', 0);
Irssi::settings_add_int('wlstat', 'wlstat_maxlines', 9);
Irssi::settings_add_str('wlstat', 'wlstat_sort', 'refnum');
Irssi::settings_add_str('wlstat', 'wlstat_placement', 'bottom');
Irssi::settings_add_int('wlstat', 'wlstat_position', 0);
Irssi::settings_add_bool('wlstat', 'wlstat_all_disable', 0);
# remove old statusbars
my %killBar;
sub get_old_status {
my ($textDest, $cont, $cont_stripped) = @_;
if ($textDest->{'level'} == 524288 and $textDest->{'target'} eq '' and !defined($textDest->{'server'})) {
if ($cont_stripped =~ m/^wl(\d+)\s/) { $killBar{$1} = {}; }
Irssi::signal_stop();
}
}
sub killOldStatus {
%killBar = ();
Irssi::signal_add_first('print text' => 'get_old_status');
Irssi::command('statusbar');
Irssi::signal_remove('print text' => 'get_old_status');
remove_statusbar(keys %killBar);
}
#killOldStatus();
sub wlreset {
$actString = [];
$currentLines = 0; # 1; # mhmmmm .. we actually enable one line down there so let's try this.
$resetNeeded = Irssi::settings_get_str('wlstat_placement').Irssi::settings_get_int('wlstat_position');
#update_keymap();
killOldStatus();
# Register statusbar
#add_statusbar(0);
#Irssi::command('statusbar wl0 enable');
resizeTerm();
}
wlreset();
my $Unload;
sub unload ($$$) {
$Unload = 1;
Irssi::timeout_add_once(10, sub { $Unload = undef; }, undef); # pretend we didn't do anything ASAP
}
Irssi::signal_add_first('gui exit' => sub { $Unload = undef; }); # last try to catch a sigsegv
sub UNLOAD {
if ($Unload) { # this might well crash Irssi... try /eval /script unload someotherscript ; /quit (= SEGFAULT !)
$actString = ['']; # syncLines(); # XXX Irssi crashes when trying to disable all statusbars ?
killOldStatus();
}
}
sub addPrintTextHook { # update on print text
return if $_[0]->{'level'} == 262144 and $_[0]->{'target'} eq '' and !defined($_[0]->{'server'});
if (Irssi::settings_get_str('wlstat_sort') =~ /^[-!]?last_line$/) {
Irssi::timeout_add_once(100, 'eventChanged', undef);
}
}
#sub _x { my ($x, $y) = @_; ($x, sub { Irssi::print('-->signal '.$x); eval "$y();"; }) }
#sub _x { @_ }
Irssi::signal_add_first(
'command script unload' => 'unload'
);
Irssi::signal_add_last({
'setup changed' => 'eventChanged',
'print text' => 'addPrintTextHook',
'terminal resized' => 'resizeTerm',
'setup reread' => 'wlreset',
'window hilight' => 'eventChanged',
});
Irssi::signal_add({
'window created' => 'eventChanged',
'window destroyed' => 'eventChanged',
'window name changed' => 'eventChanged',
'window refnum changed' => 'eventChanged',
'window changed' => 'eventChanged',
'window changed automatic' => 'eventChanged',
});
#Irssi::signal_add('nick mode changed', 'chanactHasChanged'); # relicts
###############
###
#
# Changelog
#
# 0.5a
# - add setting to also hide the last statusbar if empty (wlstat_all_disable)
# - reverted to old utf8 code to also calculate broken utf8 length correctly
# - simplified dealing with statusbars in wlreset
#
# 0.4d
# - fixed order of disabling statusbars
# - several attempts at special chars, without any real success
# and much more weird new bugs caused by this
# - setting to specify sort order
# - reduced timeout values
# - added wlstat_hide_data for Geert Hauwaerts ( geert@irssi.org ) :)
# - make it so the dynamic sub is actually deleted
# - fix a bug with removing of the last separator
# - take into consideration parse_special
#
# 0.3b
# - automatically kill old statusbars
# - reset on /reload
# - position/placement settings
#
# 0.2
# - automated retrieval of key bindings (thanks grep.pl authors)
# - improved removing of statusbars
# - got rid of status chop
#
# 0.1
# - rewritten to suit my needs
# - based on chanact 0.5.5
syntax highlighted by Code2HTML, v. 0.9.1