X-Git-Url: http://git.vpit.fr/?p=perl%2Fscripts%2Fxchat.git;a=blobdiff_plain;f=Xchat%2FXPI%2FUtils.pm;h=c8994abd6b5e7ed616be2247390560e9c074a31f;hp=8df6c0e61465ecbc1a271abc37669161b5be2fa2;hb=HEAD;hpb=9db5de0ec290fd8b82a9c510e0d627b31e44d9bd diff --git a/Xchat/XPI/Utils.pm b/Xchat/XPI/Utils.pm index 8df6c0e..c8994ab 100644 --- a/Xchat/XPI/Utils.pm +++ b/Xchat/XPI/Utils.pm @@ -5,26 +5,100 @@ use warnings; use Xchat qw<:all>; -use lib get_info 'xchatdir'; -use Xchat::XPI qw; - our $VERSION = '0.02'; +sub irc_lc { + my ($bytes) = @_; + + $bytes =~ y/A-Z[\\]^/a-z{|}~/; + + return $bytes; +} + +my @rcolors; +BEGIN { + if (nickcmp(get_info('version'), '2.4.0') < 0) { + @rcolors = (3, 4, 6, 8, 9, 10, 11, 12, 13); + } else { + @rcolors = (19, 20, 22, 24, 25, 26, 27, 28, 29); + } +} + sub dye_nick { - my ($nick, $col) = ($_[0], 0); - $col += ord for split //, $nick; - my @rcolors = (nickcmp(get_info('version'), '2.4.0') < 0) - ? (3, 4, 6, 8, 9, 10, 11, 12, 13) - : (19, 20, 22, 24, 25, 26, 27, 28, 29); - $col %= @rcolors; - return sprintf "\003%d%s", $rcolors[$col], $nick; + my $nick = $_[0]; + my $col = 0; + $col += ord for split //, $nick; + return sprintf "\003%d%s", $rcolors[$col % @rcolors], $nick; } -use base qw; - +my %gui_commands = ( + 'clear' => [ 'COLOR 0' ], + 'highlight' => [ 'FLASH' => 'COLOR 3' ], +); + +sub gui { + my $commands = $gui_commands{$_[0] || 'nope'}; + die 'Invalid command' unless defined $commands; + command "GUI $_" for @$commands; +} + +sub save_context { + my $cur_cxt = get_context; + bless \$cur_cxt, 'Xchat::XPI::Utils::ContextGuard'; +} + +sub local_context { + return unless @_ >= 2; + my $code = pop; + my $new_cxt = (@_ == 1) ? $_[0] : find_context(@_); + return undef unless defined $new_cxt; + my $cur_cxt = get_context; + my $guard = bless \$cur_cxt, 'Xchat::XPI::Utils::ContextGuard'; + if (set_context $new_cxt) { + return $code->(); + } else { + return undef; + } +} + +sub Xchat::XPI::Utils::ContextGuard::DESTROY { + set_context ${$_[0]}; +} + +sub called_from_script (&) { + my $code = shift; + my $level = 0; + my ($package, $filename); + while (1) { + my @frame = caller $level; + last unless @frame; + if ($frame[0] !~ /^(?:Xchat|HexChat)::XPI\b/) { + ($package, $filename) = @frame[0, 1]; + last; + } + ++$level; + } + if (defined $filename) { + my $internal_package = Xchat::Embed::file2pkg($filename); + my $mock = sub { $internal_package, $package }; + no warnings 'redefine'; + local *Xchat::Embed::find_pkg = $mock; + local *HexChat::Embed::find_pkg = $mock; + $code->(); + } +} + +use base qw; + our @EXPORT = (); -our %EXPORT_TAGS = ('funcs' => [ qw ]); +our %EXPORT_TAGS = ('funcs' => [ qw< + irc_lc + dye_nick + gui + save_context local_context + called_from_script +> ]); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{'all'} = [ @EXPORT_OK ]; - + 1;