2479 lines
69 KiB
Perl
Executable File
2479 lines
69 KiB
Perl
Executable File
use strict; # use warnings;
|
|
|
|
# {{{ debug
|
|
|
|
#BEGIN {
|
|
# open STDERR, '>', '/home/ailin/wlstatwarnings';
|
|
#};
|
|
|
|
# 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
|
|
|
|
# }}}
|
|
|
|
# if you don't know how to operate folds, type zn
|
|
|
|
# {{{ header
|
|
|
|
use Irssi (); # which is the minimum required version of Irssi ?
|
|
use Irssi::TextUI;
|
|
|
|
use vars qw($VERSION %IRSSI);
|
|
|
|
$VERSION = '0.6ca';
|
|
%IRSSI = (
|
|
original_authors => q(BC-bd, Veli, Timo Sirainen, ).
|
|
q(Wouter Coekaerts, Jean-Yves Lefort), # (decadix)
|
|
original_contact => q(bd@bc-bd.org, veli@piipiip.net, tss@iki.fi, ).
|
|
q(wouter@coekaerts.be, jylefort@brutele.be),
|
|
authors => q(Nei),
|
|
contact => q(Nei@QuakeNet),
|
|
url => "http://anti.teamidiot.de/",
|
|
name => q(awl),
|
|
description => q(Adds a permanent advanced window list on the right or ).
|
|
q(in a statusbar.),
|
|
description2 => q(Based on chanact.pl which was apparently based on ).
|
|
q(lightbar.c and nicklist.pl with various other ideas ).
|
|
q(from random scripts.),
|
|
license => q(GNU GPLv2 or later),
|
|
);
|
|
|
|
# }}}
|
|
|
|
# {{{ *** D O C U M E N T A T I O N ***
|
|
|
|
# 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 awl 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 awl.
|
|
# 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:i
|
|
# "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 awl
|
|
#
|
|
#
|
|
# 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 awl_display_nokey <string>
|
|
# /set awl_display_key <string>
|
|
# /set awl_display_nokey_active <string>
|
|
# /set awl_display_key_active <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
|
|
# /+++++++++++++++++++++++++++++++++,
|
|
# | **** I M P O R T A N T : **** |
|
|
# | |
|
|
# | don't forget to use $S if you |
|
|
# | used $H before! |
|
|
# | |
|
|
# '+++++++++++++++++++++++++++++++++/
|
|
# XXX NOTE ON *_active: there is a BUG somewhere in the length
|
|
# XXX calculation. currently it's best to NOT remove $H/$S from those
|
|
# XXX settings if you use it in the non-active settings.
|
|
# }}}
|
|
# {{{ /set awl_separator <string>
|
|
# * string : Charater to use between the channel entries
|
|
# you'll need to escape " " space and "$" like this:
|
|
# "/set awl_separator \ "
|
|
# "/set awl_separator \$"
|
|
# and {}% like this:
|
|
# "/set awl_separator %{"
|
|
# "/set awl_separator %}"
|
|
# "/set awl_separator %%"
|
|
# (reason being, that the separator is used inside a {format })
|
|
# }}}
|
|
# {{{ /set awl_prefer_name <ON|OFF>
|
|
# * this setting decides whether awl will use the active_name (OFF) or the
|
|
# window name as the name/caption in awl_display_*.
|
|
# That way you can rename windows using /window name myownname.
|
|
# }}}
|
|
# {{{ /set awl_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 awl_maxlines <num>
|
|
# * num : number of lines to use for the window list (0 to disable, negative
|
|
# lock)
|
|
# }}}
|
|
# {{{ /set awl_columns <num>
|
|
# * num : number of columns to use in screen mode (0 for unlimited)
|
|
# }}}
|
|
# {{{ /set awl_block <num>
|
|
# * num : width of a column in screen mode (negative values = block display)
|
|
# /+++++++++++++++++++++++++++++++++,
|
|
# | ****** W A R N I N G ! ****** |
|
|
# | |
|
|
# | If your block display looks |
|
|
# | DISTORTED, you need to add the |
|
|
# | following line to your .theme |
|
|
# | file under |
|
|
# | abstracts = { : |
|
|
# | |
|
|
# | sb_act_none = "%n$*"; |
|
|
# | |
|
|
# '+++++++++++++++++++++++++++++++++/
|
|
#.02:08:26. < shi> Irssi::current_theme()->get_format <.. can this be used?
|
|
# }}}
|
|
# {{{ /set awl_sbar_maxlength <ON|OFF>
|
|
# * if you enable the maxlength setting, the block width will be used as a
|
|
# maximum length for the non-block statusbar mode too.
|
|
# }}}
|
|
# {{{ /set awl_height_adjust <num>
|
|
# * num : how many lines to leave empty in screen mode
|
|
# }}}
|
|
# {{{ /set awl_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 awl_placement <top|bottom>
|
|
# /set awl_position <num>
|
|
# * these settings correspond to /statusbar because awl will create
|
|
# statusbars for you
|
|
# (see /help statusbar to learn more)
|
|
# }}}
|
|
# {{{ /set awl_all_disable <ON|OFF>
|
|
# * if you set awl_all_disable to ON, awl will also remove the
|
|
# last statusbar it created if it is empty.
|
|
# As you might guess, this only makes sense with awl_hide_data > 0 ;)
|
|
# }}}
|
|
# {{{ /set awl_automode <sbar|screen|emulate_lightbar>
|
|
# * this setting defines whether the window list is shown in statusbars or
|
|
# whether the screen hack is used (from nicklist.pl)
|
|
# }}}
|
|
# }}}
|
|
##########
|
|
# {{{ COMMANDS
|
|
########
|
|
# {{{ /awl paste <ON|OFF|TOGGLE>
|
|
# * enables or disables the screen hack windowlist. This is useful when you
|
|
# want to mark & copy text that you want to paste somewhere (hence the
|
|
# name). (ON means AWL disabled!)
|
|
# This is nicely bound to a function key for example.
|
|
# }}}
|
|
# {{{ /awl redraw
|
|
# * redraws the screen hack windowlist. There are many occasions where the
|
|
# screen hack windowlist can get destroyed so you can use this command to
|
|
# fix it.
|
|
# }}}
|
|
# }}}
|
|
###
|
|
# {{{ WISHES
|
|
####
|
|
#
|
|
# if you fiddle with my mess, provide me with your fixes so I can benefit as well
|
|
#
|
|
# Nei =^.^= ( QuakeNet accountname: ailin )
|
|
# }}}
|
|
|
|
# }}}
|
|
|
|
# {{{ modules
|
|
|
|
#use Class::Classless;
|
|
#use Term::Info;
|
|
|
|
# }}}
|
|
|
|
# {{{ global variables
|
|
|
|
my $replaces = '[=]'; # AARGH!!! (chars that are always surrounded by weird
|
|
# colour codes by Irssi)
|
|
|
|
my $actString = []; # statusbar texts
|
|
my $currentLines = 0;
|
|
my $resetNeeded; # layout/screen has changed, redo everything
|
|
my $needRemake; # "normal" changes
|
|
#my $callcount = 0;
|
|
sub GLOB_QUEUE_TIMER () { 100 }
|
|
my $globTime = undef; # timer to limit remake() calls
|
|
|
|
|
|
my $SCREEN_MODE;
|
|
my $DISABLE_SCREEN_TEMP;
|
|
my $currentColumns = 0;
|
|
my $screenResizing;
|
|
my ($screenHeight, $screenWidth);
|
|
my $screenansi = bless {
|
|
NAME => 'Screen::ANSI',
|
|
PARENTS => [],
|
|
METHODS => {
|
|
dcs => sub { "\033P" },
|
|
st => sub { "\033\\"},
|
|
}
|
|
}, 'Class::Classless::X';
|
|
#my $terminfo = new Term::Info 'xterm'; # xterm here, make this modular
|
|
# {{{{{{{{{{{{{{{
|
|
my $terminfo = bless { # xterm here, make this modular
|
|
NAME => 'Term::Info::xterm',
|
|
PARENTS => [],
|
|
METHODS => {
|
|
# civis=\E[?25l,
|
|
civis => sub { "\033[?25l" },
|
|
# sc=\E7,
|
|
sc => sub { "\0337" },
|
|
# cup=\E[%i%p1%d;%p2%dH,
|
|
cup => sub { shift;shift; "\033[" . ($_[0] + 1) . ';' . ($_[1] + 1) . 'H' },
|
|
# el=\E[K,
|
|
el => sub { "\033[K" },
|
|
# rc=\E8,
|
|
rc => sub { "\0338" },
|
|
# cnorm=\E[?25h,
|
|
cnorm => sub { "\033[?25h" },
|
|
# setab=\E[4%p1%dm,
|
|
setab => sub { shift;shift; "\033[4" . $_[0] . 'm' },
|
|
# setaf=\E[3%p1%dm,
|
|
setaf => sub { shift;shift; "\033[3" . $_[0] . 'm' },
|
|
# bold=\E[1m,
|
|
bold => sub { "\033[1m" },
|
|
# blink=\E[5m,
|
|
blink => sub { "\033[5m" },
|
|
# rev=\E[7m,
|
|
rev => sub { "\033[7m" },
|
|
# op=\E[39;49m,
|
|
op => sub { "\033[39;49m" },
|
|
}
|
|
}, 'Class::Classless::X';
|
|
# }}}}}}}}}}}}}}}
|
|
|
|
|
|
sub setc () {
|
|
$IRSSI{'name'}
|
|
}
|
|
sub set ($) {
|
|
setc . '_' . shift
|
|
}
|
|
|
|
# }}}
|
|
|
|
|
|
# {{{ sbar mode
|
|
|
|
my %statusbars; # currently active statusbars
|
|
|
|
# maybe I should just tie the array ?
|
|
sub add_statusbar {
|
|
for (@_) {
|
|
# add subs
|
|
for my $l ($_) { {
|
|
no strict 'refs'; # :P
|
|
*{set$l} = sub { awl($l, @_) };
|
|
}; }
|
|
Irssi::command('statusbar ' . (set$_) . ' reset');
|
|
Irssi::command('statusbar ' . (set$_) . ' enable');
|
|
if (lc Irssi::settings_get_str(set 'placement') eq 'top') {
|
|
Irssi::command('statusbar ' . (set$_) . ' placement top');
|
|
}
|
|
if ((my $x = int Irssi::settings_get_int(set 'position')) != 0) {
|
|
Irssi::command('statusbar ' . (set$_) . ' position ' . $x);
|
|
}
|
|
Irssi::command('statusbar ' . (set$_) . ' add -priority 100 -alignment left barstart');
|
|
Irssi::command('statusbar ' . (set$_) . ' add ' . (set$_));
|
|
Irssi::command('statusbar ' . (set$_) . ' add -priority 100 -alignment right barend');
|
|
Irssi::command('statusbar ' . (set$_) . ' disable');
|
|
Irssi::statusbar_item_register(set$_, '$0', set$_);
|
|
$statusbars{$_} = {};
|
|
}
|
|
}
|
|
|
|
sub remove_statusbar {
|
|
for (@_) {
|
|
Irssi::command('statusbar ' . (set$_) . ' reset');
|
|
Irssi::statusbar_item_unregister(set$_); # XXX does this actually work ?
|
|
# DO NOT REMOVE the sub before you have unregistered it :))
|
|
for my $l ($_) { {
|
|
no strict 'refs';
|
|
undef &{set$l};
|
|
}; }
|
|
delete $statusbars{$_};
|
|
}
|
|
}
|
|
|
|
sub syncLines {
|
|
my $temp = $currentLines;
|
|
$currentLines = @$actString;
|
|
#Irssi::print("current lines: $temp new lines: $currentLines");
|
|
my $currMaxLines = Irssi::settings_get_int(set 'maxlines');
|
|
if ($currMaxLines > 0 and @$actString > $currMaxLines) {
|
|
$currentLines = $currMaxLines;
|
|
}
|
|
elsif ($currMaxLines < 0) {
|
|
$currentLines = abs($currMaxLines);
|
|
}
|
|
return if ($temp == $currentLines);
|
|
if ($currentLines > $temp) {
|
|
for ($temp .. ($currentLines - 1)) {
|
|
add_statusbar($_);
|
|
Irssi::command('statusbar ' . (set$_) . ' enable');
|
|
}
|
|
}
|
|
else {
|
|
for ($_ = ($temp - 1); $_ >= $currentLines; $_--) {
|
|
Irssi::command('statusbar ' . (set$_) . ' disable');
|
|
remove_statusbar($_);
|
|
}
|
|
}
|
|
}
|
|
|
|
# FIXME implement $get_size_only check, and user $item->{min|max-size} ??
|
|
sub awl {
|
|
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);
|
|
}
|
|
|
|
# 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'})
|
|
) {
|
|
my $name = quotemeta(set '');
|
|
if ($cont_stripped =~ m/^$name(\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();
|
|
|
|
# end sbar mode }}}
|
|
|
|
|
|
# {{{ keymaps
|
|
|
|
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+)/) {
|
|
my ($level, $key, $window) = ($1, $2, $3);
|
|
my $numlevel = ($level =~ y/-//) - 1;
|
|
$keymap{$window} = ('-' x $numlevel) . "$key";
|
|
}
|
|
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();
|
|
|
|
# end keymaps }}}
|
|
|
|
# {{{ format handling
|
|
|
|
# a bad way do do expansions but who cares
|
|
sub expand {
|
|
my ($string, %format) = @_;
|
|
my ($exp, $repl);
|
|
$string =~ s/\$$exp/$repl/g while (($exp, $repl) = each(%format));
|
|
return $string;
|
|
}
|
|
|
|
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;
|
|
#if ($_[0]) { # for the future?!?
|
|
# eval {
|
|
# $o = $_[0]->parse_special($i);
|
|
# };
|
|
# unless ($@) {
|
|
# return $o;
|
|
# }
|
|
#}
|
|
my $win = shift || 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 ir_parse_special_protected {
|
|
my $o; my $i = shift;
|
|
$i =~ s/
|
|
( \\. ) | # skip over escapes (maybe)
|
|
( \$[^% $\]+ ) # catch special variables
|
|
/
|
|
if ($1) { $1 }
|
|
elsif ($2) { my $i2 = $2; ir_fe(ir_parse_special($i2, @_)) }
|
|
else { $& }
|
|
/gex;
|
|
$i
|
|
}
|
|
|
|
|
|
sub sb_ctfe { # Irssi::current_theme->format_expand wrapper
|
|
Irssi::current_theme->format_expand(
|
|
shift,
|
|
(
|
|
Irssi::EXPAND_FLAG_IGNORE_REPLACES
|
|
|
|
|
($_[0]?0:Irssi::EXPAND_FLAG_IGNORE_EMPTY)
|
|
)
|
|
)
|
|
}
|
|
sub sb_expand { # expand {format }s (and apply parse_special for $vars)
|
|
ir_parse_special(
|
|
sb_ctfe(shift)
|
|
)
|
|
}
|
|
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)
|
|
my $term_type = 'term_type';
|
|
if (Irssi::version > 20040819) { # this is probably wrong, but I don't know
|
|
# when the setting name got changed
|
|
$term_type = 'term_charset';
|
|
}
|
|
#if (lc Irssi::settings_get_str($term_type) eq '8bit'
|
|
# or Irssi::settings_get_str($term_type) =~ /^iso/i
|
|
#) {
|
|
# length(sb_strip(shift))
|
|
#}
|
|
#else {
|
|
my $temp = sb_strip(shift);
|
|
# try to get the displayed width
|
|
my $length;
|
|
eval {
|
|
require Text::CharWidth;
|
|
$length = Text::CharWidth::mbswidth($temp);
|
|
};
|
|
unless ($@) {
|
|
return $length;
|
|
}
|
|
else {
|
|
if (lc Irssi::settings_get_str($term_type) eq 'utf-8') {
|
|
# 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);
|
|
};
|
|
}
|
|
# there is nothing more I can do
|
|
length($temp)
|
|
}
|
|
#}
|
|
}
|
|
|
|
# !!! 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; # XXX HOW CAN I HANDLE THE SPACES CORRECTLY XXX
|
|
$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 ir_ve { # escapes special vars but leave colours alone
|
|
my $x = shift;
|
|
#$x =~ s/([%{}])/%$1/g;
|
|
$x =~ s/(\\|\$|[ ])/\\$1/g;
|
|
$x
|
|
}
|
|
|
|
my %ansi_table;
|
|
{
|
|
my ($i, $j, $k) = (0, 0, 0);
|
|
%ansi_table = (
|
|
# fe-common::core::formats.c:format_expand_styles
|
|
# do format_backs
|
|
(map { $_ => $terminfo->setab($i++) } (split //, '01234567' )),
|
|
# do format_fores
|
|
(map { $_ => $terminfo->setaf($j++) } (split //, 'krgybmcw' )),
|
|
# do bold_fores
|
|
(map { $_ => $terminfo->bold() .
|
|
$terminfo->setaf($k++) } (split //, 'KRGYBMCW')),
|
|
# reset
|
|
#(map { $_ => $terminfo->op() } (split //, 'nN')),
|
|
(map { $_ => $terminfo->op() } (split //, 'n')),
|
|
(map { $_ => "\033[0m" } (split //, 'N')), # XXX quick and DIRTY
|
|
# flash/bright
|
|
F => $terminfo->blink(),
|
|
# reverse
|
|
8 => $terminfo->rev(),
|
|
# bold
|
|
(map { $_ => $terminfo->bold() } (split //, '9_')),
|
|
# delete other stuff
|
|
(map { $_ => '' } (split //, ':|>#[')),
|
|
# escape
|
|
(map { $_ => $_ } (split //, '{}%')),
|
|
)
|
|
}
|
|
sub formats_to_ansi_basic {
|
|
my $o = shift;
|
|
$o =~ s/(%(.))/exists $ansi_table{$2} ? $ansi_table{$2} : $1/gex;
|
|
$o
|
|
}
|
|
|
|
sub lc1459 ($) { my $x = shift; $x =~ y/A-Z][\^/a-z}{|~/; $x }
|
|
Irssi::settings_add_str(setc, 'banned_channels', '');
|
|
Irssi::settings_add_bool(setc, 'banned_channels_on', 0);
|
|
my %banned_channels = map { lc1459($_) => undef }
|
|
split ' ', Irssi::settings_get_str('banned_channels');
|
|
Irssi::settings_add_str(setc, 'fancy_abbrev', 'fancy');
|
|
|
|
# }}}
|
|
|
|
# {{{ main
|
|
|
|
sub remake () {
|
|
#$callcount++;
|
|
#my $xx = $callcount; Irssi::print("starting remake [ $xx ]");
|
|
my ($hilight, $number, $display);
|
|
my $separator = '{sb_act_sep ' . Irssi::settings_get_str(set 'separator') .
|
|
'}';
|
|
my $custSort = Irssi::settings_get_str(set 'sort');
|
|
my $custSortDir = 1;
|
|
if ($custSort =~ /^[-!](.*)/) {
|
|
$custSortDir = -1;
|
|
$custSort = $1;
|
|
}
|
|
|
|
my @wins =
|
|
sort {
|
|
(
|
|
( (int($a->{$custSort}) <=> int($b->{$custSort})) * $custSortDir )
|
|
||
|
|
($a->{'refnum'} <=> $b->{'refnum'})
|
|
)
|
|
} Irssi::windows;
|
|
my $block = Irssi::settings_get_int(set 'block');
|
|
my $columns = $currentColumns;
|
|
my $oldActString = $actString if $SCREEN_MODE;
|
|
$actString = $SCREEN_MODE ? [' A W L'] : [];
|
|
my $line = $SCREEN_MODE ? 1 : 0;
|
|
my $width = $SCREEN_MODE
|
|
?
|
|
$screenWidth - abs($block)*$columns + 1
|
|
:
|
|
([Irssi::windows]->[0]{'width'} - sb_length('{sb x}'));
|
|
my $height = $screenHeight - abs(Irssi::settings_get_int(set
|
|
'height_adjust'));
|
|
my ($numPad, $keyPad) = (0, 0);
|
|
my %abbrevList;
|
|
if ($SCREEN_MODE or Irssi::settings_get_bool(set 'sbar_maxlength')
|
|
or ($block < 0)
|
|
) {
|
|
%abbrevList = ();
|
|
if (Irssi::settings_get_str('fancy_abbrev') !~ /^(no|off|head)/i) {
|
|
my @nameList = map { ref $_ ? $_->get_active_name : '' } @wins;
|
|
for (my $i = 0; $i < @nameList - 1; ++$i) {
|
|
my ($x, $y) = ($nameList[$i], $nameList[$i + 1]);
|
|
for ($x, $y) { s/^[+#!=]// }
|
|
my $res = Algorithm::LCSS::LCSS($x, $y);
|
|
if (defined $res) {
|
|
#Irssi::print("common pattern $x $y : $res");
|
|
#Irssi::print("found at $nameList[$i] ".index($nameList[$i],
|
|
# $res));
|
|
$abbrevList{$nameList[$i]} = int (index($nameList[$i], $res) +
|
|
(length($res) / 2));
|
|
#Irssi::print("found at ".$nameList[$i+1]." ".index($nameList[$i+1],
|
|
# $res));
|
|
$abbrevList{$nameList[$i+1]} = int (index($nameList[$i+1], $res) +
|
|
(length($res) / 2));
|
|
}
|
|
}
|
|
}
|
|
if ($SCREEN_MODE or ($block < 0)) {
|
|
$numPad = length((sort { length($b) <=> length($a) } keys %keymap)[0]);
|
|
$keyPad = length((sort { length($b) <=> length($a) } values %keymap)[0]);
|
|
}
|
|
}
|
|
if ($SCREEN_MODE) {
|
|
print STDERR $screenansi->dcs().
|
|
$terminfo->civis().
|
|
$terminfo->sc().
|
|
$screenansi->st();
|
|
if (@$oldActString < 1) {
|
|
print STDERR $screenansi->dcs().
|
|
$terminfo->cup(0, $width).
|
|
$actString->[0].
|
|
$terminfo->el().
|
|
$screenansi->st();
|
|
}
|
|
}
|
|
foreach my $win (@wins) {
|
|
unless ($SCREEN_MODE) {
|
|
$actString->[$line] = '' unless defined $actString->[$line]
|
|
or Irssi::settings_get_bool(set '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;
|
|
$name = '*' if (Irssi::settings_get_bool('banned_channels_on') and exists
|
|
$banned_channels{lc1459($name)});
|
|
$name = $win->{'name'} if $name ne '*' and $win->{'name'} ne ''
|
|
and Irssi::settings_get_bool(set 'prefer_name');
|
|
my $active = $win->{'active'};
|
|
my $colour = $win->{'hilight_color'};
|
|
if (!defined $colour) { $colour = ''; }
|
|
|
|
if ($win->{'data_level'} < Irssi::settings_get_int(set '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'};
|
|
my @display = ('display_nokey');
|
|
if (defined $keymap{$number} and $keymap{$number} ne '') {
|
|
unshift @display, map { (my $cpy = $_) =~ s/_no/_/; $cpy } @display;
|
|
}
|
|
if (Irssi::active_win->{'refnum'} == $number) {
|
|
unshift @display, map { my $cpy = $_; $cpy .= '_active'; $cpy } @display;
|
|
}
|
|
#Irssi::print("win $number [@display]: " . join '.', split //, join '<<', map {
|
|
# Irssi::settings_get_str(set $_) } @display);
|
|
$display = (grep { $_ }
|
|
map { Irssi::settings_get_str(set $_) }
|
|
@display)[0];
|
|
#Irssi::print("win $number : " . join '.', split //, $display);
|
|
|
|
if ($SCREEN_MODE or Irssi::settings_get_bool(set 'sbar_maxlength')
|
|
or ($block < 0)
|
|
) {
|
|
my $baseLength = sb_length(ir_escape(ir_ve(ir_parse_special_protected(sb_ctfe(
|
|
'{sb_background}' . expand($display,
|
|
C => ir_fe('x'),
|
|
N => $number . (' 'x($numPad - length($number))),
|
|
Q => ir_fe((' 'x($keyPad - length($keymap{$number}))) . $keymap{$number}),
|
|
H => $hilight,
|
|
S => '}{sb_background}'
|
|
), 1), $win)))) - 1;
|
|
my $diff = abs($block) - (length($name) + $baseLength);
|
|
if ($diff < 0) { # too long
|
|
if (abs($diff) >= length($name)) { $name = '' } # forget it
|
|
elsif (abs($diff) + 1 >= length($name)) { $name = substr($name,
|
|
0, 1); }
|
|
else {
|
|
my $middle = exists $abbrevList{$name} ?
|
|
(($abbrevList{$name} + (2*(length($name) / 2)))/3) :
|
|
((Irssi::settings_get_str('fancy_abbrev') =~ /^head/i) ?
|
|
length($name) :
|
|
(length($name) / 2));
|
|
my $cut = int($middle - (abs($diff) / 2) + .55);
|
|
$cut = 1 if $cut < 1;
|
|
$cut = length($name) - abs($diff) - 1 if $cut > (length($name) -
|
|
abs($diff) - 1);
|
|
$name = substr($name, 0, $cut) . '~' . substr($name, $cut +
|
|
abs($diff) + 1);
|
|
}
|
|
}
|
|
elsif ($SCREEN_MODE or ($block < 0)) {
|
|
$name .= (' ' x $diff);
|
|
}
|
|
}
|
|
|
|
my $add = ir_ve(ir_parse_special_protected(sb_ctfe('{sb_background}' . expand($display,
|
|
C => ir_fe($name),
|
|
N => $number . (' 'x($numPad - length($number))),
|
|
Q => ir_fe((' 'x($keyPad - length($keymap{$number}))) . $keymap{$number}),
|
|
H => $hilight,
|
|
S => '}{sb_background}'
|
|
), 1), $win));
|
|
if ($SCREEN_MODE) {
|
|
$actString->[$line] = $add;
|
|
if ((!defined $oldActString->[$line]
|
|
or $oldActString->[$line] ne $actString->[$line])
|
|
and
|
|
$line <= ($columns * $height)
|
|
) {
|
|
print STDERR $screenansi->dcs().
|
|
$terminfo->cup(($line-1) % $height+1, $width + (
|
|
abs($block) * int(($line-1) / $height))).
|
|
formats_to_ansi_basic(sb_expand(ir_escape($actString->[$line]))).
|
|
#$terminfo->el().
|
|
$screenansi->st();
|
|
}
|
|
$line++;
|
|
}
|
|
else {
|
|
#$temp =~ s/\{\S+?(?:\s(.*?))?\}/$1/g;
|
|
#$temp =~ s/\\\\\\\\/\\/g; # XXX I'm actually guessing here, someone point me
|
|
# # XXX to docs please
|
|
$actString->[$line] = '' unless defined $actString->[$line];
|
|
|
|
# XXX how can I check whether the content still fits in the bar? this would
|
|
# XXX allow awlstatus 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);
|
|
}
|
|
}
|
|
|
|
if ($SCREEN_MODE) {
|
|
while ($line <= ($columns * $height)) {
|
|
print STDERR $screenansi->dcs().
|
|
$terminfo->cup(($line-1) % $height+1, $width + (
|
|
abs($block) * int(($line-1) / $height))).
|
|
$terminfo->el().
|
|
$screenansi->st();
|
|
$line++;
|
|
}
|
|
print STDERR $screenansi->dcs().
|
|
$terminfo->rc().
|
|
$terminfo->cnorm().
|
|
$screenansi->st();
|
|
}
|
|
else {
|
|
# 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
|
|
my $x = $actString->[$p]; # properly, etc.
|
|
$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 awlHasChanged () {
|
|
$globTime = undef;
|
|
my $temp = ($SCREEN_MODE ?
|
|
"\\\n" . Irssi::settings_get_int(set 'block').
|
|
Irssi::settings_get_int(set 'height_adjust')
|
|
: "!\n" . Irssi::settings_get_str(set 'placement').
|
|
Irssi::settings_get_int(set 'position')).
|
|
Irssi::settings_get_str(set 'automode');
|
|
if ($temp ne $resetNeeded) { wlreset(); return; }
|
|
#Irssi::print("awl has changed, calls to remake so far: $callcount");
|
|
$needRemake = 1;
|
|
|
|
#remake();
|
|
if (
|
|
($SCREEN_MODE and !$DISABLE_SCREEN_TEMP)
|
|
or
|
|
($needRemake and Irssi::settings_get_bool(set 'all_disable'))
|
|
or
|
|
(!Irssi::settings_get_bool(set 'all_disable') and $currentLines < 1)
|
|
) {
|
|
$needRemake = undef;
|
|
remake();
|
|
}
|
|
|
|
unless ($SCREEN_MODE) {
|
|
# XXX Irssi crashes if I try to do this without timer, why ? What's the minimum
|
|
# XXX delay I need to use in the timer ?
|
|
Irssi::timeout_add_once(100, 'syncLines', undef);
|
|
|
|
for (keys %statusbars) {
|
|
Irssi::statusbar_items_redraw(set$_);
|
|
}
|
|
}
|
|
else {
|
|
Irssi::timeout_add_once(100, 'syncColumns', undef);
|
|
}
|
|
}
|
|
|
|
sub eventChanged () { # Implement a change queue/blocker -.-)
|
|
if (defined $globTime) {
|
|
Irssi::timeout_remove($globTime);
|
|
} # delay the update further
|
|
$globTime = Irssi::timeout_add_once(GLOB_QUEUE_TIMER, 'awlHasChanged', undef);
|
|
}
|
|
|
|
# }}}
|
|
|
|
|
|
# {{{ screen mode
|
|
|
|
sub screenFullRedraw {
|
|
my ($window) = @_;
|
|
if (!ref $window or $window->{'refnum'} == Irssi::active_win->{'refnum'}) {
|
|
$actString = [];
|
|
eventChanged();
|
|
}
|
|
}
|
|
|
|
sub screenSize { # from nicklist.pl
|
|
$screenResizing = 1;
|
|
# fit screen
|
|
system 'screen -x '.$ENV{'STY'}.' -X fit';
|
|
# get size
|
|
my ($row, $col) = split ' ', `stty size`;
|
|
# set screen width
|
|
$screenWidth = $col-1;
|
|
$screenHeight = $row-1;
|
|
|
|
# on some recent systems, "screen -X fit; screen -X width -w 50" doesn't work, needs a sleep in between the 2 commands
|
|
# so we wait a second before setting the width
|
|
Irssi::timeout_add_once(100, sub {
|
|
my ($new_irssi_width) = @_;
|
|
$new_irssi_width -= abs(Irssi::settings_get_int(set
|
|
'block'))*$currentColumns - 1;
|
|
system 'screen -x '.$ENV{'STY'}.' -X width -w ' . $new_irssi_width;
|
|
# and then we wait another second for the resizing, and then redraw.
|
|
Irssi::timeout_add_once(10,sub {$screenResizing = 0; screenFullRedraw()}, []);
|
|
}, $screenWidth);
|
|
}
|
|
|
|
sub screenOff {
|
|
my ($unloadMode) = @_;
|
|
Irssi::signal_remove('gui print text finished' => 'screenFullRedraw');
|
|
Irssi::signal_remove('gui page scrolled' => 'screenFullRedraw');
|
|
Irssi::signal_remove('window changed' => 'screenFullRedraw');
|
|
Irssi::signal_remove('window changed automatic' => 'screenFullRedraw');
|
|
if ($unloadMode) {
|
|
Irssi::signal_remove('terminal resized' => 'resizeTerm');
|
|
}
|
|
system 'screen -x '.$ENV{'STY'}.' -X fit';
|
|
}
|
|
|
|
sub syncColumns {
|
|
return if (@$actString == 0);
|
|
my $temp = $currentColumns;
|
|
#Irssi::print("current columns $temp");
|
|
my $height = $screenHeight - abs(Irssi::settings_get_int(set
|
|
'height_adjust'));
|
|
$currentColumns = int(($#$actString-1) / $height) + 1;
|
|
#Irssi::print("objects in actstring:".scalar(@$actString).", screen height:".
|
|
# $height);
|
|
my $currMaxColumns = Irssi::settings_get_int(set 'columns');
|
|
if ($currMaxColumns > 0 and $currentColumns > $currMaxColumns) {
|
|
$currentColumns = $currMaxColumns;
|
|
}
|
|
elsif ($currMaxColumns < 0) {
|
|
$currentColumns = abs($currMaxColumns);
|
|
}
|
|
return if ($temp == $currentColumns);
|
|
screenSize();
|
|
}
|
|
|
|
#$needRemake = 1;
|
|
sub resizeTerm () {
|
|
if ($SCREEN_MODE and !$screenResizing) {
|
|
$screenResizing = 1;
|
|
Irssi::timeout_add_once(10, 'screenSize', undef);
|
|
}
|
|
Irssi::timeout_add_once(100, 'eventChanged', undef);
|
|
}
|
|
|
|
# }}}
|
|
|
|
|
|
# {{{ settings add
|
|
|
|
Irssi::settings_add_str(setc, set 'display_nokey', '[$N]$H$C$S');
|
|
Irssi::settings_add_str(setc, set 'display_key', '[$Q=$N]$H$C$S');
|
|
Irssi::settings_add_str(setc, set 'display_nokey_active', '');
|
|
Irssi::settings_add_str(setc, set 'display_key_active', '');
|
|
Irssi::settings_add_str(setc, set 'separator', "\\ ");
|
|
Irssi::settings_add_bool(setc, set 'prefer_name', 0);
|
|
Irssi::settings_add_int(setc, set 'hide_data', 0);
|
|
Irssi::settings_add_int(setc, set 'maxlines', 9);
|
|
Irssi::settings_add_int(setc, set 'columns', 1);
|
|
Irssi::settings_add_int(setc, set 'block', 20);
|
|
Irssi::settings_add_bool(setc, set 'sbar_maxlength', 0);
|
|
Irssi::settings_add_int(setc, set 'height_adjust', 2);
|
|
Irssi::settings_add_str(setc, set 'sort', 'refnum');
|
|
Irssi::settings_add_str(setc, set 'placement', 'bottom');
|
|
Irssi::settings_add_int(setc, set 'position', 0);
|
|
Irssi::settings_add_bool(setc, set 'all_disable', 0);
|
|
Irssi::settings_add_str(setc, set 'automode', 'sbar');
|
|
|
|
# }}}
|
|
|
|
|
|
# {{{ init
|
|
|
|
sub wlreset {
|
|
$actString = [];
|
|
$currentLines = 0; # 1; # mhmmmm .. we actually enable one line down there so
|
|
# let's try this.
|
|
#update_keymap();
|
|
killOldStatus();
|
|
# Register statusbar
|
|
#add_statusbar(0);
|
|
#Irssi::command('statusbar wl0 enable');
|
|
my $was_screen_mode = $SCREEN_MODE;
|
|
if ($SCREEN_MODE = (Irssi::settings_get_str(set 'automode') =~ /screen/i)
|
|
and
|
|
!$was_screen_mode
|
|
) {
|
|
if (!defined $ENV{'STY'}) {
|
|
Irssi::print('Screen mode can only be used in GNU screen but no '.
|
|
'screen was found.', MSGLEVEL_CLIENTERROR);
|
|
$SCREEN_MODE = undef;
|
|
}
|
|
else {
|
|
Irssi::signal_add_last('gui print text finished' => 'screenFullRedraw');
|
|
Irssi::signal_add_last('gui page scrolled' => 'screenFullRedraw');
|
|
Irssi::signal_add('window changed' => 'screenFullRedraw');
|
|
Irssi::signal_add('window changed automatic' => 'screenFullRedraw');
|
|
}
|
|
}
|
|
elsif ($was_screen_mode and !$SCREEN_MODE) {
|
|
screenOff();
|
|
}
|
|
$resetNeeded = ($SCREEN_MODE ?
|
|
"\\\n" . Irssi::settings_get_int(set 'block').
|
|
Irssi::settings_get_int(set 'height_adjust')
|
|
: "!\n" . Irssi::settings_get_str(set 'placement').
|
|
Irssi::settings_get_int(set 'position')).
|
|
Irssi::settings_get_str(set 'automode');
|
|
resizeTerm();
|
|
}
|
|
|
|
wlreset();
|
|
|
|
# }}}
|
|
|
|
|
|
# {{{ unload/deinit
|
|
|
|
my $Unload;
|
|
sub unload ($$$) {
|
|
$Unload = 1;
|
|
# pretend we didn't do anything ASAP
|
|
Irssi::timeout_add_once(10, sub { $Unload = undef; }, undef);
|
|
}
|
|
# last try to catch a sigsegv
|
|
Irssi::signal_add_first('gui exit' => sub { $Unload = undef; });
|
|
sub UNLOAD {
|
|
# this might well crash Irssi... try /eval /script unload someotherscript ;
|
|
# /quit (= SEGFAULT !)
|
|
if ($Unload) {
|
|
$actString = ['']; # syncLines(); # XXX Irssi crashes when trying to disable
|
|
killOldStatus(); # XXX all statusbars ?
|
|
if ($SCREEN_MODE) {
|
|
screenOff('unload mode');
|
|
}
|
|
}
|
|
}
|
|
|
|
# }}}
|
|
|
|
|
|
# {{{ signals
|
|
|
|
sub addPrintTextHook { # update on print text
|
|
return if $_[0]->{'level'} == 262144 and $_[0]->{'target'} eq ''
|
|
and !defined($_[0]->{'server'});
|
|
if (Irssi::settings_get_str(set '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
|
|
|
|
# }}}
|
|
|
|
# {{{ commands
|
|
|
|
|
|
sub runsub {
|
|
my ($cmd) = @_;
|
|
sub {
|
|
my ($data, $server, $item) = @_;
|
|
Irssi::command_runsub($cmd, $data, $server, $item);
|
|
};
|
|
}
|
|
Irssi::command_bind( setc() => runsub(setc()) );
|
|
Irssi::command_bind( setc() . ' paste' => runsub(setc() . ' paste') );
|
|
Irssi::command_bind(
|
|
setc() . ' paste on' => sub {
|
|
return unless $SCREEN_MODE;
|
|
my $was_disabled = $DISABLE_SCREEN_TEMP;
|
|
$DISABLE_SCREEN_TEMP = 1;
|
|
Irssi::print('Paste mode is now ON, '.uc(setc()).' is temporarily '.
|
|
'disabled.');
|
|
if (!$was_disabled) {
|
|
$screenResizing = 1;
|
|
screenOff();
|
|
}
|
|
}
|
|
);
|
|
Irssi::command_bind(
|
|
setc() . ' paste off' => sub {
|
|
return unless $SCREEN_MODE;
|
|
my $was_disabled = $DISABLE_SCREEN_TEMP;
|
|
$DISABLE_SCREEN_TEMP = undef;
|
|
Irssi::print('Paste mode is now OFF, '.uc(setc()).' is enabled.');
|
|
if ($was_disabled) {
|
|
$SCREEN_MODE = undef;
|
|
$screenResizing = 0;
|
|
wlreset();
|
|
}
|
|
}
|
|
);
|
|
Irssi::command_bind(
|
|
setc() . ' paste toggle' => sub {
|
|
if ($DISABLE_SCREEN_TEMP) {
|
|
Irssi::command(setc() . ' paste off');
|
|
}
|
|
else {
|
|
Irssi::command(setc() . ' paste on');
|
|
}
|
|
}
|
|
);
|
|
Irssi::command_bind(
|
|
setc() . ' redraw' => sub {
|
|
return unless $SCREEN_MODE;
|
|
screenFullRedraw();
|
|
}
|
|
);
|
|
|
|
|
|
# }}}
|
|
|
|
# {{{ Algorithm::LCSS module
|
|
{
|
|
package Algorithm::Diff;
|
|
# Skip to first "=head" line for documentation.
|
|
use strict;
|
|
|
|
use integer; # see below in _replaceNextLargerWith() for mod to make
|
|
# if you don't use this
|
|
|
|
# McIlroy-Hunt diff algorithm
|
|
# Adapted from the Smalltalk code of Mario I. Wolczko, <mario@wolczko.com>
|
|
# by Ned Konz, perl@bike-nomad.com
|
|
# Updates by Tye McQueen, http://perlmonks.org/?node=tye
|
|
|
|
# Create a hash that maps each element of $aCollection to the set of
|
|
# positions it occupies in $aCollection, restricted to the elements
|
|
# within the range of indexes specified by $start and $end.
|
|
# The fourth parameter is a subroutine reference that will be called to
|
|
# generate a string to use as a key.
|
|
# Additional parameters, if any, will be passed to this subroutine.
|
|
#
|
|
# my $hashRef = _withPositionsOfInInterval( \@array, $start, $end, $keyGen );
|
|
|
|
sub _withPositionsOfInInterval
|
|
{
|
|
my $aCollection = shift; # array ref
|
|
my $start = shift;
|
|
my $end = shift;
|
|
my $keyGen = shift;
|
|
my %d;
|
|
my $index;
|
|
for ( $index = $start ; $index <= $end ; $index++ )
|
|
{
|
|
my $element = $aCollection->[$index];
|
|
my $key = &$keyGen( $element, @_ );
|
|
if ( exists( $d{$key} ) )
|
|
{
|
|
unshift ( @{ $d{$key} }, $index );
|
|
}
|
|
else
|
|
{
|
|
$d{$key} = [$index];
|
|
}
|
|
}
|
|
return wantarray ? %d : \%d;
|
|
}
|
|
|
|
# Find the place at which aValue would normally be inserted into the
|
|
# array. If that place is already occupied by aValue, do nothing, and
|
|
# return undef. If the place does not exist (i.e., it is off the end of
|
|
# the array), add it to the end, otherwise replace the element at that
|
|
# point with aValue. It is assumed that the array's values are numeric.
|
|
# This is where the bulk (75%) of the time is spent in this module, so
|
|
# try to make it fast!
|
|
|
|
sub _replaceNextLargerWith
|
|
{
|
|
my ( $array, $aValue, $high ) = @_;
|
|
$high ||= $#$array;
|
|
|
|
# off the end?
|
|
if ( $high == -1 || $aValue > $array->[-1] )
|
|
{
|
|
push ( @$array, $aValue );
|
|
return $high + 1;
|
|
}
|
|
|
|
# binary search for insertion point...
|
|
my $low = 0;
|
|
my $index;
|
|
my $found;
|
|
while ( $low <= $high )
|
|
{
|
|
$index = ( $high + $low ) / 2;
|
|
|
|
# $index = int(( $high + $low ) / 2); # without 'use integer'
|
|
$found = $array->[$index];
|
|
|
|
if ( $aValue == $found )
|
|
{
|
|
return undef;
|
|
}
|
|
elsif ( $aValue > $found )
|
|
{
|
|
$low = $index + 1;
|
|
}
|
|
else
|
|
{
|
|
$high = $index - 1;
|
|
}
|
|
}
|
|
|
|
# now insertion point is in $low.
|
|
$array->[$low] = $aValue; # overwrite next larger
|
|
return $low;
|
|
}
|
|
|
|
# This method computes the longest common subsequence in $a and $b.
|
|
|
|
# Result is array or ref, whose contents is such that
|
|
# $a->[ $i ] == $b->[ $result[ $i ] ]
|
|
# foreach $i in ( 0 .. $#result ) if $result[ $i ] is defined.
|
|
|
|
# An additional argument may be passed; this is a hash or key generating
|
|
# function that should return a string that uniquely identifies the given
|
|
# element. It should be the case that if the key is the same, the elements
|
|
# will compare the same. If this parameter is undef or missing, the key
|
|
# will be the element as a string.
|
|
|
|
# By default, comparisons will use "eq" and elements will be turned into keys
|
|
# using the default stringizing operator '""'.
|
|
|
|
# Additional parameters, if any, will be passed to the key generation
|
|
# routine.
|
|
|
|
sub _longestCommonSubsequence
|
|
{
|
|
my $a = shift; # array ref or hash ref
|
|
my $b = shift; # array ref or hash ref
|
|
my $counting = shift; # scalar
|
|
my $keyGen = shift; # code ref
|
|
my $compare; # code ref
|
|
|
|
if ( ref($a) eq 'HASH' )
|
|
{ # prepared hash must be in $b
|
|
my $tmp = $b;
|
|
$b = $a;
|
|
$a = $tmp;
|
|
}
|
|
|
|
# Check for bogus (non-ref) argument values
|
|
if ( !ref($a) || !ref($b) )
|
|
{
|
|
my @callerInfo = caller(1);
|
|
die 'error: must pass array or hash references to ' . $callerInfo[3];
|
|
}
|
|
|
|
# set up code refs
|
|
# Note that these are optimized.
|
|
if ( !defined($keyGen) ) # optimize for strings
|
|
{
|
|
$keyGen = sub { $_[0] };
|
|
$compare = sub { my ( $a, $b ) = @_; $a eq $b };
|
|
}
|
|
else
|
|
{
|
|
$compare = sub {
|
|
my $a = shift;
|
|
my $b = shift;
|
|
&$keyGen( $a, @_ ) eq &$keyGen( $b, @_ );
|
|
};
|
|
}
|
|
|
|
my ( $aStart, $aFinish, $matchVector ) = ( 0, $#$a, [] );
|
|
my ( $prunedCount, $bMatches ) = ( 0, {} );
|
|
|
|
if ( ref($b) eq 'HASH' ) # was $bMatches prepared for us?
|
|
{
|
|
$bMatches = $b;
|
|
}
|
|
else
|
|
{
|
|
my ( $bStart, $bFinish ) = ( 0, $#$b );
|
|
|
|
# First we prune off any common elements at the beginning
|
|
while ( $aStart <= $aFinish
|
|
and $bStart <= $bFinish
|
|
and &$compare( $a->[$aStart], $b->[$bStart], @_ ) )
|
|
{
|
|
$matchVector->[ $aStart++ ] = $bStart++;
|
|
$prunedCount++;
|
|
}
|
|
|
|
# now the end
|
|
while ( $aStart <= $aFinish
|
|
and $bStart <= $bFinish
|
|
and &$compare( $a->[$aFinish], $b->[$bFinish], @_ ) )
|
|
{
|
|
$matchVector->[ $aFinish-- ] = $bFinish--;
|
|
$prunedCount++;
|
|
}
|
|
|
|
# Now compute the equivalence classes of positions of elements
|
|
$bMatches =
|
|
_withPositionsOfInInterval( $b, $bStart, $bFinish, $keyGen, @_ );
|
|
}
|
|
my $thresh = [];
|
|
my $links = [];
|
|
|
|
my ( $i, $ai, $j, $k );
|
|
for ( $i = $aStart ; $i <= $aFinish ; $i++ )
|
|
{
|
|
$ai = &$keyGen( $a->[$i], @_ );
|
|
if ( exists( $bMatches->{$ai} ) )
|
|
{
|
|
$k = 0;
|
|
for $j ( @{ $bMatches->{$ai} } )
|
|
{
|
|
|
|
# optimization: most of the time this will be true
|
|
if ( $k and $thresh->[$k] > $j and $thresh->[ $k - 1 ] < $j )
|
|
{
|
|
$thresh->[$k] = $j;
|
|
}
|
|
else
|
|
{
|
|
$k = _replaceNextLargerWith( $thresh, $j, $k );
|
|
}
|
|
|
|
# oddly, it's faster to always test this (CPU cache?).
|
|
if ( defined($k) )
|
|
{
|
|
$links->[$k] =
|
|
[ ( $k ? $links->[ $k - 1 ] : undef ), $i, $j ];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if (@$thresh)
|
|
{
|
|
return $prunedCount + @$thresh if $counting;
|
|
for ( my $link = $links->[$#$thresh] ; $link ; $link = $link->[0] )
|
|
{
|
|
$matchVector->[ $link->[1] ] = $link->[2];
|
|
}
|
|
}
|
|
elsif ($counting)
|
|
{
|
|
return $prunedCount;
|
|
}
|
|
|
|
return wantarray ? @$matchVector : $matchVector;
|
|
}
|
|
|
|
sub traverse_sequences
|
|
{
|
|
my $a = shift; # array ref
|
|
my $b = shift; # array ref
|
|
my $callbacks = shift || {};
|
|
my $keyGen = shift;
|
|
my $matchCallback = $callbacks->{'MATCH'} || sub { };
|
|
my $discardACallback = $callbacks->{'DISCARD_A'} || sub { };
|
|
my $finishedACallback = $callbacks->{'A_FINISHED'};
|
|
my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { };
|
|
my $finishedBCallback = $callbacks->{'B_FINISHED'};
|
|
my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ );
|
|
|
|
# Process all the lines in @$matchVector
|
|
my $lastA = $#$a;
|
|
my $lastB = $#$b;
|
|
my $bi = 0;
|
|
my $ai;
|
|
|
|
for ( $ai = 0 ; $ai <= $#$matchVector ; $ai++ )
|
|
{
|
|
my $bLine = $matchVector->[$ai];
|
|
if ( defined($bLine) ) # matched
|
|
{
|
|
&$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine;
|
|
&$matchCallback( $ai, $bi++, @_ );
|
|
}
|
|
else
|
|
{
|
|
&$discardACallback( $ai, $bi, @_ );
|
|
}
|
|
}
|
|
|
|
# The last entry (if any) processed was a match.
|
|
# $ai and $bi point just past the last matching lines in their sequences.
|
|
|
|
while ( $ai <= $lastA or $bi <= $lastB )
|
|
{
|
|
|
|
# last A?
|
|
if ( $ai == $lastA + 1 and $bi <= $lastB )
|
|
{
|
|
if ( defined($finishedACallback) )
|
|
{
|
|
&$finishedACallback( $lastA, @_ );
|
|
$finishedACallback = undef;
|
|
}
|
|
else
|
|
{
|
|
&$discardBCallback( $ai, $bi++, @_ ) while $bi <= $lastB;
|
|
}
|
|
}
|
|
|
|
# last B?
|
|
if ( $bi == $lastB + 1 and $ai <= $lastA )
|
|
{
|
|
if ( defined($finishedBCallback) )
|
|
{
|
|
&$finishedBCallback( $lastB, @_ );
|
|
$finishedBCallback = undef;
|
|
}
|
|
else
|
|
{
|
|
&$discardACallback( $ai++, $bi, @_ ) while $ai <= $lastA;
|
|
}
|
|
}
|
|
|
|
&$discardACallback( $ai++, $bi, @_ ) if $ai <= $lastA;
|
|
&$discardBCallback( $ai, $bi++, @_ ) if $bi <= $lastB;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub traverse_balanced
|
|
{
|
|
my $a = shift; # array ref
|
|
my $b = shift; # array ref
|
|
my $callbacks = shift || {};
|
|
my $keyGen = shift;
|
|
my $matchCallback = $callbacks->{'MATCH'} || sub { };
|
|
my $discardACallback = $callbacks->{'DISCARD_A'} || sub { };
|
|
my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { };
|
|
my $changeCallback = $callbacks->{'CHANGE'};
|
|
my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ );
|
|
|
|
# Process all the lines in match vector
|
|
my $lastA = $#$a;
|
|
my $lastB = $#$b;
|
|
my $bi = 0;
|
|
my $ai = 0;
|
|
my $ma = -1;
|
|
my $mb;
|
|
|
|
while (1)
|
|
{
|
|
|
|
# Find next match indices $ma and $mb
|
|
do {
|
|
$ma++;
|
|
} while(
|
|
$ma <= $#$matchVector
|
|
&& !defined $matchVector->[$ma]
|
|
);
|
|
|
|
last if $ma > $#$matchVector; # end of matchVector?
|
|
$mb = $matchVector->[$ma];
|
|
|
|
# Proceed with discard a/b or change events until
|
|
# next match
|
|
while ( $ai < $ma || $bi < $mb )
|
|
{
|
|
|
|
if ( $ai < $ma && $bi < $mb )
|
|
{
|
|
|
|
# Change
|
|
if ( defined $changeCallback )
|
|
{
|
|
&$changeCallback( $ai++, $bi++, @_ );
|
|
}
|
|
else
|
|
{
|
|
&$discardACallback( $ai++, $bi, @_ );
|
|
&$discardBCallback( $ai, $bi++, @_ );
|
|
}
|
|
}
|
|
elsif ( $ai < $ma )
|
|
{
|
|
&$discardACallback( $ai++, $bi, @_ );
|
|
}
|
|
else
|
|
{
|
|
|
|
# $bi < $mb
|
|
&$discardBCallback( $ai, $bi++, @_ );
|
|
}
|
|
}
|
|
|
|
# Match
|
|
&$matchCallback( $ai++, $bi++, @_ );
|
|
}
|
|
|
|
while ( $ai <= $lastA || $bi <= $lastB )
|
|
{
|
|
if ( $ai <= $lastA && $bi <= $lastB )
|
|
{
|
|
|
|
# Change
|
|
if ( defined $changeCallback )
|
|
{
|
|
&$changeCallback( $ai++, $bi++, @_ );
|
|
}
|
|
else
|
|
{
|
|
&$discardACallback( $ai++, $bi, @_ );
|
|
&$discardBCallback( $ai, $bi++, @_ );
|
|
}
|
|
}
|
|
elsif ( $ai <= $lastA )
|
|
{
|
|
&$discardACallback( $ai++, $bi, @_ );
|
|
}
|
|
else
|
|
{
|
|
|
|
# $bi <= $lastB
|
|
&$discardBCallback( $ai, $bi++, @_ );
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub prepare
|
|
{
|
|
my $a = shift; # array ref
|
|
my $keyGen = shift; # code ref
|
|
|
|
# set up code ref
|
|
$keyGen = sub { $_[0] } unless defined($keyGen);
|
|
|
|
return scalar _withPositionsOfInInterval( $a, 0, $#$a, $keyGen, @_ );
|
|
}
|
|
|
|
sub LCS
|
|
{
|
|
my $a = shift; # array ref
|
|
my $b = shift; # array ref or hash ref
|
|
my $matchVector = _longestCommonSubsequence( $a, $b, 0, @_ );
|
|
my @retval;
|
|
my $i;
|
|
for ( $i = 0 ; $i <= $#$matchVector ; $i++ )
|
|
{
|
|
if ( defined( $matchVector->[$i] ) )
|
|
{
|
|
push ( @retval, $a->[$i] );
|
|
}
|
|
}
|
|
return wantarray ? @retval : \@retval;
|
|
}
|
|
|
|
sub LCS_length
|
|
{
|
|
my $a = shift; # array ref
|
|
my $b = shift; # array ref or hash ref
|
|
return _longestCommonSubsequence( $a, $b, 1, @_ );
|
|
}
|
|
|
|
sub LCSidx
|
|
{
|
|
my $a= shift @_;
|
|
my $b= shift @_;
|
|
my $match= _longestCommonSubsequence( $a, $b, 0, @_ );
|
|
my @am= grep defined $match->[$_], 0..$#$match;
|
|
my @bm= @{$match}[@am];
|
|
return \@am, \@bm;
|
|
}
|
|
|
|
sub compact_diff
|
|
{
|
|
my $a= shift @_;
|
|
my $b= shift @_;
|
|
my( $am, $bm )= LCSidx( $a, $b, @_ );
|
|
my @cdiff;
|
|
my( $ai, $bi )= ( 0, 0 );
|
|
push @cdiff, $ai, $bi;
|
|
while( 1 ) {
|
|
while( @$am && $ai == $am->[0] && $bi == $bm->[0] ) {
|
|
shift @$am;
|
|
shift @$bm;
|
|
++$ai, ++$bi;
|
|
}
|
|
push @cdiff, $ai, $bi;
|
|
last if ! @$am;
|
|
$ai = $am->[0];
|
|
$bi = $bm->[0];
|
|
push @cdiff, $ai, $bi;
|
|
}
|
|
push @cdiff, 0+@$a, 0+@$b
|
|
if $ai < @$a || $bi < @$b;
|
|
return wantarray ? @cdiff : \@cdiff;
|
|
}
|
|
|
|
sub diff
|
|
{
|
|
my $a = shift; # array ref
|
|
my $b = shift; # array ref
|
|
my $retval = [];
|
|
my $hunk = [];
|
|
my $discard = sub {
|
|
push @$hunk, [ '-', $_[0], $a->[ $_[0] ] ];
|
|
};
|
|
my $add = sub {
|
|
push @$hunk, [ '+', $_[1], $b->[ $_[1] ] ];
|
|
};
|
|
my $match = sub {
|
|
push @$retval, $hunk
|
|
if 0 < @$hunk;
|
|
$hunk = []
|
|
};
|
|
traverse_sequences( $a, $b,
|
|
{ MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add }, @_ );
|
|
&$match();
|
|
return wantarray ? @$retval : $retval;
|
|
}
|
|
|
|
sub sdiff
|
|
{
|
|
my $a = shift; # array ref
|
|
my $b = shift; # array ref
|
|
my $retval = [];
|
|
my $discard = sub { push ( @$retval, [ '-', $a->[ $_[0] ], "" ] ) };
|
|
my $add = sub { push ( @$retval, [ '+', "", $b->[ $_[1] ] ] ) };
|
|
my $change = sub {
|
|
push ( @$retval, [ 'c', $a->[ $_[0] ], $b->[ $_[1] ] ] );
|
|
};
|
|
my $match = sub {
|
|
push ( @$retval, [ 'u', $a->[ $_[0] ], $b->[ $_[1] ] ] );
|
|
};
|
|
traverse_balanced(
|
|
$a,
|
|
$b,
|
|
{
|
|
MATCH => $match,
|
|
DISCARD_A => $discard,
|
|
DISCARD_B => $add,
|
|
CHANGE => $change,
|
|
},
|
|
@_
|
|
);
|
|
return wantarray ? @$retval : $retval;
|
|
}
|
|
|
|
########################################
|
|
my $Root= __PACKAGE__;
|
|
package Algorithm::Diff::_impl;
|
|
use strict;
|
|
|
|
sub _Idx() { 0 } # $me->[_Idx]: Ref to array of hunk indices
|
|
# 1 # $me->[1]: Ref to first sequence
|
|
# 2 # $me->[2]: Ref to second sequence
|
|
sub _End() { 3 } # $me->[_End]: Diff between forward and reverse pos
|
|
sub _Same() { 4 } # $me->[_Same]: 1 if pos 1 contains unchanged items
|
|
sub _Base() { 5 } # $me->[_Base]: Added to range's min and max
|
|
sub _Pos() { 6 } # $me->[_Pos]: Which hunk is currently selected
|
|
sub _Off() { 7 } # $me->[_Off]: Offset into _Idx for current position
|
|
sub _Min() { -2 } # Added to _Off to get min instead of max+1
|
|
|
|
sub Die
|
|
{
|
|
require Carp;
|
|
Carp::confess( @_ );
|
|
}
|
|
|
|
sub _ChkPos
|
|
{
|
|
my( $me )= @_;
|
|
return if $me->[_Pos];
|
|
my $meth= ( caller(1) )[3];
|
|
Die( "Called $meth on 'reset' object" );
|
|
}
|
|
|
|
sub _ChkSeq
|
|
{
|
|
my( $me, $seq )= @_;
|
|
return $seq + $me->[_Off]
|
|
if 1 == $seq || 2 == $seq;
|
|
my $meth= ( caller(1) )[3];
|
|
Die( "$meth: Invalid sequence number ($seq); must be 1 or 2" );
|
|
}
|
|
|
|
sub getObjPkg
|
|
{
|
|
my( $us )= @_;
|
|
return ref $us if ref $us;
|
|
return $us . "::_obj";
|
|
}
|
|
|
|
sub new
|
|
{
|
|
my( $us, $seq1, $seq2, $opts ) = @_;
|
|
my @args;
|
|
for( $opts->{keyGen} ) {
|
|
push @args, $_ if $_;
|
|
}
|
|
for( $opts->{keyGenArgs} ) {
|
|
push @args, @$_ if $_;
|
|
}
|
|
my $cdif= Algorithm::Diff::compact_diff( $seq1, $seq2, @args );
|
|
my $same= 1;
|
|
if( 0 == $cdif->[2] && 0 == $cdif->[3] ) {
|
|
$same= 0;
|
|
splice @$cdif, 0, 2;
|
|
}
|
|
my @obj= ( $cdif, $seq1, $seq2 );
|
|
$obj[_End] = (1+@$cdif)/2;
|
|
$obj[_Same] = $same;
|
|
$obj[_Base] = 0;
|
|
my $me = bless \@obj, $us->getObjPkg();
|
|
$me->Reset( 0 );
|
|
return $me;
|
|
}
|
|
|
|
sub Reset
|
|
{
|
|
my( $me, $pos )= @_;
|
|
$pos= int( $pos || 0 );
|
|
$pos += $me->[_End]
|
|
if $pos < 0;
|
|
$pos= 0
|
|
if $pos < 0 || $me->[_End] <= $pos;
|
|
$me->[_Pos]= $pos || !1;
|
|
$me->[_Off]= 2*$pos - 1;
|
|
return $me;
|
|
}
|
|
|
|
sub Base
|
|
{
|
|
my( $me, $base )= @_;
|
|
my $oldBase= $me->[_Base];
|
|
$me->[_Base]= 0+$base if defined $base;
|
|
return $oldBase;
|
|
}
|
|
|
|
sub Copy
|
|
{
|
|
my( $me, $pos, $base )= @_;
|
|
my @obj= @$me;
|
|
my $you= bless \@obj, ref($me);
|
|
$you->Reset( $pos ) if defined $pos;
|
|
$you->Base( $base );
|
|
return $you;
|
|
}
|
|
|
|
sub Next {
|
|
my( $me, $steps )= @_;
|
|
$steps= 1 if ! defined $steps;
|
|
if( $steps ) {
|
|
my $pos= $me->[_Pos];
|
|
my $new= $pos + $steps;
|
|
$new= 0 if $pos && $new < 0;
|
|
$me->Reset( $new )
|
|
}
|
|
return $me->[_Pos];
|
|
}
|
|
|
|
sub Prev {
|
|
my( $me, $steps )= @_;
|
|
$steps= 1 if ! defined $steps;
|
|
my $pos= $me->Next(-$steps);
|
|
$pos -= $me->[_End] if $pos;
|
|
return $pos;
|
|
}
|
|
|
|
sub Diff {
|
|
my( $me )= @_;
|
|
$me->_ChkPos();
|
|
return 0 if $me->[_Same] == ( 1 & $me->[_Pos] );
|
|
my $ret= 0;
|
|
my $off= $me->[_Off];
|
|
for my $seq ( 1, 2 ) {
|
|
$ret |= $seq
|
|
if $me->[_Idx][ $off + $seq + _Min ]
|
|
< $me->[_Idx][ $off + $seq ];
|
|
}
|
|
return $ret;
|
|
}
|
|
|
|
sub Min {
|
|
my( $me, $seq, $base )= @_;
|
|
$me->_ChkPos();
|
|
my $off= $me->_ChkSeq($seq);
|
|
$base= $me->[_Base] if !defined $base;
|
|
return $base + $me->[_Idx][ $off + _Min ];
|
|
}
|
|
|
|
sub Max {
|
|
my( $me, $seq, $base )= @_;
|
|
$me->_ChkPos();
|
|
my $off= $me->_ChkSeq($seq);
|
|
$base= $me->[_Base] if !defined $base;
|
|
return $base + $me->[_Idx][ $off ] -1;
|
|
}
|
|
|
|
sub Range {
|
|
my( $me, $seq, $base )= @_;
|
|
$me->_ChkPos();
|
|
my $off = $me->_ChkSeq($seq);
|
|
if( !wantarray ) {
|
|
return $me->[_Idx][ $off ]
|
|
- $me->[_Idx][ $off + _Min ];
|
|
}
|
|
$base= $me->[_Base] if !defined $base;
|
|
return ( $base + $me->[_Idx][ $off + _Min ] )
|
|
.. ( $base + $me->[_Idx][ $off ] - 1 );
|
|
}
|
|
|
|
sub Items {
|
|
my( $me, $seq )= @_;
|
|
$me->_ChkPos();
|
|
my $off = $me->_ChkSeq($seq);
|
|
if( !wantarray ) {
|
|
return $me->[_Idx][ $off ]
|
|
- $me->[_Idx][ $off + _Min ];
|
|
}
|
|
return
|
|
@{$me->[$seq]}[
|
|
$me->[_Idx][ $off + _Min ]
|
|
.. ( $me->[_Idx][ $off ] - 1 )
|
|
];
|
|
}
|
|
|
|
sub Same {
|
|
my( $me )= @_;
|
|
$me->_ChkPos();
|
|
return wantarray ? () : 0
|
|
if $me->[_Same] != ( 1 & $me->[_Pos] );
|
|
return $me->Items(1);
|
|
}
|
|
|
|
my %getName;
|
|
%getName= (
|
|
same => \&Same,
|
|
diff => \&Diff,
|
|
base => \&Base,
|
|
min => \&Min,
|
|
max => \&Max,
|
|
range=> \&Range,
|
|
items=> \&Items, # same thing
|
|
);
|
|
|
|
sub Get
|
|
{
|
|
my $me= shift @_;
|
|
$me->_ChkPos();
|
|
my @value;
|
|
for my $arg ( @_ ) {
|
|
for my $word ( split ' ', $arg ) {
|
|
my $meth;
|
|
if( $word !~ /^(-?\d+)?([a-zA-Z]+)([12])?$/
|
|
|| not $meth= $getName{ lc $2 }
|
|
) {
|
|
Die( $Root, ", Get: Invalid request ($word)" );
|
|
}
|
|
my( $base, $name, $seq )= ( $1, $2, $3 );
|
|
push @value, scalar(
|
|
4 == length($name)
|
|
? $meth->( $me )
|
|
: $meth->( $me, $seq, $base )
|
|
);
|
|
}
|
|
}
|
|
if( wantarray ) {
|
|
return @value;
|
|
} elsif( 1 == @value ) {
|
|
return $value[0];
|
|
}
|
|
Die( 0+@value, " values requested from ",
|
|
$Root, "'s Get in scalar context" );
|
|
}
|
|
|
|
|
|
my $Obj= getObjPkg($Root);
|
|
no strict 'refs';
|
|
|
|
for my $meth ( qw( new getObjPkg ) ) {
|
|
*{$Root."::".$meth} = \&{$meth};
|
|
*{$Obj ."::".$meth} = \&{$meth};
|
|
}
|
|
for my $meth ( qw(
|
|
Next Prev Reset Copy Base Diff
|
|
Same Items Range Min Max Get
|
|
_ChkPos _ChkSeq
|
|
) ) {
|
|
*{$Obj."::".$meth} = \&{$meth};
|
|
}
|
|
|
|
};
|
|
{
|
|
package Algorithm::LCSS;
|
|
|
|
use strict;
|
|
{
|
|
no strict 'refs';
|
|
*traverse_sequences = \&Algorithm::Diff::traverse_sequences;
|
|
}
|
|
|
|
sub _tokenize { [split //, $_[0]] }
|
|
|
|
sub CSS {
|
|
my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
|
|
my ( $seq1, $seq2, @match, $from_match );
|
|
my $i = 0;
|
|
if ( $is_array ) {
|
|
$seq1 = $_[0];
|
|
$seq2 = $_[1];
|
|
traverse_sequences( $seq1, $seq2, {
|
|
MATCH => sub { push @{$match[$i]}, $seq1->[$_[0]]; $from_match = 1 },
|
|
DISCARD_A => sub { do{$i++; $from_match = 0} if $from_match },
|
|
DISCARD_B => sub { do{$i++; $from_match = 0} if $from_match },
|
|
});
|
|
}
|
|
else {
|
|
$seq1 = _tokenize($_[0]);
|
|
$seq2 = _tokenize($_[1]);
|
|
traverse_sequences( $seq1, $seq2, {
|
|
MATCH => sub { $match[$i] .= $seq1->[$_[0]]; $from_match = 1 },
|
|
DISCARD_A => sub { do{$i++; $from_match = 0} if $from_match },
|
|
DISCARD_B => sub { do{$i++; $from_match = 0} if $from_match },
|
|
});
|
|
}
|
|
return \@match;
|
|
}
|
|
|
|
sub CSS_Sorted {
|
|
my $match = CSS(@_);
|
|
if ( ref $_[0] eq 'ARRAY' ) {
|
|
@$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,scalar(@$_)]}@$match
|
|
}
|
|
else {
|
|
@$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,length($_)]}@$match
|
|
}
|
|
return $match;
|
|
}
|
|
|
|
sub LCSS {
|
|
my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
|
|
my $css = CSS(@_);
|
|
my $index;
|
|
my $length = 0;
|
|
if ( $is_array ) {
|
|
for( my $i = 0; $i < @$css; $i++ ) {
|
|
next unless @{$css->[$i]}>$length;
|
|
$index = $i;
|
|
$length = @{$css->[$i]};
|
|
}
|
|
}
|
|
else {
|
|
for( my $i = 0; $i < @$css; $i++ ) {
|
|
next unless length($css->[$i])>$length;
|
|
$index = $i;
|
|
$length = length($css->[$i]);
|
|
}
|
|
}
|
|
return $css->[$index];
|
|
}
|
|
|
|
};
|
|
# }}}
|
|
#{{{ Class::Classless module
|
|
{
|
|
package Class::Classless;
|
|
use strict;
|
|
use vars qw(@ISA);
|
|
use Carp;
|
|
|
|
@ISA = ();
|
|
|
|
###########################################################################
|
|
|
|
@Class::Classless::X::ISA = ();
|
|
|
|
###########################################################################
|
|
###########################################################################
|
|
|
|
sub Class::Classless::X::AUTOLOAD {
|
|
# This's the big dispatcher.
|
|
|
|
my $it = shift @_;
|
|
my $m = ($Class::Classless::X::AUTOLOAD =~ m/([^:]+)$/s )
|
|
? $1 : $Class::Classless::X::AUTOLOAD;
|
|
|
|
croak "Can't call Class::Classless methods (like $m) without an object"
|
|
unless ref $it; # sanity, basically.
|
|
|
|
my $prevstate;
|
|
$prevstate = ${shift @_}
|
|
if scalar(@_) && defined($_[0]) &&
|
|
ref($_[0]) eq 'Class::Classless::CALLSTATE::SHIMMY'
|
|
; # A shim! we were called via $callstate->NEXT
|
|
|
|
my $no_fail = $prevstate ? $prevstate->[3] : undef;
|
|
my $i = $prevstate ? ($prevstate->[1] + 1) : 0;
|
|
# where to start scanning
|
|
my $lineage;
|
|
|
|
# Get the linearization of the ISA tree
|
|
if($prevstate) {
|
|
$lineage = $prevstate->[2];
|
|
} elsif(defined $it->{'ISA_CACHE'} and ref $it->{'ISA_CACHE'} ){
|
|
$lineage = $it->{'ISA_CACHE'};
|
|
} else {
|
|
$lineage = [ &Class::Classless::X::ISA_TREE($it) ];
|
|
}
|
|
|
|
# Was:
|
|
#my @lineage =
|
|
# $prevstate ? @{$prevstate->[2]}
|
|
# : &Class::Classless::X::ISA_TREE($it);
|
|
# # Get the linearization of the ISA tree
|
|
# # ISA-memoization happens in the ISA_TREE function.
|
|
|
|
for(; $i < @$lineage; ++$i) {
|
|
|
|
if( !defined($no_fail) and exists($lineage->[$i]{'NO_FAIL'}) ) {
|
|
$no_fail = ($lineage->[$i]{'NO_FAIL'} || 0);
|
|
# so the first NO_FAIL sets it
|
|
}
|
|
|
|
if( ref($lineage->[$i]{'METHODS'} || 0) # sanity
|
|
&& exists($lineage->[$i]{'METHODS'}{$m})
|
|
){
|
|
# We found what we were after. Now see what to do with it.
|
|
my $v = $lineage->[$i]{'METHODS'}{$m};
|
|
return $v unless defined $v and ref $v;
|
|
|
|
if(ref($v) eq 'CODE') { # normal case, I expect!
|
|
# Used to have copying of the arglist here.
|
|
# But it was apparently useless, so I deleted it
|
|
unshift @_,
|
|
$it, # $_[0] -- target object
|
|
# a NEW callstate
|
|
bless([$m, $i, $lineage, $no_fail, $prevstate ? 1 : 0],
|
|
'Class::Classless::CALLSTATE'
|
|
), # $_[1] -- the callstate
|
|
;
|
|
goto &{ $v }; # yes, magic goto! bimskalabim!
|
|
}
|
|
return @$v if ref($v) eq '_deref_array';
|
|
return $$v if ref($v) eq '_deref_scalar';
|
|
return $v; # fallthru
|
|
}
|
|
}
|
|
|
|
if($m eq 'DESTROY') { # mitigate DESTROY-lookup failure at global destruction
|
|
# should be impossible
|
|
} else {
|
|
if($no_fail || 0) {
|
|
return;
|
|
}
|
|
croak "Can't find ", $prevstate ? 'NEXT method' : 'method',
|
|
" $m in ", $it->{'NAME'} || $it,
|
|
" or any ancestors\n";
|
|
}
|
|
}
|
|
|
|
###########################################################################
|
|
###########################################################################
|
|
|
|
sub Class::Classless::X::DESTROY {
|
|
# noop
|
|
}
|
|
|
|
###########################################################################
|
|
sub Class::Classless::X::ISA_TREE {
|
|
# The linearizer!
|
|
# Returns the search path for $_[0], starting with $_[0]
|
|
# Possibly memoized.
|
|
|
|
# I stopped being able to understand this algorithm about five
|
|
# minutes after I wrote it.
|
|
use strict;
|
|
|
|
my $set_cache = 0; # flag to set the cache on the way out
|
|
|
|
if(exists($_[0]{'ISA_CACHE'})) {
|
|
return @{$_[0]{'ISA_CACHE'}}
|
|
if defined $_[0]{'ISA_CACHE'}
|
|
and ref $_[0]{'ISA_CACHE'};
|
|
|
|
# Otherwise, if exists but is not a ref, it's a signal that it should
|
|
# be replaced at the earliest, with a listref
|
|
$set_cache = 1;
|
|
}
|
|
|
|
my $has_mi = 0; # set to 0 on the first node we see with 2 parents!
|
|
# First, just figure out what's in the tree.
|
|
my %last_child = ($_[0] => 1); # as if already seen
|
|
|
|
# if $last_child{$x} == $y, that means:
|
|
# 1) incidentally, we've passed the node $x before.
|
|
# 2) $x is the last child of $y,
|
|
# so that means that $y can be pushed to the stack only after
|
|
# we've pushed $x to the stack.
|
|
|
|
my @tree_nodes;
|
|
{
|
|
my $current;
|
|
my @in_stack = ($_[0]);
|
|
while(@in_stack) {
|
|
next unless
|
|
defined($current = shift @in_stack)
|
|
&& ref($current) # sanity
|
|
&& ref($current->{'PARENTS'} || 0) # sanity
|
|
;
|
|
|
|
push @tree_nodes, $current;
|
|
|
|
$has_mi = 1 if @{$current->{'PARENTS'}} > 1;
|
|
unshift
|
|
@in_stack,
|
|
map {
|
|
if(exists $last_child{$_}) { # seen before!
|
|
$last_child{$_} = $current;
|
|
(); # seen -- don't re-explore
|
|
} else { # first time seen
|
|
$last_child{$_} = $current;
|
|
$_; # first time seen -- explore now
|
|
}
|
|
}
|
|
@{$current->{'PARENTS'}}
|
|
;
|
|
}
|
|
|
|
# If there was no MI, then that first scan was sufficient.
|
|
unless($has_mi) {
|
|
$_[0]{'ISA_CACHE'} = \@tree_nodes if $set_cache;
|
|
return @tree_nodes;
|
|
}
|
|
|
|
# Otherwise, toss this list and rescan, consulting %last_child
|
|
}
|
|
|
|
# $last_child{$parent} holds the last (or only) child of $parent
|
|
# in this tree. When walking the tree this time, only that
|
|
# child is authorized to put its parent on the @in_stack.
|
|
# And that's the only way a node can get added to @in_stack,
|
|
# except for $_[0] (the start node) being there at the beginning.
|
|
|
|
# Now, walk again, but this time exploring parents the LAST
|
|
# time seen in the tree, not the first.
|
|
|
|
my @out;
|
|
{
|
|
my $current;
|
|
my @in_stack = ($_[0]);
|
|
while(@in_stack) {
|
|
next unless defined($current = shift @in_stack) && ref($current);
|
|
push @out, $current; # finally.
|
|
unshift
|
|
@in_stack,
|
|
grep(
|
|
(
|
|
defined($_) # sanity
|
|
&& ref($_) # sanity
|
|
&& $last_child{$_} eq $current,
|
|
),
|
|
# I'm lastborn (or onlyborn) of this parent
|
|
# so it's OK to explore now
|
|
@{$current->{'PARENTS'}}
|
|
)
|
|
if ref($current->{'PARENTS'} || 0) # sanity
|
|
;
|
|
}
|
|
|
|
unless(scalar(@out) == scalar(keys(%last_child))) {
|
|
# the counts should be equal
|
|
my %good_ones;
|
|
@good_ones{@out} = ();
|
|
croak
|
|
"ISA tree for " .
|
|
($_[0]{'NAME'} || $_[0]) .
|
|
" is apparently cyclic, probably involving the nodes " .
|
|
nodelist( grep { ref($_) && !exists $good_ones{$_} }
|
|
values(%last_child) )
|
|
. "\n";
|
|
}
|
|
}
|
|
#print "Contents of out: ", nodelist(@out), "\n";
|
|
|
|
$_[0]{'ISA_CACHE'} = \@out if $set_cache;
|
|
return @out;
|
|
}
|
|
|
|
###########################################################################
|
|
|
|
sub Class::Classless::X::can { # NOT like UNIVERSAL::can ...
|
|
# return 1 if $it is capable of the method given -- otherwise 0
|
|
my($it, $m) = @_[0,1];
|
|
return undef unless ref $it;
|
|
|
|
croak "undef is not a valid method name" unless defined($m);
|
|
croak "null-string is not a valid method name" unless length($m);
|
|
|
|
foreach my $o (&Class::Classless::X::ISA_TREE($it)) {
|
|
return 1
|
|
if ref($o->{'METHODS'} || 0) # sanity
|
|
&& exists $o->{'METHODS'}{$m};
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
|
|
###########################################################################
|
|
|
|
sub Class::Classless::X::isa { # Like UNIVERSAL::isa
|
|
# Returns true for $X->isa($Y) iff $Y is $X or is an ancestor of $X.
|
|
|
|
return unless ref($_[0]) && ref($_[1]);
|
|
return scalar(grep {$_ eq $_[1]} &Class::Classless::X::ISA_TREE($_[0]));
|
|
}
|
|
|
|
###########################################################################
|
|
|
|
sub nodelist { join ', ', map { "" . ($_->{'NAME'} || $_) . ""} @_ }
|
|
|
|
###########################################################################
|
|
###########################################################################
|
|
###########################################################################
|
|
# Methods for the CALLSTATE class.
|
|
# Basically, CALLSTATE objects represent the state of the dispatcher,
|
|
# frozen at the moment when the method call was dispatched to the
|
|
# appropriate sub.
|
|
# In the grand scheme of things, this needn't be a class -- I could
|
|
# have just made the callstate data-object be a hash with documented
|
|
# keys, or a closure that responded to only certain parameters,
|
|
# etc. But I like it this way. And I like being able to say simply
|
|
# $cs->NEXT
|
|
# Yes, these are a bit cryptically written, but it's behoovy for
|
|
# them to be very very efficient.
|
|
|
|
@Class::Classless::ISA = ();
|
|
sub Class::Classless::CALLSTATE::found_name { $_[0][0] }
|
|
# the method name called and found
|
|
sub Class::Classless::CALLSTATE::found_depth { $_[0][1] }
|
|
# my depth in the lineage
|
|
sub Class::Classless::CALLSTATE::lineage { @{$_[0][2]} }
|
|
# my lineage
|
|
sub Class::Classless::CALLSTATE::target { $_[0][2][ 0 ] }
|
|
# the object that's the target -- same as $_[0] for the method called
|
|
sub Class::Classless::CALLSTATE::home { $_[0][2][ $_[0][1] ] }
|
|
# the object I was found in
|
|
sub Class::Classless::CALLSTATE::sub_found {
|
|
$_[0][2][ $_[0][1] ]{'METHODS'}{ $_[0][0] }
|
|
} # the routine called
|
|
|
|
sub Class::Classless::CALLSTATE::no_fail { $_[0][3] }
|
|
sub Class::Classless::CALLSTATE::set_no_fail_true { $_[0][3] = 1 }
|
|
sub Class::Classless::CALLSTATE::set_fail_false { $_[0][3] = 0 }
|
|
sub Class::Classless::CALLSTATE::set_fail_undef { $_[0][3] = undef }
|
|
|
|
sub Class::Classless::CALLSTATE::via_next { $_[0][4] }
|
|
|
|
sub Class::Classless::CALLSTATE::NEXT {
|
|
#croak "NEXT needs at least one argument: \$cs->NEXT('method'...)"
|
|
# unless @_ > 1;
|
|
# no longer true.
|
|
my $cs = shift @_;
|
|
my $m = shift @_; # which may be (or come out) undef...
|
|
$m = $cs->[0] unless defined $m; # the method name called and found
|
|
|
|
($cs->[2][0])->$m(
|
|
bless( \$cs, 'Class::Classless::CALLSTATE::SHIMMY' ),
|
|
@_
|
|
);
|
|
}
|
|
|
|
###########################################################################
|
|
};
|
|
#}}}
|
|
|
|
###############
|
|
###
|
|
#
|
|
# {{{ *** C h a n g e l o g ***
|
|
#
|
|
# 0.6ca
|
|
# - add screen support (from nicklist.pl)
|
|
# - rename to adv_windowlist.pl (advanced window list) since it isn't just a
|
|
# window list status bar (wlstat) anymore
|
|
# - names can now have a max length and window names can be used
|
|
# - fixed a bug with block display in screen mode and statusbar mode
|
|
# - added space handling to ir_fe and removed it again
|
|
# - now handling formats on my own
|
|
# - added warning about missing sb_act_none abstract leading to
|
|
# - display*active settings
|
|
# - added warning about the bug in awl_display_(no)key_active settings
|
|
#
|
|
# 0.5d
|
|
# - add setting to also hide the last statusbar if empty (awl_all_disable)
|
|
# - reverted to old utf8 code to also calculate broken utf8 length correctly
|
|
# - simplified dealing with statusbars in wlreset
|
|
# - added a little tweak for the renamed term_type somewhere after Irssi 0.8.9
|
|
# - fixed bug in handling channel #$$
|
|
# - typo on line 200 spotted by f0rked
|
|
# - reset background colour at the beginning of an entry
|
|
#
|
|
# 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 awl_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
|
|
# }}}
|
|
# vim: se fdm=marker tw=80 :
|