X-Git-Url: http://git.vpit.fr/?p=perl%2Fscripts%2Fxchat.git;a=blobdiff_plain;f=Xchat%2FXPI%2FUtils.pm;h=c8994abd6b5e7ed616be2247390560e9c074a31f;hp=ad99f0ff0162b140e40634d560a0c4a1d7fc49df;hb=HEAD;hpb=edd1cbfd1a969e16d8df9988eb448a53c97c02e7 diff --git a/Xchat/XPI/Utils.pm b/Xchat/XPI/Utils.pm index ad99f0f..c8994ab 100644 --- a/Xchat/XPI/Utils.pm +++ b/Xchat/XPI/Utils.pm @@ -7,6 +7,14 @@ use Xchat qw<:all>; 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) { @@ -23,6 +31,17 @@ sub dye_nick { return sprintf "\003%d%s", $rcolors[$col % @rcolors], $nick; } +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'; @@ -32,9 +51,10 @@ 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) { - my $guard = bless \$cur_cxt, 'Xchat::XPI::Utils::ContextGuard'; return $code->(); } else { return undef; @@ -45,12 +65,38 @@ 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< + irc_lc dye_nick + gui save_context local_context + called_from_script > ]); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];