SoniEx2
/
c.sexchat
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
plugins/perl/Makefile.am
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

13
plugins/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

59
plugins/perl/lib/Xchat/Embed.pm → plugins/perl/lib/HexChat/Embed.pm
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++;
} }

6
plugins/perl/lib/Xchat/List/Network.pm → plugins/perl/lib/HexChat/List/Network.pm
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': $!";

2
plugins/perl/lib/Xchat/List/Network/AutoJoin.pm → plugins/perl/lib/HexChat/List/Network/AutoJoin.pm
View File

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

6
plugins/perl/lib/Xchat/List/Network/Entry.pm → plugins/perl/lib/HexChat/List/Network/Entry.pm
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 ) {

526
plugins/perl/lib/Xchat.pm
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

258
plugins/perl/perl.c
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 );

4
plugins/perl/perl.vcxproj
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>