Rebrand Perl plugin to HexChat,

Add /pl and plugin_pref

Add help messages
This commit is contained in:
Farow 2013-10-02 17:47:56 +03:00 committed by Eustachy Kapusta
parent aafbb6374b
commit 075cc61c94
10 changed files with 792 additions and 652 deletions

View File

@ -1,6 +1,6 @@
EXTRA_DIST=alt_completion.pl generate_header lib/Xchat.pm lib/Xchat/Embed.pm lib/Xchat/List/Network.pm \ EXTRA_DIST=alt_completion.pl generate_header lib/HexChat.pm lib/Xchat.pm lib/HexChat/Embed.pm lib/HexChat/List/Network.pm \
lib/Xchat/List/Network/Entry.pm lib/Xchat/List/Network/AutoJoin.pm lib/IRC.pm lib/HexChat/List/Network/Entry.pm lib/HexChat/List/Network/AutoJoin.pm lib/IRC.pm
libdir = $(hexchatlibdir) libdir = $(hexchatlibdir)
@ -8,11 +8,11 @@ lib_LTLIBRARIES = perl.la
perl_la_SOURCES = perl.c perl_la_SOURCES = perl.c
perl_la_LDFLAGS = -avoid-version -module perl_la_LDFLAGS = -avoid-version -module
perl_la_LIBADD = $(PERL_LDFLAGS) perl_la_LIBADD = $(PERL_LDFLAGS)
BUILT_SOURCES = xchat.pm.h irc.pm.h BUILT_SOURCES = hexchat.pm.h irc.pm.h
#CFLAGS = @CFLAGS@ -Wno-unused #CFLAGS = @CFLAGS@ -Wno-unused
AM_CPPFLAGS = $(PERL_CFLAGS) $(COMMON_CFLAGS) -I$(srcdir)/../../src/common AM_CPPFLAGS = $(PERL_CFLAGS) $(COMMON_CFLAGS) -I$(srcdir)/../../src/common
CLEANFILES = xchat.pm.h irc.pm.h CLEANFILES = hexchat.pm.h irc.pm.h
xchat.pm.h irc.pm.h: lib/Xchat.pm lib/Xchat/Embed.pm \ hexchat.pm.h irc.pm.h: lib/HexChat.pm lib/Xchat.pm lib/HexChat/Embed.pm \
lib/Xchat/List/Network.pm lib/Xchat/List/Network/Entry.pm \ lib/HexChat/List/Network.pm lib/HexChat/List/Network/Entry.pm \
lib/Xchat/List/Network/AutoJoin.pm lib/IRC.pm lib/HexChat/List/Network/AutoJoin.pm lib/IRC.pm
perl generate_header perl generate_header

View File

