#!/usr/bin/perl
use strict;
use warnings;
use File::Spec ();
use Data::Dumper;
BEGIN { use lib File::Spec->catdir( Xchat::get_info('xchatdir'), 'lib' ); }
use N0i::Xchat::Colors;
my $o = N0i::Xchat::Colors->new(

# INTRO:
########
# The basic control code for adding color to your output is %Cfg[,bg]
#
# Color codes may be integers from 0 up to 15
# Color palette may be configured by accessing:
#          Settings -> Interface -> Colors
# Default looks something like this:
#   0 => white
#   1 => black
#   2 => blue
#   3 => green
#   4 => red
#   5 => dark red
#   6 => magenta
#   7 => brown
#   8 => yellow
#   9 => light green
#  10 => cyan
#  11 => bright cyan
#  12 => bright blue
#  13 => pink
#  14 => gray
#  15 => light gray
#
# Excerpts from XChat's official documentation:
# %C     -  Control-C (mIRC color code)
# %Cforeground,background will produce a color code, eg: %C03,10
#
# %B     -  Bold Text
# %U     -  Underline Text
# %R     -  Reverse Text
########
# colors definitions are formed as:
#    'color key' , 'nick regular expression'
#
# 'nick regular expression' = are precompiled regular expressions (qr/..../)
# 'color key' = may be anything as documented in control codes above, without
#               prepending '%' in front
#
# NOTE that terms in array are parsed in order! So keep "default" the latest
# one to avoid misbehaving
# NOTE 2: patterns DO NOT NEED ^ and $ in front/back! 

### CHANGE SETTINGS AS YOU WISH

	# Color patterns definitions:
	# -> AoA with color code as first field and RegExp as second field.
	colors => [
		# red: IRC-Services (MUST BE THE 1ST PATTERN!)
		[ 4,	qr/./o ],

		# various highlighted patterns
		[ 10,	qr/(?i:n0i(?:\.net)?|#?noi|#?perl)/o ],
		[ 10,	qr/(?i:linux|redhat|debian|suse|mandrake|slackware)/o ],
		[ 10,	qr{(?i:(?i:ht|f)tps?://\S+|www\d?\.\S+)}o ],

		# nicknames colorization
		[ 4,	qr/(?i:A[B0-9]|Z[Z0-9])/o ],
		[ 12,	qr/(?i:altblue|nop|hlt|jmp|nul|foo)_*/o ],
		[ 9,	qr/_*(?i:galez|green)_*/o ],
		[ 8,	qr/_*(?i:cozy|zarrok|burzum|haras|bubu)_*/o ],
		[ 14,	qr/_*(?i:rav|helminthe|tirnacopu|zbang)_*/o ],
		[ 11,	qr/_*(?i:taz|mituc|sod|char|diablo)_*/o ],
		[ 7,	qr/_*(?i:iulica|gabim|xcyborg|guzu|thevert)_*/o ],
		[ 13,	qr/_*(?i:mituc|cage|ionut|voodoo|gody|sondy|ogru)_*/o ],
		[ 6,	qr/_*(?i:mishoo|cris|wink|green|bibi)_*/o ],

		# default one, keep it latest!
		[ 0,	qr/./o ],

	],

	# What to use for highlighting lines?
	# \cB = bold,
	# \cU = underline,
	# \cV = reverse
	hilite => "\cC1,23 ",
	hilite_off => " \cC1,0",

	# opposite to highlighting ;-]
	lolite => "\cC14",
	lolite_off => "\cC1",

	# switch context for join/part/etc messages?
	# (moving them into the network tab would clean up very much
	#  the channel tab, leaving there only chatter) :)
	# NOTE that this works as a channel target RegExp!
	switch => qr{^$},
#	switch => qr{.},

	# Are there any server CAPAB enabled?
	capab => {
		# is CAPAB IDENTIFY-MSG active?
		identify_msg => 1,
		# is CAPAB IDENTIFY-CTCP active?
		identify_ctcp => 1,
	},

###############################################################################
# That should be all you needed editing.
# Place this script into your ~/.xchat2 directory and fire xchat up.
# Enjoy.
###############################################################################

) or die "Fucked up: $!\n";

$o->register;

sub whoami {
	my $level = shift || 1;
	local $_= (caller($level))[3];
	s/^.+:://;
	$_;
}

sub print_handler {
    my ($cmd, $data) = @_;
    my ($nick, $message) = @$data;
    $nick ||= '';   # shouldn't happen!
    $message ||= '';
    my $imsg = '';
    if ($o->capab('identify_msg') || $o->capab('identify_ctcp')) {
    	$message =~ s/^([+-])// and $imsg = $1;
    }

	# xchat is fucked up at this point if it was a CTCP request
	if ($imsg && $message =~ s/^\x01(.*)\x01$/$1/) {
		if ($message =~ s/^ACTION //) {
			$cmd =~ s/_msg/_act/;
		}
	}

    if ($cmd =~ /^(?:chan_msg|chan_msg_hi|ur_msg)$/) {
        # removes mode char
        # - no longer necessary in 2.4.x as it seems to be provided ad an extra arg
        $message =~ s/[+@] $//;
    } else {
        # remove all padding spaces
        $message =~ s/\s+$//;
        # leave starting space alone.. maybe it's useful to someone :)
        # $message =~ s/^\s+//;
    }
    if ($cmd =~ /_hi$/) {
        # highlight entire line
        $message = $o->hilite . $message . $o->hilite_off;
    }
    if ($imsg eq '-') {
        # "low"-light entire line
        $message = $o->lolite . $message . $o->lolite_off;
    }


    $nick =~ s{\cC\d+(?:,\d+)?}{}g;

#	$o->_debug({ nick => $nick, imsg => $imsg, message => $message, cmd => $cmd });

    print_event($o->pevent($cmd), $o->Ncolor($nick, ($imsg eq '+')), $o->colorize($message));
}

sub print_event {
    local $_ = shift;
    my @options;
	my @args = ('dummy');

	foreach (@_) {
		if (ref($_) && ref($_) eq 'ARRAY') {
    		@options = @$_;
		} else {
			push @args, $_;
		}
	}

    for (my $i=1; $i<@args; $i++) {
	    s/\$$i/$args[$i]/g;
    }

    Xchat::print($_, @options);
    Xchat::EAT_ALL;
}

foreach ($o->handlers) {
    my ($event, $cmd, $has, $switch) = @$_;
    $o->hook( Xchat::hook_print($event, $cmd) );
    next if $has;
    eval qq{ sub $cmd { return print_handler('$cmd', \@_) } };
}

sub chan_join {
    my ($nick, $channel, $mask) = @{$_[0]};
    $mask =~ s/\s+$//;
    print_event($o->pevent(whoami), $o->Ncolor($nick), $channel, $mask);
}

sub chan_part {
    my ($nick, $message, $channel) = @{$_[0]};
    print_event($o->pevent(whoami), $o->Ncolor($nick), $message, $channel);
}

sub ctcp_gen {
    my ($type, @muci) = @{$_[0]};
    my $nick = $o->Ncolor(pop @muci);
    if (@muci) {
        $nick .= ' (' . join(' ', @muci) . ')';
    }
    print_event($o->pevent(whoami), $type, $nick);
}

sub ctcp_gen_chan {
    my ($type, @muci) = @{$_[0]};
    my $nick = pop @muci;
    my $channel = $o->colorize(Xchat::get_info('channel'));
    if (@muci) {
        $channel .= ' [' . join(' ', @muci) . ']';
    }
    print_event($o->pevent(whoami), $type, $o->Ncolor($nick), $channel);
}

sub invited {
    my ($channel, $nick, $server) = @{$_[0]};
    print_event($o->pevent(whoami), $o->colorize($channel),
                                            $o->Ncolor($nick), $server);
}

sub irc_quit {
    my ($nick, $reason, $mask) = @{$_[0]};
    my $one = $o->Ncolor($nick);
    $one .= " ($mask)" if $mask;
    print_event($o->pevent(whoami), $one, $reason || '');
}

sub mode_generic {
    my ($nick, $sign, $flag, $channel) = @{$_[0]};
    print_event($o->pevent(whoami), $o->Ncolor($nick), $sign, $flag,
                                                $o->colorize($channel));
}

sub mode_kick {
    my ($nick, $who, $channel, $why) = @{$_[0]};
    print_event($o->pevent(whoami), $o->Ncolor($nick), $o->Ncolor($who),
                $o->colorize($channel), $o->colorize($why) );
}

sub notice_chan {
    my ($nick, $channel, $message) = @{$_[0]};
    print_event($o->pevent(whoami), $o->Ncolor($nick), $channel,
                                                $o->colorize($message));
}

sub part_w_reason {
    my ($nick, $mask, $channel, $reason) = @{$_[0]};
    print_event($o->pevent(whoami), $o->Ncolor($nick), $mask,
                $o->colorize($channel), $o->colorize($reason) );
}

sub you_kicked {
    my ($nick, $channel, $who, $why) = @{$_[0]};
    print_event($o->pevent(whoami), '', $o->colorize($channel),
                        $o->Ncolor($who), $o->colorize($why));
}

sub topic_change {
    my ($nick, @muci) = @{$_[0]};
    my $channel = pop @muci;
    my $message = $o->colorize(join(' ', @muci));
    print_event($o->pevent(whoami), $o->Ncolor($nick), $message);
}

sub topic_create {
    my ($channel, $nick, $message) = @{$_[0]};
    print_event($o->pevent(whoami), $channel, $o->Ncolor($nick), $message);
}

$o->loaded;