<<q=~q>>;
	     script: Activeify
	     author: b0at
	       date: 3 November 2005
	    license: public domain
	
	description: Show user-configurable events in the current/active tab
	
	--Changes--
	   001->002: quiet option, multiple events per add/del, improved emit-hook 
	             loop prevention, PERSISTENT activeified events
		002->002.1: take list out of the stupid loop on load
		002.x->003: add wildcard event name matching (like in Tabify)

	--Instructions--
	Please use the latest version of X-Chat 2.
	
	No changes are necessary to this script unless it doesn't work.
	TRY IT FIRST.
q

### CONFIGURABLE OPTIONS ####

# None.

#############################

use strict;
use warnings;
use Storable qw( store retrieve ); # core
use Xchat qw( :all ); sub prnt { Xchat::print \@_ }

use constant CONFIG  => '_activeify.conf'; # requires wd to be xchatdir
chdir( get_info('xchatdir') );
my $CMD    = 'activeify';

register(
	my $NAME    = "Activeify",
	my $VERSION = "003",
	"Show events in the current/active tab (use /$CMD)"
);
prnt "\cB$NAME $VERSION\cB by b0at (use /$CMD)"; # announce
my $PREFIX = "\cB$NAME\cB\t";
my $USAGE  = <<USAGE;
Usage: $CMD <+|add|-|del> <event>[, <event>[, ...]], add (+) or delete (-) text event(s) from activeify list
       $CMD <?|list>, list currently activified events
		 For less verbose output, append 'q' to the operator. Errors will still display.
		 example: $CMD + Channel Message, Notice
					 $CMD +q Part, Join
USAGE
hook_command($CMD, \&user_command, { help_text => $USAGE } );

# get event list from our own conf!
my %events;
if( open( my $pevents, '<', 
	'pevents.conf'
	) )
{ 
	%events = 
		map { chomp; s/\s*event_name\s*=\s*//; lc($_) => $_ } # parse out names
		grep{/event_name=/} <$pevents>; # event names
	close $pevents;
}
else { # can't get list, do our best
	prnt "$PREFIX Unable to open pevents.conf (tried '",get_info('xchatdir'),'/pevents.conf',"') to get event list. The script will still work, but all event names must have correct case ('activeify + Channel Message' will work, but 'activeify + channel message' will not).";
}

# keep track of current user context
my $curr = get_context();
hook_print($_, sub { $curr = get_context(); EAT_NONE })
	for 'Focus Tab', 'Focus Window';
	
# activeified event hooks
my ($hooks, $config);
if( -e CONFIG ) { $hooks = retrieve(CONFIG) } # existing
elsif( open my $config, '>', CONFIG ) { # new
	close $config;
	store $hooks = {}, CONFIG;
	prnt "$PREFIX Successfully created new config file.";
}

if( not $hooks ) {
	prnt "$PREFIX Unable to open or create config file (tried '",CONFIG,"'). Changes will not persist.";
	$hooks = {};
} else { $config = 1 }

# rehook persisting events
for( keys %$hooks ) {
	delete $hooks->{$_};
	command("$CMD +q $_"); # quiet
#	command("$CMD listq");  # show events
}
command("$CMD listq");  # show events

# user command
sub user_command {
	my ($w, $e) = @_;
	my $events  = [split/\s*,\s*/, $e->[2]||''];
	my $action  = lc $w->[1];
	my $quiet   = ( $action and $action =~ s/q$//i );
	
	for( $action ) {
		# list events
		if( /^(l(|ist)|\?)$/ ) {
			if( %$hooks ) {
				prnt "$PREFIX Currently activeifying: ", join(', ',keys%$hooks);
			} elsif( not $quiet ) {
				prnt "$PREFIX Currently activeifying: no events";
			}
		}
		# add events
		elsif( /^(a(|dd?)|\+)$/ ) {
			prnt $USAGE unless @$events;
			prnt "$PREFIX There are no known events matching that pattern." unless $events = expand_events($events);
			
			for my $event (@$events) {
				if( not %events # account for missing pevents
					or exists( $events{lc $event} ) )
				{
					$hooks->{lc$event} = hook_print( $events{lc$event}, # get proper name to work
						\&activeify, { data => { event => $events{lc$event}||$event , 
						emitted => 0 } } ); # not emitted: hooked.
					prnt "$PREFIX Now activeifying '",$events{lc$event}||$event,"'." unless $quiet;
				}
				else { prnt "$PREFIX The event '$event' does not exist." }
			}
			store $hooks, CONFIG if $config; # update config
		}
		# delete events
		elsif( /^(d(|el(|ete))|-)$/ ) {
			prnt $USAGE unless @$events;
			prnt "$PREFIX There are no known events matching that pattern." unless $events = expand_events($events);
			
			for my $event (@$events) {
				if( exists $hooks->{lc$event} ) {
					for( lc$event ) { unhook $hooks->{$_}; delete $hooks->{$_}; }
					prnt "$PREFIX '",$events{lc$event}||$event,"' de-activeified." unless $quiet;
				}
				else { prnt "$PREFIX The event '$event' is not currently activeified." }
			}
			store $hooks, CONFIG if $config; # update config
		}
		else { prnt $USAGE }
	}
	return EAT_XCHAT;
}

sub activeify {
	my ($values, $data) = @_;

	$data->{emitted} = ! $data->{emitted};

	# avoid emit-hook loop: continue IFF not emitted
	if( $data->{emitted} ) { # if from original hook
		hook_timer(0, sub{ # emit after this handler
			set_context( $curr );
			emit_print( $data->{event}, @$values ); 
			return Xchat::REMOVE;
		});
		return EAT_XCHAT; # hide from this context
	} # if emitted
	return EAT_NONE; # keep in this context (the active one)
}

sub expand_events {
	my @re = map { $_ = wildcard($_); qr{^$_$}i } @{ shift() };
	my @events;
	
	for my $e ( keys %events ) {
INNER:for my $r ( @re ) {
			if( $e =~ $r ) {
				push @events, $e;
				last INNER;
			}
		}
	}
	@events? return \@events : return;
}


sub wildcard { # convert wc to re
	# quote meta characters coming in
	my $w = "\Q$_[0]\E"; # makes <*> -> <\*>

	# need to find and replace quotmeta'd '\\'.'\*' now, not just '\*'
	$w =~ s!\\\?     !\E(.)\Q!gx;   # one character
	$w =~ s!\\\*(?=.)!\E(.*?)\Q!gx; # non-greedy required here
	$w =~ s!\\\*    $!\E(.*)\Q!gx;  # greedy required here
	# bug fix: using .+ to find chars after '*' was skipping later wildcards,
	# should've used a look-ahead to begin with

	return $w;
}


__END__