@ -25,12 +25,13 @@ sub toc {
} }
for my $files ( for my $files (
[ "xchat.pm.h", # output file [ "hexchat.pm.h", # output file
"lib/Xchat.pm", # input files "lib/HexChat.pm", # input files
"lib/Xchat/Embed.pm", "lib/Xchat.pm",
"lib/Xchat/List/Network.pm", "lib/HexChat/Embed.pm",
"lib/Xchat/List/Network/Entry.pm", "lib/HexChat/List/Network.pm",
"lib/Xchat/List/Network/AutoJoin.pm", "lib/HexChat/List/Network/Entry.pm",
"lib/HexChat/List/Network/AutoJoin.pm",
], ],
[ "irc.pm.h", # output file [ "irc.pm.h", # output file
"lib/IRC.pm" # input file "lib/IRC.pm" # input file

556
plugins/perl/lib/HexChat.pm Normal file
View File

@ -0,0 +1,556 @@
$SIG{__WARN__} = sub {
my $message = shift @_;
my ($package) = caller;
# redirect Gtk/Glib errors and warnings back to STDERR
my $message_levels = qr/ERROR|CRITICAL|WARNING|MESSAGE|INFO|DEBUG/i;
if( $message =~ /^(?:Gtk|GLib|Gdk)(?:-\w+)?-$message_levels/i ) {
print STDERR $message;
} else {
if( defined &HexChat::Internal::print ) {
HexChat::print( $message );
} else {
warn $message;
}
}
};
use File::Spec ();
use File::Basename ();
use File::Glob ();
use List::Util ();
use Symbol();
use Time::HiRes ();
use Carp ();
package HexChat;
use base qw(Exporter);
use strict;
use warnings;
sub PRI_HIGHEST ();
sub PRI_HIGH ();
sub PRI_NORM ();
sub PRI_LOW ();
sub PRI_LOWEST ();
sub EAT_NONE ();
sub EAT_HEXCHAT ();
sub EAT_PLUGIN ();
sub EAT_ALL ();
sub KEEP ();
sub REMOVE ();
sub FD_READ ();
sub FD_WRITE ();
sub FD_EXCEPTION ();
sub FD_NOTSOCKET ();
sub get_context;
sub HexChat::Internal::context_info;
sub HexChat::Internal::print;
#keep compability with Xchat scripts
sub EAT_XCHAT ();
BEGIN {
*Xchat:: = *HexChat::;
}
our %EXPORT_TAGS = (
constants => [
qw(PRI_HIGHEST PRI_HIGH PRI_NORM PRI_LOW PRI_LOWEST), # priorities
qw(EAT_NONE EAT_HEXCHAT EAT_XCHAT EAT_PLUGIN EAT_ALL), # callback return values
qw(FD_READ FD_WRITE FD_EXCEPTION FD_NOTSOCKET), # fd flags
qw(KEEP REMOVE), # timers
],
hooks => [
qw(hook_server hook_command hook_print hook_timer hook_fd unhook),
],
util => [
qw(register nickcmp strip_code send_modes), # misc
qw(print prnt printf prntf command commandf emit_print), # output
qw(find_context get_context set_context), # context
qw(get_info get_prefs get_list context_info user_info), # input
qw(plugin_pref_set plugin_pref_get plugin_pref_delete plugin_pref_list), #settings
],
);
$EXPORT_TAGS{all} = [ map { @{$_} } @EXPORT_TAGS{qw(constants hooks util)}];
our @EXPORT = @{$EXPORT_TAGS{constants}};
our @EXPORT_OK = @{$EXPORT_TAGS{all}};
sub register {
my ($package, $calling_package) = HexChat::Embed::find_pkg();
my $pkg_info = HexChat::Embed::pkg_info( $package );
my $filename = $pkg_info->{filename};
my ($name, $version, $description, $callback) = @_;
if( defined $pkg_info->{gui_entry} ) {
HexChat::print( "HexChat::register called more than once in "
. $pkg_info->{filename} );
return ();
}
$description = "" unless defined $description;
if( $callback ) {
$callback = HexChat::Embed::fix_callback(
$package, $calling_package, $callback
);
}
$pkg_info->{shutdown} = $callback;
unless( $name && $name =~ /[[:print:]\w]/ ) {
$name = "Not supplied";
}
unless( $version && $version =~ /\d+(?:\.\d+)?/ ) {
$version = "NaN";
}
$pkg_info->{gui_entry} =
HexChat::Internal::register( $name, $version, $description, $filename );
# keep with old behavior
return ();
}
sub _process_hook_options {
my ($options, $keys, $store) = @_;
unless( @$keys == @$store ) {
die 'Number of keys must match the size of the store';
}
my @results;
if( ref( $options ) eq 'HASH' ) {
for my $index ( 0 .. @$keys - 1 ) {
my $key = $keys->[$index];
if( exists( $options->{ $key } ) && defined( $options->{ $key } ) ) {
${$store->[$index]} = $options->{ $key };
}
}
}
}
sub hook_server {
return undef unless @_ >= 2;
my $message = shift;
my $callback = shift;
my $options = shift;
my ($package, $calling_package) = HexChat::Embed::find_pkg();
$callback = HexChat::Embed::fix_callback(
$package, $calling_package, $callback
);
my ($priority, $data) = ( HexChat::PRI_NORM, undef );
_process_hook_options(
$options,
[qw(priority data)],
[\($priority, $data)],
);
my $pkg_info = HexChat::Embed::pkg_info( $package );
my $hook = HexChat::Internal::hook_server(
$message, $priority, $callback, $data, $package
);
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub hook_command {
return undef unless @_ >= 2;
my $command = shift;
my $callback = shift;
my $options = shift;
my ($package, $calling_package) = HexChat::Embed::find_pkg();
$callback = HexChat::Embed::fix_callback(
$package, $calling_package, $callback
);
my ($priority, $help_text, $data) = ( HexChat::PRI_NORM, undef, undef );
_process_hook_options(
$options,
[qw(priority help_text data)],
[\($priority, $help_text, $data)],
);
my $pkg_info = HexChat::Embed::pkg_info( $package );
my $hook = HexChat::Internal::hook_command(
$command, $priority, $callback, $help_text, $data, $package
);
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub hook_print {
return undef unless @_ >= 2;
my $event = shift;
my $callback = shift;
my $options = shift;
my ($package, $calling_package) = HexChat::Embed::find_pkg();
$callback = HexChat::Embed::fix_callback(
$package, $calling_package, $callback
);
my ($priority, $run_after, $filter, $data) = ( HexChat::PRI_NORM, 0, 0, undef );
_process_hook_options(
$options,
[qw(priority run_after_event filter data)],
[\($priority, $run_after, $filter, $data)],
);
if( $run_after and $filter ) {
Carp::carp( "HexChat::hook_print's run_after_event and filter options are mutually exclusive, you can only use of them at a time per hook" );
return;
}
if( $run_after ) {
my $cb = $callback;
$callback = sub {
my @args = @_;
hook_timer( 0, sub {
$cb->( @args );
if( ref $run_after eq 'CODE' ) {
$run_after->( @args );
}
return REMOVE;
});
return EAT_NONE;
};
}
if( $filter ) {
my $cb = $callback;
$callback = sub {
my @args = @{$_[0]};
my $event_data = $_[1];
my $event_name = $event;
my $last_arg = @args - 1;
my @new = $cb->( \@args, $event_data, $event_name );
# allow changing event by returning the new value
if( @new > @args ) {
$event_name = pop @new;
}
# a filter can either return the new results or it can modify
# @_ in place.
if( @new == @args ) {
emit_print( $event_name, @new[ 0 .. $last_arg ] );
return EAT_ALL;
} elsif(
join( "\0", @{$_[0]} ) ne join( "\0", @args[ 0 .. $last_arg ] )
) {
emit_print( $event_name, @args[ 0 .. $last_arg ] );
return EAT_ALL;
}
return EAT_NONE;
};
}
my $pkg_info = HexChat::Embed::pkg_info( $package );
my $hook = HexChat::Internal::hook_print(
$event, $priority, $callback, $data, $package
);
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub hook_timer {
return undef unless @_ >= 2;
my ($timeout, $callback, $data) = @_;
my ($package, $calling_package) = HexChat::Embed::find_pkg();
$callback = HexChat::Embed::fix_callback(
$package, $calling_package, $callback
);
if(
ref( $data ) eq 'HASH' && exists( $data->{data} )
&& defined( $data->{data} )
) {
$data = $data->{data};
}
my $pkg_info = HexChat::Embed::pkg_info( $package );
my $hook = HexChat::Internal::hook_timer( $timeout, $callback, $data, $package );
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub hook_fd {
return undef unless @_ >= 2;
my ($fd, $callback, $options) = @_;
return undef unless defined $fd && defined $callback;
my $fileno = fileno $fd;
return undef unless defined $fileno; # no underlying fd for this handle
my ($package, $calling_package) = HexChat::Embed::find_pkg();
$callback = HexChat::Embed::fix_callback(
$package, $calling_package, $callback
);
my ($flags, $data) = (HexChat::FD_READ, undef);
_process_hook_options(
$options,
[qw(flags data)],
[\($flags, $data)],
);
my $cb = sub {
my $userdata = shift;
return $userdata->{CB}->(
$userdata->{FD}, $userdata->{FLAGS}, $userdata->{DATA},
);
};
my $pkg_info = HexChat::Embed::pkg_info( $package );
my $hook = HexChat::Internal::hook_fd(
$fileno, $cb, $flags, {
DATA => $data, FD => $fd, CB => $callback, FLAGS => $flags,
},
$package
);
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub unhook {
my $hook = shift @_;
my $package = shift @_;
($package) = caller unless $package;
my $pkg_info = HexChat::Embed::pkg_info( $package );
if( defined( $hook )
&& $hook =~ /^\d+$/
&& grep { $_ == $hook } @{$pkg_info->{hooks}} ) {
$pkg_info->{hooks} = [grep { $_ != $hook } @{$pkg_info->{hooks}}];
return HexChat::Internal::unhook( $hook );
}
return ();
}
sub _do_for_each {
my ($cb, $channels, $servers) = @_;
# not specifying any channels or servers is not the same as specifying
# undef for both
# - not specifying either results in calling the callback inthe current ctx
# - specifying undef for for both results in calling the callback in the
# front/currently selected tab
if( @_ == 3 && !($channels || $servers) ) {
$channels = [ undef ];
$servers = [ undef ];
} elsif( !($channels || $servers) ) {
$cb->();
return 1;
}
$channels = [ $channels ] unless ref( $channels ) eq 'ARRAY';
if( $servers ) {
$servers = [ $servers ] unless ref( $servers ) eq 'ARRAY';
} else {
$servers = [ undef ];
}
my $num_done = 0;
my $old_ctx = HexChat::get_context();
for my $server ( @$servers ) {
for my $channel ( @$channels ) {
if( HexChat::set_context( $channel, $server ) ) {
$cb->();
$num_done++
}
}
}
HexChat::set_context( $old_ctx );
return $num_done;
}
sub print {
my $text = shift @_;
return "" unless defined $text;
if( ref( $text ) eq 'ARRAY' ) {
if( $, ) {
$text = join $, , @$text;
} else {
$text = join "", @$text;
}
}
return _do_for_each(
sub { HexChat::Internal::print( $text ); },
@_
);
}
sub printf {
my $format = shift;
HexChat::print( sprintf( $format, @_ ) );
}
# make HexChat::prnt() and HexChat::prntf() as aliases for HexChat::print() and
# HexChat::printf(), mainly useful when these functions are exported
sub prnt {
goto &HexChat::print;
}
sub prntf {
goto &HexChat::printf;
}
sub command {
my $command = shift;
return "" unless defined $command;
my @commands;
if( ref( $command ) eq 'ARRAY' ) {
@commands = @$command;
} else {
@commands = ($command);
}
return _do_for_each(
sub { HexChat::Internal::command( $_ ) foreach @commands },
@_
);
}
sub commandf {
my $format = shift;
HexChat::command( sprintf( $format, @_ ) );
}
sub plugin_pref_set {
my $setting = shift // return 0;
my $value = shift // return 0;
return HexChat::Internal::plugin_pref_set($setting, $value);
}
sub plugin_pref_get {
my $setting = shift // return 0;
return HexChat::Internal::plugin_pref_get($setting);
}
sub plugin_pref_delete {
my $setting = shift // return 0;
return HexChat::Internal::plugin_pref_delete($setting);
}
sub plugin_pref_list {
my %list = HexChat::Internal::plugin_pref_list();
return \%list;
}
sub set_context {
my $context;
if( @_ == 2 ) {
my ($channel, $server) = @_;
$context = HexChat::find_context( $channel, $server );
} elsif( @_ == 1 ) {
if( defined $_[0] && $_[0] =~ /^\d+$/ ) {
$context = $_[0];
} else {
$context = HexChat::find_context( $_[0] );
}
} elsif( @_ == 0 ) {
$context = HexChat::find_context();
}
return $context ? HexChat::Internal::set_context( $context ) : 0;
}
sub get_info {
my $id = shift;
my $info;
if( defined( $id ) ) {
if( grep { $id eq $_ } qw(state_cursor id) ) {
$info = HexChat::get_prefs( $id );
} else {
$info = HexChat::Internal::get_info( $id );
}
}
return $info;
}
sub user_info {
my $nick = HexChat::strip_code(shift @_ || HexChat::get_info( "nick" ));
my $user;
for (HexChat::get_list( "users" ) ) {
if ( HexChat::nickcmp( $_->{nick}, $nick ) == 0 ) {
$user = $_;
last;
}
}
return $user;
}
sub context_info {
my $ctx = shift @_ || HexChat::get_context;
my $old_ctx = HexChat::get_context;
my @fields = (
qw(away channel charset host id inputbox libdirfs modes network),
qw(nick nickserv server topic version win_ptr win_status),
qw(configdir xchatdir xchatdirfs state_cursor),
);
if( HexChat::set_context( $ctx ) ) {
my %info;
for my $field ( @fields ) {
$info{$field} = HexChat::get_info( $field );
}
my $ctx_info = HexChat::Internal::context_info;
@info{keys %$ctx_info} = values %$ctx_info;
HexChat::set_context( $old_ctx );
return \%info;
} else {
return undef;
}
}
sub get_list {
unless( grep { $_[0] eq $_ } qw(channels dcc ignore notify users networks) ) {
Carp::carp( "'$_[0]' does not appear to be a valid list name" );
}
if( $_[0] eq 'networks' ) {
return HexChat::List::Network->get();
} else {
return HexChat::Internal::get_list( $_[0] );
}
}
sub strip_code {
my $pattern = qr<
\cB| #Bold
\cC\d{0,2}(?:,\d{1,2})?| #Color
\e\[(?:\d{1,2}(?:;\d{1,2})*)?m| # ANSI color code
\cG| #Beep
\cO| #Reset
\cV| #Reverse
\c_ #Underline
>x;
if( defined wantarray ) {
my $msg = shift;
$msg =~ s/$pattern//g;
return $msg;
} else {
$_[0] =~ s/$pattern//g if defined $_[0];
}
}
1

View File

@ -1,6 +1,7 @@
package Xchat::Embed; package HexChat::Embed;
use strict; use strict;
use warnings; use warnings;
use Data::Dumper;
# list of loaded scripts keyed by their package names # list of loaded scripts keyed by their package names
# The package names are generated from the filename of the script using # The package names are generated from the filename of the script using
# the file2pkg() function. # the file2pkg() function.
@ -42,11 +43,11 @@ sub load {
if( exists $scripts{$package} ) { if( exists $scripts{$package} ) {
my $pkg_info = pkg_info( $package ); my $pkg_info = pkg_info( $package );
my $filename = File::Basename::basename( $pkg_info->{filename} ); my $filename = File::Basename::basename( $pkg_info->{filename} );
Xchat::printf( HexChat::printf(
qq{'%s' already loaded from '%s'.\n}, qq{'%s' already loaded from '%s'.\n},
$filename, $pkg_info->{filename} $filename, $pkg_info->{filename}
); );
Xchat::print( HexChat::print(
'If this is a different script then it rename and try '. 'If this is a different script then it rename and try '.
'loading it again.' 'loading it again.'
); );
@ -60,7 +61,7 @@ sub load {
$source =~ s/^__END__.*//ms; $source =~ s/^__END__.*//ms;
# this must come before the eval or the filename will not be found in # this must come before the eval or the filename will not be found in
# Xchat::register # HexChat::register
$scripts{$package}{filename} = $file; $scripts{$package}{filename} = $file;
$scripts{$package}{loaded_at} = Time::HiRes::time(); $scripts{$package}{loaded_at} = Time::HiRes::time();
@ -93,7 +94,7 @@ sub load {
$error_message .= " $conflict_package already defined in " . $error_message .= " $conflict_package already defined in " .
pkg_info($owner_package{ $conflict_package })->{filename}."\n"; pkg_info($owner_package{ $conflict_package })->{filename}."\n";
} }
Xchat::print( $error_message ); HexChat::print( $error_message );
return 2; return 2;
} }
@ -114,7 +115,7 @@ sub load {
unless( exists $scripts{$package}{gui_entry} ) { unless( exists $scripts{$package}{gui_entry} ) {
$scripts{$package}{gui_entry} = $scripts{$package}{gui_entry} =
Xchat::Internal::register( HexChat::Internal::register(
"", "unknown", "", $file "", "unknown", "", $file
); );
} }
@ -122,13 +123,13 @@ sub load {
if( $@ ) { if( $@ ) {
# something went wrong # something went wrong
$@ =~ s/\(eval \d+\)/$file/g; $@ =~ s/\(eval \d+\)/$file/g;
Xchat::print( "Error loading '$file':\n$@\n" ); HexChat::print( "Error loading '$file':\n$@\n" );
# make sure the script list doesn't contain false information # make sure the script list doesn't contain false information
unload( $scripts{$package}{filename} ); unload( $scripts{$package}{filename} );
return 1; return 1;
} }
} else { } else {
Xchat::print( "Error opening '$file': $!\n" ); HexChat::print( "Error opening '$file': $!\n" );
return 2; return 2;
} }
@ -162,7 +163,7 @@ sub unload {
if( exists $pkg_info->{hooks} ) { if( exists $pkg_info->{hooks} ) {
for my $hook ( @{$pkg_info->{hooks}} ) { for my $hook ( @{$pkg_info->{hooks}} ) {
Xchat::unhook( $hook, $package ); HexChat::unhook( $hook, $package );
} }
} }
@ -176,10 +177,10 @@ sub unload {
} }
Symbol::delete_package( $package ); Symbol::delete_package( $package );
delete $scripts{$package}; delete $scripts{$package};
return Xchat::EAT_ALL; return HexChat::EAT_ALL;
} else { } else {
Xchat::print( qq{"$file" is not loaded.\n} ); HexChat::print( qq{"$file" is not loaded.\n} );
return Xchat::EAT_NONE; return HexChat::EAT_NONE;
} }
} }
@ -188,7 +189,7 @@ sub unload_all {
unload( $scripts{$package}->{filename} ); unload( $scripts{$package}->{filename} );
} }
return Xchat::EAT_ALL; return HexChat::EAT_ALL;
} }
sub reload { sub reload {
@ -203,11 +204,11 @@ sub reload {
} }
load( $fullpath ); load( $fullpath );
return Xchat::EAT_ALL; return HexChat::EAT_ALL;
} }
sub reload_all { sub reload_all {
my @dirs = Xchat::get_info( "configdir" ); my @dirs = HexChat::get_info( "configdir" );
push @dirs, File::Spec->catdir( $dirs[0], "plugins" ); push @dirs, File::Spec->catdir( $dirs[0], "plugins" );
for my $dir ( @dirs ) { for my $dir ( @dirs ) {
my $auto_load_glob = File::Spec->catfile( $dir, "*.pl" ); my $auto_load_glob = File::Spec->catfile( $dir, "*.pl" );
@ -227,6 +228,28 @@ sub reload_all {
} }
} }
sub evaluate {
my ($code) = @_;
my @results = eval $code;
HexChat::print $@ if $@; #print warnings
local $Data::Dumper::Sortkeys = 1;
local $Data::Dumper::Terse = 1;
if (@results > 1) {
HexChat::print Dumper \@results;
}
elsif (ref $results[0] || !$results[0]) {
HexChat::print Dumper $results[0];
}
else {
HexChat::print $results[0];
}
return HexChat::EAT_HEXCHAT;
};
sub expand_homedir { sub expand_homedir {
my $file = shift @_; my $file = shift @_;
@ -244,7 +267,7 @@ sub file2pkg {
my $string = File::Basename::basename( shift @_ ); my $string = File::Basename::basename( shift @_ );
$string =~ s/\.pl$//i; $string =~ s/\.pl$//i;
$string =~ s|([^A-Za-z0-9/])|'_'.unpack("H*",$1)|eg; $string =~ s|([^A-Za-z0-9/])|'_'.unpack("H*",$1)|eg;
return "Xchat::Script::" . $string; return "HexChat::Script::" . $string;
} }
sub pkg_info { sub pkg_info {
@ -256,7 +279,7 @@ sub find_external_pkg {
my $level = 1; my $level = 1;
while( my @frame = caller( $level ) ) { while( my @frame = caller( $level ) ) {
return @frame if $frame[0] !~ /(?:^IRC$|^Xchat)/; return @frame if $frame[0] !~ /(?:^IRC$|^HexChat)/;
$level++; $level++;
} }
return; return;
@ -266,7 +289,7 @@ sub find_pkg {
my $level = 1; my $level = 1;
while( my ($package, $file, $line) = caller( $level ) ) { while( my ($package, $file, $line) = caller( $level ) ) {
return $package if $package =~ /^Xchat::Script::/; return $package if $package =~ /^HexChat::Script::/;
$level++; $level++;
} }

View File

@ -1,4 +1,4 @@
package Xchat::List::Network; package HexChat::List::Network;
use strict; use strict;
use warnings; use warnings;
use Storable qw(dclone); use Storable qw(dclone);
@ -6,7 +6,7 @@ my $last_modified;
my @servers; my @servers;
sub get { sub get {
my $server_file = Xchat::get_info( "configdir" ) . "/servlist.conf"; my $server_file = HexChat::get_info( "configdir" ) . "/servlist.conf";
# recreate the list only if the server list file has changed # recreate the list only if the server list file has changed
if( -f $server_file && if( -f $server_file &&
@ -19,7 +19,7 @@ sub get {
while( my $record = <$fh> ) { while( my $record = <$fh> ) {
chomp $record; chomp $record;
next if $record =~ /^v=/; # skip the version line next if $record =~ /^v=/; # skip the version line
push @servers, Xchat::List::Network::Entry::parse( $record ); push @servers, HexChat::List::Network::Entry::parse( $record );
} }
} else { } else {
warn "Unable to open '$server_file': $!"; warn "Unable to open '$server_file': $!";

View File

@ -1,4 +1,4 @@
package Xchat::List::Network::AutoJoin; package HexChat::List::Network::AutoJoin;
use strict; use strict;
use warnings; use warnings;

View File

@ -1,4 +1,4 @@
package Xchat::List::Network::Entry; package HexChat::List::Network::Entry;
use strict; use strict;
use warnings; use warnings;
@ -26,7 +26,7 @@ sub parse {
# the order of the channels need to be maintained # the order of the channels need to be maintained
# list of { channel => .., key => ... } # list of { channel => .., key => ... }
autojoins => Xchat::List::Network::AutoJoin->new( '' ), autojoins => HexChat::List::Network::AutoJoin->new( '' ),
connect_commands => [], connect_commands => [],
flags => {}, flags => {},
selected => undef, selected => undef,
@ -39,7 +39,7 @@ sub parse {
my @fields = split /\n/, $data; my @fields = split /\n/, $data;
chomp @fields; chomp @fields;
$entry->{ autojoins } = Xchat::List::Network::AutoJoin->new(); $entry->{ autojoins } = HexChat::List::Network::AutoJoin->new();
for my $field ( @fields ) { for my $field ( @fields ) {
SWITCH: for ( $field ) { SWITCH: for ( $field ) {

View File

@ -1,525 +1 @@
$SIG{__WARN__} = sub { require HexChat;
my $message = shift @_;
my ($package) = caller;
# redirect Gtk/Glib errors and warnings back to STDERR
my $message_levels = qr/ERROR|CRITICAL|WARNING|MESSAGE|INFO|DEBUG/i;
if( $message =~ /^(?:Gtk|GLib|Gdk)(?:-\w+)?-$message_levels/i ) {
print STDERR $message;
} else {
if( defined &Xchat::Internal::print ) {
Xchat::print( $message );
} else {
warn $message;
}
}
};
use File::Spec ();
use File::Basename ();
use File::Glob ();
use List::Util ();
use Symbol();
use Time::HiRes ();
use Carp ();
package Xchat;
use base qw(Exporter);
use strict;
use warnings;
sub PRI_HIGHEST ();
sub PRI_HIGH ();
sub PRI_NORM ();
sub PRI_LOW ();
sub PRI_LOWEST ();
sub EAT_NONE ();
sub EAT_XCHAT ();
sub EAT_PLUIN ();
sub EAT_ALL ();
sub KEEP ();
sub REMOVE ();
sub FD_READ ();
sub FD_WRITE ();
sub FD_EXCEPTION ();
sub FD_NOTSOCKET ();
sub get_context;
sub Xchat::Internal::context_info;
sub Xchat::Internal::print;
our %EXPORT_TAGS = (
constants => [
qw(PRI_HIGHEST PRI_HIGH PRI_NORM PRI_LOW PRI_LOWEST), # priorities
qw(EAT_NONE EAT_XCHAT EAT_PLUGIN EAT_ALL), # callback return values
qw(FD_READ FD_WRITE FD_EXCEPTION FD_NOTSOCKET), # fd flags
qw(KEEP REMOVE), # timers
],
hooks => [
qw(hook_server hook_command hook_print hook_timer hook_fd unhook),
],
util => [
qw(register nickcmp strip_code send_modes), # misc
qw(print prnt printf prntf command commandf emit_print), # output
qw(find_context get_context set_context), # context
qw(get_info get_prefs get_list context_info user_info), # input
],
);
$EXPORT_TAGS{all} = [ map { @{$_} } @EXPORT_TAGS{qw(constants hooks util)}];
our @EXPORT = @{$EXPORT_TAGS{constants}};
our @EXPORT_OK = @{$EXPORT_TAGS{all}};
sub register {
my ($package, $calling_package) = Xchat::Embed::find_pkg();
my $pkg_info = Xchat::Embed::pkg_info( $package );
my $filename = $pkg_info->{filename};
my ($name, $version, $description, $callback) = @_;
if( defined $pkg_info->{gui_entry} ) {
Xchat::print( "Xchat::register called more than once in "
. $pkg_info->{filename} );
return ();
}
$description = "" unless defined $description;
if( $callback ) {
$callback = Xchat::Embed::fix_callback(
$package, $calling_package, $callback
);
}
$pkg_info->{shutdown} = $callback;
unless( $name && $name =~ /[[:print:]\w]/ ) {
$name = "Not supplied";
}
unless( $version && $version =~ /\d+(?:\.\d+)?/ ) {
$version = "NaN";
}
$pkg_info->{gui_entry} =
Xchat::Internal::register( $name, $version, $description, $filename );
# keep with old behavior
return ();
}
sub _process_hook_options {
my ($options, $keys, $store) = @_;
unless( @$keys == @$store ) {
die 'Number of keys must match the size of the store';
}
my @results;
if( ref( $options ) eq 'HASH' ) {
for my $index ( 0 .. @$keys - 1 ) {
my $key = $keys->[$index];
if( exists( $options->{ $key } ) && defined( $options->{ $key } ) ) {
${$store->[$index]} = $options->{ $key };
}
}
}
}
sub hook_server {
return undef unless @_ >= 2;
my $message = shift;
my $callback = shift;
my $options = shift;
my ($package, $calling_package) = Xchat::Embed::find_pkg();
$callback = Xchat::Embed::fix_callback(
$package, $calling_package, $callback
);
my ($priority, $data) = ( Xchat::PRI_NORM, undef );
_process_hook_options(
$options,
[qw(priority data)],
[\($priority, $data)],
);
my $pkg_info = Xchat::Embed::pkg_info( $package );
my $hook = Xchat::Internal::hook_server(
$message, $priority, $callback, $data, $package
);
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub hook_command {
return undef unless @_ >= 2;
my $command = shift;
my $callback = shift;
my $options = shift;
my ($package, $calling_package) = Xchat::Embed::find_pkg();
$callback = Xchat::Embed::fix_callback(
$package, $calling_package, $callback
);
my ($priority, $help_text, $data) = ( Xchat::PRI_NORM, undef, undef );
_process_hook_options(
$options,
[qw(priority help_text data)],
[\($priority, $help_text, $data)],
);
my $pkg_info = Xchat::Embed::pkg_info( $package );
my $hook = Xchat::Internal::hook_command(
$command, $priority, $callback, $help_text, $data, $package
);
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub hook_print {
return undef unless @_ >= 2;
my $event = shift;
my $callback = shift;
my $options = shift;
my ($package, $calling_package) = Xchat::Embed::find_pkg();
$callback = Xchat::Embed::fix_callback(
$package, $calling_package, $callback
);
my ($priority, $run_after, $filter, $data) = ( Xchat::PRI_NORM, 0, 0, undef );
_process_hook_options(
$options,
[qw(priority run_after_event filter data)],
[\($priority, $run_after, $filter, $data)],
);
if( $run_after and $filter ) {
Carp::carp( "Xchat::hook_print's run_after_event and filter options are mutually exclusive, you can only use of them at a time per hook" );
return;
}
if( $run_after ) {
my $cb = $callback;
$callback = sub {
my @args = @_;
hook_timer( 0, sub {
$cb->( @args );
if( ref $run_after eq 'CODE' ) {
$run_after->( @args );
}
return REMOVE;
});
return EAT_NONE;
};
}
if( $filter ) {
my $cb = $callback;
$callback = sub {
my @args = @{$_[0]};
my $event_data = $_[1];
my $event_name = $event;
my $last_arg = @args - 1;
my @new = $cb->( \@args, $event_data, $event_name );
# allow changing event by returning the new value
if( @new > @args ) {
$event_name = pop @new;
}
# a filter can either return the new results or it can modify
# @_ in place.
if( @new == @args ) {
emit_print( $event_name, @new[ 0 .. $last_arg ] );
return EAT_ALL;
} elsif(
join( "\0", @{$_[0]} ) ne join( "\0", @args[ 0 .. $last_arg ] )
) {
emit_print( $event_name, @args[ 0 .. $last_arg ] );
return EAT_ALL;
}
return EAT_NONE;
};
}
my $pkg_info = Xchat::Embed::pkg_info( $package );
my $hook = Xchat::Internal::hook_print(
$event, $priority, $callback, $data, $package
);
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub hook_timer {
return undef unless @_ >= 2;
my ($timeout, $callback, $data) = @_;
my ($package, $calling_package) = Xchat::Embed::find_pkg();
$callback = Xchat::Embed::fix_callback(
$package, $calling_package, $callback
);
if(
ref( $data ) eq 'HASH' && exists( $data->{data} )
&& defined( $data->{data} )
) {
$data = $data->{data};
}
my $pkg_info = Xchat::Embed::pkg_info( $package );
my $hook = Xchat::Internal::hook_timer( $timeout, $callback, $data, $package );
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub hook_fd {
return undef unless @_ >= 2;
my ($fd, $callback, $options) = @_;
return undef unless defined $fd && defined $callback;
my $fileno = fileno $fd;
return undef unless defined $fileno; # no underlying fd for this handle
my ($package, $calling_package) = Xchat::Embed::find_pkg();
$callback = Xchat::Embed::fix_callback(
$package, $calling_package, $callback
);
my ($flags, $data) = (Xchat::FD_READ, undef);
_process_hook_options(
$options,
[qw(flags data)],
[\($flags, $data)],
);
my $cb = sub {
my $userdata = shift;
return $userdata->{CB}->(
$userdata->{FD}, $userdata->{FLAGS}, $userdata->{DATA},
);
};
my $pkg_info = Xchat::Embed::pkg_info( $package );
my $hook = Xchat::Internal::hook_fd(
$fileno, $cb, $flags, {
DATA => $data, FD => $fd, CB => $callback, FLAGS => $flags,
},
$package
);
push @{$pkg_info->{hooks}}, $hook if defined $hook;
return $hook;
}
sub unhook {
my $hook = shift @_;
my $package = shift @_;
($package) = caller unless $package;
my $pkg_info = Xchat::Embed::pkg_info( $package );
if( defined( $hook )
&& $hook =~ /^\d+$/
&& grep { $_ == $hook } @{$pkg_info->{hooks}} ) {
$pkg_info->{hooks} = [grep { $_ != $hook } @{$pkg_info->{hooks}}];
return Xchat::Internal::unhook( $hook );
}
return ();
}
sub _do_for_each {
my ($cb, $channels, $servers) = @_;
# not specifying any channels or servers is not the same as specifying
# undef for both
# - not specifying either results in calling the callback inthe current ctx
# - specifying undef for for both results in calling the callback in the
# front/currently selected tab
if( @_ == 3 && !($channels || $servers) ) {
$channels = [ undef ];
$servers = [ undef ];
} elsif( !($channels || $servers) ) {
$cb->();
return 1;
}
$channels = [ $channels ] unless ref( $channels ) eq 'ARRAY';
if( $servers ) {
$servers = [ $servers ] unless ref( $servers ) eq 'ARRAY';
} else {
$servers = [ undef ];
}
my $num_done = 0;
my $old_ctx = Xchat::get_context();
for my $server ( @$servers ) {
for my $channel ( @$channels ) {
if( Xchat::set_context( $channel, $server ) ) {
$cb->();
$num_done++
}
}
}
Xchat::set_context( $old_ctx );
return $num_done;
}
sub print {
my $text = shift @_;
return "" unless defined $text;
if( ref( $text ) eq 'ARRAY' ) {
if( $, ) {
$text = join $, , @$text;
} else {
$text = join "", @$text;
}
}
return _do_for_each(
sub { Xchat::Internal::print( $text ); },
@_
);
}
sub printf {
my $format = shift;
Xchat::print( sprintf( $format, @_ ) );
}
# make Xchat::prnt() and Xchat::prntf() as aliases for Xchat::print() and
# Xchat::printf(), mainly useful when these functions are exported
sub prnt {
goto &Xchat::print;
}
sub prntf {
goto &Xchat::printf;
}
sub command {
my $command = shift;
return "" unless defined $command;
my @commands;
if( ref( $command ) eq 'ARRAY' ) {
@commands = @$command;
} else {
@commands = ($command);
}
return _do_for_each(
sub { Xchat::Internal::command( $_ ) foreach @commands },
@_
);
}
sub commandf {
my $format = shift;
Xchat::command( sprintf( $format, @_ ) );
}
sub set_context {
my $context;
if( @_ == 2 ) {
my ($channel, $server) = @_;
$context = Xchat::find_context( $channel, $server );
} elsif( @_ == 1 ) {
if( defined $_[0] && $_[0] =~ /^\d+$/ ) {
$context = $_[0];
} else {
$context = Xchat::find_context( $_[0] );
}
} elsif( @_ == 0 ) {
$context = Xchat::find_context();
}
return $context ? Xchat::Internal::set_context( $context ) : 0;
}
sub get_info {
my $id = shift;
my $info;
if( defined( $id ) ) {
if( grep { $id eq $_ } qw(state_cursor id) ) {
$info = Xchat::get_prefs( $id );
} else {
$info = Xchat::Internal::get_info( $id );
}
}
return $info;
}
sub user_info {
my $nick = Xchat::strip_code(shift @_ || Xchat::get_info( "nick" ));
my $user;
for (Xchat::get_list( "users" ) ) {
if ( Xchat::nickcmp( $_->{nick}, $nick ) == 0 ) {
$user = $_;
last;
}
}
return $user;
}
sub context_info {
my $ctx = shift @_ || Xchat::get_context;
my $old_ctx = Xchat::get_context;
my @fields = (
qw(away channel charset host id inputbox libdirfs modes network),
qw(nick nickserv server topic version win_ptr win_status),
qw(configdir xchatdir xchatdirfs state_cursor),
);
if( Xchat::set_context( $ctx ) ) {
my %info;
for my $field ( @fields ) {
$info{$field} = Xchat::get_info( $field );
}
my $ctx_info = Xchat::Internal::context_info;
@info{keys %$ctx_info} = values %$ctx_info;
Xchat::set_context( $old_ctx );
return %info if wantarray;
return \%info;
} else {
return undef;
}
}
sub get_list {
unless( grep { $_[0] eq $_ } qw(channels dcc ignore notify users networks) ) {
Carp::carp( "'$_[0]' does not appear to be a valid list name" );
}
if( $_[0] eq 'networks' ) {
return Xchat::List::Network->get();
} else {
return Xchat::Internal::get_list( $_[0] );
}
}
sub strip_code {
my $pattern = qr<
\cB| #Bold
\cC\d{0,2}(?:,\d{1,2})?| #Color
\e\[(?:\d{1,2}(?:;\d{1,2})*)?m| # ANSI color code
\cG| #Beep
\cO| #Reset
\cV| #Reverse
\c_ #Underline
>x;
if( defined wantarray ) {
my $msg = shift;
$msg =~ s/$pattern//g;
return $msg;
} else {
$_[0] =~ s/$pattern//g if defined $_[0];
}
}
1

View File

@ -323,11 +323,11 @@ array2av (char *array[])
return av; return av;
} }
/* sets $Xchat::Embed::current_package */ /* sets $HexChat::Embed::current_package */
static void static void
set_current_package (SV *package) set_current_package (SV *package)
{ {
SV *current_package = get_sv ("Xchat::Embed::current_package", 1); SV *current_package = get_sv ("HexChat::Embed::current_package", 1);
SvSetSV_nosteal (current_package, package); SvSetSV_nosteal (current_package, package);
} }
@ -367,7 +367,7 @@ fd_cb (int fd, int flags, void *userdata)
XPUSHs (sv_2mortal (newSViv (PTR2IV (data->hook)))); XPUSHs (sv_2mortal (newSViv (PTR2IV (data->hook))));
PUTBACK; PUTBACK;
call_pv ("Xchat::unhook", G_EVAL); call_pv ("HexChat::unhook", G_EVAL);
SPAGAIN; SPAGAIN;
SvREFCNT_dec (data->callback); SvREFCNT_dec (data->callback);
@ -429,7 +429,7 @@ timer_cb (void *userdata)
XPUSHs (sv_mortalcopy (data->package)); XPUSHs (sv_mortalcopy (data->package));
PUTBACK; PUTBACK;
call_pv ("Xchat::unhook", G_EVAL); call_pv ("HexChat::unhook", G_EVAL);
SPAGAIN; SPAGAIN;
} }
} }
@ -619,19 +619,19 @@ print_cb (char *word[], void *userdata)
/* custom IRC perl functions for scripting */ /* custom IRC perl functions for scripting */
/* Xchat::Internal::register (scriptname, version, desc, shutdowncallback, filename) /* HexChat::Internal::register (scriptname, version, desc, shutdowncallback, filename)
* *
*/ */
static static
XS (XS_Xchat_register) XS (XS_HexChat_register)
{ {
char *name, *version, *desc, *filename; char *name, *version, *desc, *filename;
void *gui_entry; void *gui_entry;
dXSARGS; dXSARGS;
if (items != 4) { if (items != 4) {
hexchat_printf (ph, hexchat_printf (ph,
"Usage: Xchat::Internal::register(scriptname, version, desc, filename)"); "Usage: HexChat::Internal::register(scriptname, version, desc, filename)");
} else { } else {
name = SvPV_nolen (ST (0)); name = SvPV_nolen (ST (0));
version = SvPV_nolen (ST (1)); version = SvPV_nolen (ST (1));
@ -647,16 +647,16 @@ XS (XS_Xchat_register)
} }
/* Xchat::print(output) */ /* HexChat::print(output) */
static static
XS (XS_Xchat_print) XS (XS_HexChat_print)
{ {
char *text = NULL; char *text = NULL;
dXSARGS; dXSARGS;
if (items != 1) { if (items != 1) {
hexchat_print (ph, "Usage: Xchat::Internal::print(text)"); hexchat_print (ph, "Usage: HexChat::Internal::print(text)");
} else { } else {
text = SvPV_nolen (ST (0)); text = SvPV_nolen (ST (0));
hexchat_print (ph, text); hexchat_print (ph, text);
@ -665,7 +665,7 @@ XS (XS_Xchat_print)
} }
static static
XS (XS_Xchat_emit_print) XS (XS_HexChat_emit_print)
{ {
char *event_name; char *event_name;
int RETVAL; int RETVAL;
@ -673,7 +673,7 @@ XS (XS_Xchat_emit_print)
dXSARGS; dXSARGS;
if (items < 1) { if (items < 1) {
hexchat_print (ph, "Usage: Xchat::emit_print(event_name, ...)"); hexchat_print (ph, "Usage: HexChat::emit_print(event_name, ...)");
} else { } else {
event_name = (char *) SvPV_nolen (ST (0)); event_name = (char *) SvPV_nolen (ST (0));
RETVAL = 0; RETVAL = 0;
@ -719,7 +719,7 @@ XS (XS_Xchat_emit_print)
} }
static static
XS (XS_Xchat_send_modes) XS (XS_HexChat_send_modes)
{ {
AV *p_targets = NULL; AV *p_targets = NULL;
int modes_per_line = 0; int modes_per_line = 0;
@ -733,7 +733,7 @@ XS (XS_Xchat_send_modes)
dXSARGS; dXSARGS;
if (items < 3 || items > 4) { if (items < 3 || items > 4) {
hexchat_print (ph, hexchat_print (ph,
"Usage: Xchat::send_modes( targets, sign, mode, modes_per_line)" "Usage: HexChat::send_modes( targets, sign, mode, modes_per_line)"
); );
} else { } else {
if (SvROK (ST (0))) { if (SvROK (ST (0))) {
@ -771,12 +771,12 @@ XS (XS_Xchat_send_modes)
} }
} }
static static
XS (XS_Xchat_get_info) XS (XS_HexChat_get_info)
{ {
SV *temp = NULL; SV *temp = NULL;
dXSARGS; dXSARGS;
if (items != 1) { if (items != 1) {
hexchat_print (ph, "Usage: Xchat::get_info(id)"); hexchat_print (ph, "Usage: HexChat::get_info(id)");
} else { } else {
SV *id = ST (0); SV *id = ST (0);
const char *RETVAL; const char *RETVAL;
@ -810,13 +810,13 @@ XS (XS_Xchat_get_info)
} }
static static
XS (XS_Xchat_context_info) XS (XS_HexChat_context_info)
{ {
const char *const *fields; const char *const *fields;
dXSARGS; dXSARGS;
if (items > 0 ) { if (items > 0 ) {
hexchat_print (ph, "Usage: Xchat::Internal::context_info()"); hexchat_print (ph, "Usage: HexChat::Internal::context_info()");
} }
fields = hexchat_list_fields (ph, "channels" ); fields = hexchat_list_fields (ph, "channels" );
XPUSHs (list_item_to_sv (NULL, fields)); XPUSHs (list_item_to_sv (NULL, fields));
@ -824,14 +824,14 @@ XS (XS_Xchat_context_info)
} }
static static
XS (XS_Xchat_get_prefs) XS (XS_HexChat_get_prefs)
{ {
const char *str; const char *str;
int integer; int integer;
SV *temp = NULL; SV *temp = NULL;
dXSARGS; dXSARGS;
if (items != 1) { if (items != 1) {
hexchat_print (ph, "Usage: Xchat::get_prefs(name)"); hexchat_print (ph, "Usage: HexChat::get_prefs(name)");
} else { } else {
@ -860,9 +860,9 @@ XS (XS_Xchat_get_prefs)
} }
} }
/* Xchat::Internal::hook_server(name, priority, callback, userdata) */ /* HexChat::Internal::hook_server(name, priority, callback, userdata) */
static static
XS (XS_Xchat_hook_server) XS (XS_HexChat_hook_server)
{ {
char *name; char *name;
@ -877,7 +877,7 @@ XS (XS_Xchat_hook_server)
if (items != 5) { if (items != 5) {
hexchat_print (ph, hexchat_print (ph,
"Usage: Xchat::Internal::hook_server(name, priority, callback, userdata, package)"); "Usage: HexChat::Internal::hook_server(name, priority, callback, userdata, package)");
} else { } else {
name = SvPV_nolen (ST (0)); name = SvPV_nolen (ST (0));
pri = (int) SvIV (ST (1)); pri = (int) SvIV (ST (1));
@ -901,9 +901,9 @@ XS (XS_Xchat_hook_server)
} }
} }
/* Xchat::Internal::hook_command(name, priority, callback, help_text, userdata) */ /* HexChat::Internal::hook_command(name, priority, callback, help_text, userdata) */
static static
XS (XS_Xchat_hook_command) XS (XS_HexChat_hook_command)
{ {
char *name; char *name;
int pri; int pri;
@ -918,7 +918,7 @@ XS (XS_Xchat_hook_command)
if (items != 6) { if (items != 6) {
hexchat_print (ph, hexchat_print (ph,
"Usage: Xchat::Internal::hook_command(name, priority, callback, help_text, userdata, package)"); "Usage: HexChat::Internal::hook_command(name, priority, callback, help_text, userdata, package)");
} else { } else {
name = SvPV_nolen (ST (0)); name = SvPV_nolen (ST (0));
pri = (int) SvIV (ST (1)); pri = (int) SvIV (ST (1));
@ -950,9 +950,9 @@ XS (XS_Xchat_hook_command)
} }
/* Xchat::Internal::hook_print(name, priority, callback, [userdata]) */ /* HexChat::Internal::hook_print(name, priority, callback, [userdata]) */
static static
XS (XS_Xchat_hook_print) XS (XS_HexChat_hook_print)
{ {
char *name; char *name;
@ -965,7 +965,7 @@ XS (XS_Xchat_hook_print)
dXSARGS; dXSARGS;
if (items != 5) { if (items != 5) {
hexchat_print (ph, hexchat_print (ph,
"Usage: Xchat::Internal::hook_print(name, priority, callback, userdata, package)"); "Usage: HexChat::Internal::hook_print(name, priority, callback, userdata, package)");
} else { } else {
name = SvPV_nolen (ST (0)); name = SvPV_nolen (ST (0));
pri = (int) SvIV (ST (1)); pri = (int) SvIV (ST (1));
@ -989,9 +989,9 @@ XS (XS_Xchat_hook_print)
} }
} }
/* Xchat::Internal::hook_timer(timeout, callback, userdata) */ /* HexChat::Internal::hook_timer(timeout, callback, userdata) */
static static
XS (XS_Xchat_hook_timer) XS (XS_HexChat_hook_timer)
{ {
int timeout; int timeout;
SV *callback; SV *callback;
@ -1004,7 +1004,7 @@ XS (XS_Xchat_hook_timer)
if (items != 4) { if (items != 4) {
hexchat_print (ph, hexchat_print (ph,
"Usage: Xchat::Internal::hook_timer(timeout, callback, userdata, package)"); "Usage: HexChat::Internal::hook_timer(timeout, callback, userdata, package)");
} else { } else {
timeout = (int) SvIV (ST (0)); timeout = (int) SvIV (ST (0));
callback = ST (1); callback = ST (1);
@ -1028,9 +1028,9 @@ XS (XS_Xchat_hook_timer)
} }
} }
/* Xchat::Internal::hook_fd(fd, callback, flags, userdata) */ /* HexChat::Internal::hook_fd(fd, callback, flags, userdata) */
static static
XS (XS_Xchat_hook_fd) XS (XS_HexChat_hook_fd)
{ {
int fd; int fd;
SV *callback; SV *callback;
@ -1044,7 +1044,7 @@ XS (XS_Xchat_hook_fd)
if (items != 5) { if (items != 5) {
hexchat_print (ph, hexchat_print (ph,
"Usage: Xchat::Internal::hook_fd(fd, callback, flags, userdata)"); "Usage: HexChat::Internal::hook_fd(fd, callback, flags, userdata)");
} else { } else {
fd = (int) SvIV (ST (0)); fd = (int) SvIV (ST (0));
callback = ST (1); callback = ST (1);
@ -1083,14 +1083,14 @@ XS (XS_Xchat_hook_fd)
} }
static static
XS (XS_Xchat_unhook) XS (XS_HexChat_unhook)
{ {
hexchat_hook *hook; hexchat_hook *hook;
HookData *userdata; HookData *userdata;
int retCount = 0; int retCount = 0;
dXSARGS; dXSARGS;
if (items != 1) { if (items != 1) {
hexchat_print (ph, "Usage: Xchat::unhook(hook)"); hexchat_print (ph, "Usage: HexChat::unhook(hook)");
} else { } else {
hook = INT2PTR (hexchat_hook *, SvUV (ST (0))); hook = INT2PTR (hexchat_hook *, SvUV (ST (0)));
userdata = (HookData *) hexchat_unhook (ph, hook); userdata = (HookData *) hexchat_unhook (ph, hook);
@ -1117,15 +1117,15 @@ XS (XS_Xchat_unhook)
XSRETURN_EMPTY; XSRETURN_EMPTY;
} }
/* Xchat::Internal::command(command) */ /* HexChat::Internal::command(command) */
static static
XS (XS_Xchat_command) XS (XS_HexChat_command)
{ {
char *cmd = NULL; char *cmd = NULL;
dXSARGS; dXSARGS;
if (items != 1) { if (items != 1) {
hexchat_print (ph, "Usage: Xchat::Internal::command(command)"); hexchat_print (ph, "Usage: HexChat::Internal::command(command)");
} else { } else {
cmd = SvPV_nolen (ST (0)); cmd = SvPV_nolen (ST (0));
hexchat_command (ph, cmd); hexchat_command (ph, cmd);
@ -1135,7 +1135,7 @@ XS (XS_Xchat_command)
} }
static static
XS (XS_Xchat_find_context) XS (XS_HexChat_find_context)
{ {
char *server = NULL; char *server = NULL;
char *chan = NULL; char *chan = NULL;
@ -1143,7 +1143,7 @@ XS (XS_Xchat_find_context)
dXSARGS; dXSARGS;
if (items > 2) if (items > 2)
hexchat_print (ph, "Usage: Xchat::find_context ([channel, [server]])"); hexchat_print (ph, "Usage: HexChat::find_context ([channel, [server]])");
{ {
switch (items) { switch (items) {
@ -1191,23 +1191,23 @@ XS (XS_Xchat_find_context)
} }
static static
XS (XS_Xchat_get_context) XS (XS_HexChat_get_context)
{ {
dXSARGS; dXSARGS;
if (items != 0) { if (items != 0) {
hexchat_print (ph, "Usage: Xchat::get_context()"); hexchat_print (ph, "Usage: HexChat::get_context()");
} else { } else {
XSRETURN_IV (PTR2IV (hexchat_get_context (ph))); XSRETURN_IV (PTR2IV (hexchat_get_context (ph)));
} }
} }
static static
XS (XS_Xchat_set_context) XS (XS_HexChat_set_context)
{ {
hexchat_context *ctx; hexchat_context *ctx;
dXSARGS; dXSARGS;
if (items != 1) { if (items != 1) {
hexchat_print (ph, "Usage: Xchat::set_context(ctx)"); hexchat_print (ph, "Usage: HexChat::set_context(ctx)");
} else { } else {
ctx = INT2PTR (hexchat_context *, SvUV (ST (0))); ctx = INT2PTR (hexchat_context *, SvUV (ST (0)));
XSRETURN_IV ((IV) hexchat_set_context (ph, ctx)); XSRETURN_IV ((IV) hexchat_set_context (ph, ctx));
@ -1215,11 +1215,11 @@ XS (XS_Xchat_set_context)
} }
static static
XS (XS_Xchat_nickcmp) XS (XS_HexChat_nickcmp)
{ {
dXSARGS; dXSARGS;
if (items != 2) { if (items != 2) {
hexchat_print (ph, "Usage: Xchat::nickcmp(s1, s2)"); hexchat_print (ph, "Usage: HexChat::nickcmp(s1, s2)");
} else { } else {
XSRETURN_IV ((IV) hexchat_nickcmp (ph, SvPV_nolen (ST (0)), XSRETURN_IV ((IV) hexchat_nickcmp (ph, SvPV_nolen (ST (0)),
SvPV_nolen (ST (1)))); SvPV_nolen (ST (1))));
@ -1227,7 +1227,7 @@ XS (XS_Xchat_nickcmp)
} }
static static
XS (XS_Xchat_get_list) XS (XS_HexChat_get_list)
{ {
SV *name; SV *name;
hexchat_list *list; hexchat_list *list;
@ -1236,7 +1236,7 @@ XS (XS_Xchat_get_list)
dXSARGS; dXSARGS;
if (items != 1) { if (items != 1) {
hexchat_print (ph, "Usage: Xchat::get_list(name)"); hexchat_print (ph, "Usage: HexChat::get_list(name)");
} else { } else {
SP -= items; /*remove the argument list from the stack */ SP -= items; /*remove the argument list from the stack */
@ -1268,12 +1268,12 @@ XS (XS_Xchat_get_list)
} }
static static
XS (XS_Xchat_Embed_plugingui_remove) XS (XS_HexChat_Embed_plugingui_remove)
{ {
void *gui_entry; void *gui_entry;
dXSARGS; dXSARGS;
if (items != 1) { if (items != 1) {
hexchat_print (ph, "Usage: Xchat::Embed::plugingui_remove(handle)"); hexchat_print (ph, "Usage: HexChat::Embed::plugingui_remove(handle)");
} else { } else {
gui_entry = INT2PTR (void *, SvUV (ST (0))); gui_entry = INT2PTR (void *, SvUV (ST (0)));
hexchat_plugingui_remove (ph, gui_entry); hexchat_plugingui_remove (ph, gui_entry);
@ -1281,6 +1281,72 @@ XS (XS_Xchat_Embed_plugingui_remove)
XSRETURN_EMPTY; XSRETURN_EMPTY;
} }
static
XS (XS_HexChat_plugin_pref_set)
{
dMARK;
dAX;
XSRETURN_IV ((IV) hexchat_pluginpref_set_str (ph, SvPV_nolen (ST (0)),
SvPV_nolen (ST (1))));
}
static
XS (XS_HexChat_plugin_pref_get)
{
int result;
char value[512];
dMARK;
dAX;
result = hexchat_pluginpref_get_str (ph, SvPV_nolen (ST (0)), value);
if (result)
XSRETURN_PV (value);
XSRETURN_UNDEF;
}
static
XS (XS_HexChat_plugin_pref_delete)
{
dMARK;
dAX;
XSRETURN_IV ((IV) hexchat_pluginpref_delete (ph, SvPV_nolen (ST (0))));
}
static
XS (XS_HexChat_plugin_pref_list)
{
char list[4096];
char value[512];
char *token;
dSP;
dMARK;
dAX;
if (!hexchat_pluginpref_list (ph, list))
XSRETURN_EMPTY;
PUSHMARK (SP);
token = strtok (list, ",");
while (token != NULL)
{
hexchat_pluginpref_get_str (ph, token, value);
XPUSHs (sv_2mortal (newSVpv (token, 0)));
XPUSHs (sv_2mortal (newSVpv (value, 0)));
token = strtok (NULL, ",");
}
PUTBACK;
}
/* xs_init is the second argument perl_parse. As the name hints, it /* xs_init is the second argument perl_parse. As the name hints, it
initializes XS subroutines (see the perlembed manpage) */ initializes XS subroutines (see the perlembed manpage) */
static void static void
@ -1292,31 +1358,36 @@ xs_init (pTHX)
scripts by the 'use perlmod;' construction */ scripts by the 'use perlmod;' construction */
newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
/* load up all the custom IRC perl functions */ /* load up all the custom IRC perl functions */
newXS ("Xchat::Internal::register", XS_Xchat_register, __FILE__); newXS ("HexChat::Internal::register", XS_HexChat_register, __FILE__);
newXS ("Xchat::Internal::hook_server", XS_Xchat_hook_server, __FILE__); newXS ("HexChat::Internal::hook_server", XS_HexChat_hook_server, __FILE__);
newXS ("Xchat::Internal::hook_command", XS_Xchat_hook_command, __FILE__); newXS ("HexChat::Internal::hook_command", XS_HexChat_hook_command, __FILE__);
newXS ("Xchat::Internal::hook_print", XS_Xchat_hook_print, __FILE__); newXS ("HexChat::Internal::hook_print", XS_HexChat_hook_print, __FILE__);
newXS ("Xchat::Internal::hook_timer", XS_Xchat_hook_timer, __FILE__); newXS ("HexChat::Internal::hook_timer", XS_HexChat_hook_timer, __FILE__);
newXS ("Xchat::Internal::hook_fd", XS_Xchat_hook_fd, __FILE__); newXS ("HexChat::Internal::hook_fd", XS_HexChat_hook_fd, __FILE__);
newXS ("Xchat::Internal::unhook", XS_Xchat_unhook, __FILE__); newXS ("HexChat::Internal::unhook", XS_HexChat_unhook, __FILE__);
newXS ("Xchat::Internal::print", XS_Xchat_print, __FILE__); newXS ("HexChat::Internal::print", XS_HexChat_print, __FILE__);
newXS ("Xchat::Internal::command", XS_Xchat_command, __FILE__); newXS ("HexChat::Internal::command", XS_HexChat_command, __FILE__);
newXS ("Xchat::Internal::set_context", XS_Xchat_set_context, __FILE__); newXS ("HexChat::Internal::set_context", XS_HexChat_set_context, __FILE__);
newXS ("Xchat::Internal::get_info", XS_Xchat_get_info, __FILE__); newXS ("HexChat::Internal::get_info", XS_HexChat_get_info, __FILE__);
newXS ("Xchat::Internal::context_info", XS_Xchat_context_info, __FILE__); newXS ("HexChat::Internal::context_info", XS_HexChat_context_info, __FILE__);
newXS ("Xchat::Internal::get_list", XS_Xchat_get_list, __FILE__); newXS ("HexChat::Internal::get_list", XS_HexChat_get_list, __FILE__);
newXS ("Xchat::find_context", XS_Xchat_find_context, __FILE__);
newXS ("Xchat::get_context", XS_Xchat_get_context, __FILE__);
newXS ("Xchat::get_prefs", XS_Xchat_get_prefs, __FILE__);
newXS ("Xchat::emit_print", XS_Xchat_emit_print, __FILE__);
newXS ("Xchat::send_modes", XS_Xchat_send_modes, __FILE__);
newXS ("Xchat::nickcmp", XS_Xchat_nickcmp, __FILE__);
newXS ("Xchat::Embed::plugingui_remove", XS_Xchat_Embed_plugingui_remove, newXS ("HexChat::Internal::plugin_pref_set", XS_HexChat_plugin_pref_set, __FILE__);
newXS ("HexChat::Internal::plugin_pref_get", XS_HexChat_plugin_pref_get, __FILE__);
newXS ("HexChat::Internal::plugin_pref_delete", XS_HexChat_plugin_pref_delete, __FILE__);
newXS ("HexChat::Internal::plugin_pref_list", XS_HexChat_plugin_pref_list, __FILE__);
newXS ("HexChat::find_context", XS_HexChat_find_context, __FILE__);
newXS ("HexChat::get_context", XS_HexChat_get_context, __FILE__);
newXS ("HexChat::get_prefs", XS_HexChat_get_prefs, __FILE__);
newXS ("HexChat::emit_print", XS_HexChat_emit_print, __FILE__);
newXS ("HexChat::send_modes", XS_HexChat_send_modes, __FILE__);
newXS ("HexChat::nickcmp", XS_HexChat_nickcmp, __FILE__);
newXS ("HexChat::Embed::plugingui_remove", XS_HexChat_Embed_plugingui_remove,
__FILE__); __FILE__);
stash = get_hv ("Xchat::", TRUE); stash = get_hv ("HexChat::", TRUE);
if (stash == NULL) { if (stash == NULL) {
exit (1); exit (1);
} }
@ -1328,7 +1399,8 @@ xs_init (pTHX)
newCONSTSUB (stash, "PRI_LOWEST", newSViv (HEXCHAT_PRI_LOWEST)); newCONSTSUB (stash, "PRI_LOWEST", newSViv (HEXCHAT_PRI_LOWEST));
newCONSTSUB (stash, "EAT_NONE", newSViv (HEXCHAT_EAT_NONE)); newCONSTSUB (stash, "EAT_NONE", newSViv (HEXCHAT_EAT_NONE));
newCONSTSUB (stash, "EAT_XCHAT", newSViv (HEXCHAT_EAT_HEXCHAT)); newCONSTSUB (stash, "EAT_HEXCHAT", newSViv (HEXCHAT_EAT_HEXCHAT));
newCONSTSUB (stash, "EAT_XCHAT", newSViv (HEXCHAT_EAT_HEXCHAT)); /* for compatibility */
newCONSTSUB (stash, "EAT_PLUGIN", newSViv (HEXCHAT_EAT_PLUGIN)); newCONSTSUB (stash, "EAT_PLUGIN", newSViv (HEXCHAT_EAT_PLUGIN));
newCONSTSUB (stash, "EAT_ALL", newSViv (HEXCHAT_EAT_ALL)); newCONSTSUB (stash, "EAT_ALL", newSViv (HEXCHAT_EAT_ALL));
newCONSTSUB (stash, "FD_READ", newSViv (HEXCHAT_FD_READ)); newCONSTSUB (stash, "FD_READ", newSViv (HEXCHAT_FD_READ));
@ -1338,7 +1410,7 @@ xs_init (pTHX)
newCONSTSUB (stash, "KEEP", newSViv (1)); newCONSTSUB (stash, "KEEP", newSViv (1));
newCONSTSUB (stash, "REMOVE", newSViv (0)); newCONSTSUB (stash, "REMOVE", newSViv (0));
version = get_sv( "Xchat::VERSION", 1 ); version = get_sv( "HexChat::VERSION", 1 );
sv_setpv( version, PACKAGE_VERSION ); sv_setpv( version, PACKAGE_VERSION );
} }
@ -1352,7 +1424,7 @@ perl_init (void)
static const char xchat_definitions[] = { static const char xchat_definitions[] = {
/* Redefine the $SIG{__WARN__} handler to have HexChat /* Redefine the $SIG{__WARN__} handler to have HexChat
printing warnings in the main window. (TheHobbit) */ printing warnings in the main window. (TheHobbit) */
#include "xchat.pm.h" #include "hexchat.pm.h"
}; };
#ifdef OLD_PERL #ifdef OLD_PERL
static const char irc_definitions[] = { static const char irc_definitions[] = {
@ -1448,7 +1520,7 @@ perl_load_file (char *filename)
perl_init (); perl_init ();
} }
return execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::load", 0)), return execute_perl (sv_2mortal (newSVpv ("HexChat::Embed::load", 0)),
filename); filename);
} }
@ -1458,7 +1530,7 @@ perl_end (void)
{ {
if (my_perl != NULL) { if (my_perl != NULL) {
execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), ""); execute_perl (sv_2mortal (newSVpv ("HexChat::Embed::unload_all", 0)), "");
PL_perl_destruct_level = 1; PL_perl_destruct_level = 1;
perl_destruct (my_perl); perl_destruct (my_perl);
perl_free (my_perl); perl_free (my_perl);
@ -1472,7 +1544,7 @@ static int
perl_command_unloadall (char *word[], char *word_eol[], void *userdata) perl_command_unloadall (char *word[], char *word_eol[], void *userdata)
{ {
if (my_perl != NULL) { if (my_perl != NULL) {
execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), ""); execute_perl (sv_2mortal (newSVpv ("HexChat::Embed::unload_all", 0)), "");
return HEXCHAT_EAT_HEXCHAT; return HEXCHAT_EAT_HEXCHAT;
} }
@ -1483,7 +1555,7 @@ static int
perl_command_reloadall (char *word[], char *word_eol[], void *userdata) perl_command_reloadall (char *word[], char *word_eol[], void *userdata)
{ {
if (my_perl != NULL) { if (my_perl != NULL) {
execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload_all", 0)), ""); execute_perl (sv_2mortal (newSVpv ("HexChat::Embed::reload_all", 0)), "");
return HEXCHAT_EAT_HEXCHAT; return HEXCHAT_EAT_HEXCHAT;
} else { } else {
@ -1512,7 +1584,7 @@ perl_command_unload (char *word[], char *word_eol[], void *userdata)
char *file = get_filename (word, word_eol); char *file = get_filename (word, word_eol);
if (my_perl != NULL && file != NULL) { if (my_perl != NULL && file != NULL) {
execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload", 0)), file); execute_perl (sv_2mortal (newSVpv ("HexChat::Embed::unload", 0)), file);
return HEXCHAT_EAT_HEXCHAT; return HEXCHAT_EAT_HEXCHAT;
} }
@ -1525,7 +1597,7 @@ perl_command_reload (char *word[], char *word_eol[], void *eat)
char *file = get_filename (word, word_eol); char *file = get_filename (word, word_eol);
if (my_perl != NULL && file != NULL) { if (my_perl != NULL && file != NULL) {
execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload", 0)), file); execute_perl (sv_2mortal (newSVpv ("HexChat::Embed::reload", 0)), file);
return HEXCHAT_EAT_HEXCHAT; return HEXCHAT_EAT_HEXCHAT;
} }
@ -1535,6 +1607,15 @@ perl_command_reload (char *word[], char *word_eol[], void *eat)
return HEXCHAT_EAT_NONE; return HEXCHAT_EAT_NONE;
} }
static int
perl_command_eval (char *word[], char *word_eol[], void *userdata)
{
if (my_perl != NULL)
execute_perl (sv_2mortal (newSVpv ("HexChat::Embed::evaluate", 0)), word_eol[2]);
return HEXCHAT_EAT_HEXCHAT;
}
void void
hexchat_plugin_get_info (char **name, char **desc, char **version, hexchat_plugin_get_info (char **name, char **desc, char **version,
void **reserved) void **reserved)
@ -1572,12 +1653,15 @@ hexchat_plugin_init (hexchat_plugin * plugin_handle, char **plugin_name,
0); 0);
hexchat_hook_command (ph, "reload", HEXCHAT_PRI_NORM, perl_command_reload, 0, hexchat_hook_command (ph, "reload", HEXCHAT_PRI_NORM, perl_command_reload, 0,
0); 0);
hexchat_hook_command (ph, "pl_reload", HEXCHAT_PRI_NORM, perl_command_reload, 0, hexchat_hook_command (ph, "pl_reload", HEXCHAT_PRI_NORM, perl_command_reload,
(int*)1); "Reloads a Perl script. Syntax: /pl_reload <filename.pl>", (int*)1);
hexchat_hook_command (ph, "unloadall", HEXCHAT_PRI_NORM, hexchat_hook_command (ph, "unloadall", HEXCHAT_PRI_NORM,
perl_command_unloadall, 0, 0); perl_command_unloadall, "Unloads all loaded Perl scripts.", 0);
hexchat_hook_command (ph, "reloadall", HEXCHAT_PRI_NORM, hexchat_hook_command (ph, "reloadall", HEXCHAT_PRI_NORM,
perl_command_reloadall, 0, 0); perl_command_reloadall, "Realoads all loaded Perl scripts.", 0);
hexchat_hook_command (ph, "pl", HEXCHAT_PRI_NORM,
perl_command_eval, "Evaluates Perl code. Syntax: /pl <perl code>", 0);
/*perl_init (); */ /*perl_init (); */
hexchat_hook_timer (ph, 0, perl_auto_load, NULL ); hexchat_hook_timer (ph, 0, perl_auto_load, NULL );

View File

@ -81,7 +81,7 @@ move $(PerlLib).def "$(IntDir)"
lib /nologo /machine:x86 "/def:$(IntDir)$(PerlLib).def" "/out:$(OutDir)\$(PerlLib).lib" lib /nologo /machine:x86 "/def:$(IntDir)$(PerlLib).def" "/out:$(OutDir)\$(PerlLib).lib"
"$(PerlPath)\bin\perl.exe" generate_header "$(PerlPath)\bin\perl.exe" generate_header
move irc.pm.h "$(IntDir)" move irc.pm.h "$(IntDir)"
move xchat.pm.h "$(IntDir)"</Command> move hexchat.pm.h "$(IntDir)"</Command>
</PreBuildEvent> </PreBuildEvent>
</ItemDefinitionGroup> </ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'"> <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
@ -110,7 +110,7 @@ move $(PerlLib).def "$(IntDir)"
lib /nologo /machine:x64 "/def:$(IntDir)$(PerlLib).def" "/out:$(OutDir)\$(PerlLib).lib" lib /nologo /machine:x64 "/def:$(IntDir)$(PerlLib).def" "/out:$(OutDir)\$(PerlLib).lib"
"$(PerlPath)\bin\perl.exe" generate_header "$(PerlPath)\bin\perl.exe" generate_header
move irc.pm.h "$(IntDir)" move irc.pm.h "$(IntDir)"
move xchat.pm.h "$(IntDir)"</Command> move hexchat.pm.h "$(IntDir)"</Command>
</PreBuildEvent> </PreBuildEvent>
</ItemDefinitionGroup> </ItemDefinitionGroup>
<ItemGroup> <ItemGroup>