diff --git a/plugins/perl/Makefile.am b/plugins/perl/Makefile.am index 02f29252..b54df005 100644 --- a/plugins/perl/Makefile.am +++ b/plugins/perl/Makefile.am @@ -1,6 +1,6 @@ -EXTRA_DIST=alt_completion.pl generate_header lib/Xchat.pm lib/Xchat/Embed.pm lib/Xchat/List/Network.pm \ - lib/Xchat/List/Network/Entry.pm lib/Xchat/List/Network/AutoJoin.pm lib/IRC.pm +EXTRA_DIST=alt_completion.pl generate_header lib/HexChat.pm lib/Xchat.pm lib/HexChat/Embed.pm lib/HexChat/List/Network.pm \ + lib/HexChat/List/Network/Entry.pm lib/HexChat/List/Network/AutoJoin.pm lib/IRC.pm libdir = $(hexchatlibdir) @@ -8,11 +8,11 @@ lib_LTLIBRARIES = perl.la perl_la_SOURCES = perl.c perl_la_LDFLAGS = -avoid-version -module 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 AM_CPPFLAGS = $(PERL_CFLAGS) $(COMMON_CFLAGS) -I$(srcdir)/../../src/common -CLEANFILES = xchat.pm.h irc.pm.h -xchat.pm.h irc.pm.h: lib/Xchat.pm lib/Xchat/Embed.pm \ - lib/Xchat/List/Network.pm lib/Xchat/List/Network/Entry.pm \ - lib/Xchat/List/Network/AutoJoin.pm lib/IRC.pm +CLEANFILES = hexchat.pm.h irc.pm.h +hexchat.pm.h irc.pm.h: lib/HexChat.pm lib/Xchat.pm lib/HexChat/Embed.pm \ + lib/HexChat/List/Network.pm lib/HexChat/List/Network/Entry.pm \ + lib/HexChat/List/Network/AutoJoin.pm lib/IRC.pm perl generate_header diff --git a/plugins/perl/generate_header b/plugins/perl/generate_header index 37e7d323..7dd437ce 100644 --- a/plugins/perl/generate_header +++ b/plugins/perl/generate_header @@ -25,12 +25,13 @@ sub toc { } for my $files ( - [ "xchat.pm.h", # output file - "lib/Xchat.pm", # input files - "lib/Xchat/Embed.pm", - "lib/Xchat/List/Network.pm", - "lib/Xchat/List/Network/Entry.pm", - "lib/Xchat/List/Network/AutoJoin.pm", + [ "hexchat.pm.h", # output file + "lib/HexChat.pm", # input files + "lib/Xchat.pm", + "lib/HexChat/Embed.pm", + "lib/HexChat/List/Network.pm", + "lib/HexChat/List/Network/Entry.pm", + "lib/HexChat/List/Network/AutoJoin.pm", ], [ "irc.pm.h", # output file "lib/IRC.pm" # input file diff --git a/plugins/perl/lib/HexChat.pm b/plugins/perl/lib/HexChat.pm new file mode 100644 index 00000000..ebbed4fb --- /dev/null +++ b/plugins/perl/lib/HexChat.pm @@ -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 diff --git a/plugins/perl/lib/Xchat/Embed.pm b/plugins/perl/lib/HexChat/Embed.pm similarity index 87% rename from plugins/perl/lib/Xchat/Embed.pm rename to plugins/perl/lib/HexChat/Embed.pm index 6993dc6e..c033d3c9 100644 --- a/plugins/perl/lib/Xchat/Embed.pm +++ b/plugins/perl/lib/HexChat/Embed.pm @@ -1,6 +1,7 @@ -package Xchat::Embed; +package HexChat::Embed; use strict; use warnings; +use Data::Dumper; # list of loaded scripts keyed by their package names # The package names are generated from the filename of the script using # the file2pkg() function. @@ -42,11 +43,11 @@ sub load { if( exists $scripts{$package} ) { my $pkg_info = pkg_info( $package ); my $filename = File::Basename::basename( $pkg_info->{filename} ); - Xchat::printf( + HexChat::printf( qq{'%s' already loaded from '%s'.\n}, $filename, $pkg_info->{filename} ); - Xchat::print( + HexChat::print( 'If this is a different script then it rename and try '. 'loading it again.' ); @@ -60,7 +61,7 @@ sub load { $source =~ s/^__END__.*//ms; # this must come before the eval or the filename will not be found in - # Xchat::register + # HexChat::register $scripts{$package}{filename} = $file; $scripts{$package}{loaded_at} = Time::HiRes::time(); @@ -93,7 +94,7 @@ sub load { $error_message .= " $conflict_package already defined in " . pkg_info($owner_package{ $conflict_package })->{filename}."\n"; } - Xchat::print( $error_message ); + HexChat::print( $error_message ); return 2; } @@ -114,7 +115,7 @@ sub load { unless( exists $scripts{$package}{gui_entry} ) { $scripts{$package}{gui_entry} = - Xchat::Internal::register( + HexChat::Internal::register( "", "unknown", "", $file ); } @@ -122,13 +123,13 @@ sub load { if( $@ ) { # something went wrong $@ =~ 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 unload( $scripts{$package}{filename} ); return 1; } } else { - Xchat::print( "Error opening '$file': $!\n" ); + HexChat::print( "Error opening '$file': $!\n" ); return 2; } @@ -162,7 +163,7 @@ sub unload { if( exists $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 ); delete $scripts{$package}; - return Xchat::EAT_ALL; + return HexChat::EAT_ALL; } else { - Xchat::print( qq{"$file" is not loaded.\n} ); - return Xchat::EAT_NONE; + HexChat::print( qq{"$file" is not loaded.\n} ); + return HexChat::EAT_NONE; } } @@ -188,7 +189,7 @@ sub unload_all { unload( $scripts{$package}->{filename} ); } - return Xchat::EAT_ALL; + return HexChat::EAT_ALL; } sub reload { @@ -203,11 +204,11 @@ sub reload { } load( $fullpath ); - return Xchat::EAT_ALL; + return HexChat::EAT_ALL; } sub reload_all { - my @dirs = Xchat::get_info( "configdir" ); + my @dirs = HexChat::get_info( "configdir" ); push @dirs, File::Spec->catdir( $dirs[0], "plugins" ); for my $dir ( @dirs ) { 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 { my $file = shift @_; @@ -244,7 +267,7 @@ sub file2pkg { my $string = File::Basename::basename( shift @_ ); $string =~ s/\.pl$//i; $string =~ s|([^A-Za-z0-9/])|'_'.unpack("H*",$1)|eg; - return "Xchat::Script::" . $string; + return "HexChat::Script::" . $string; } sub pkg_info { @@ -256,7 +279,7 @@ sub find_external_pkg { my $level = 1; while( my @frame = caller( $level ) ) { - return @frame if $frame[0] !~ /(?:^IRC$|^Xchat)/; + return @frame if $frame[0] !~ /(?:^IRC$|^HexChat)/; $level++; } return; @@ -266,7 +289,7 @@ sub find_pkg { my $level = 1; while( my ($package, $file, $line) = caller( $level ) ) { - return $package if $package =~ /^Xchat::Script::/; + return $package if $package =~ /^HexChat::Script::/; $level++; } diff --git a/plugins/perl/lib/Xchat/List/Network.pm b/plugins/perl/lib/HexChat/List/Network.pm similarity index 77% rename from plugins/perl/lib/Xchat/List/Network.pm rename to plugins/perl/lib/HexChat/List/Network.pm index 3a7e2ae6..64b3d14c 100644 --- a/plugins/perl/lib/Xchat/List/Network.pm +++ b/plugins/perl/lib/HexChat/List/Network.pm @@ -1,4 +1,4 @@ -package Xchat::List::Network; +package HexChat::List::Network; use strict; use warnings; use Storable qw(dclone); @@ -6,7 +6,7 @@ my $last_modified; my @servers; 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 if( -f $server_file && @@ -19,7 +19,7 @@ sub get { while( my $record = <$fh> ) { chomp $record; 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 { warn "Unable to open '$server_file': $!"; diff --git a/plugins/perl/lib/Xchat/List/Network/AutoJoin.pm b/plugins/perl/lib/HexChat/List/Network/AutoJoin.pm similarity index 96% rename from plugins/perl/lib/Xchat/List/Network/AutoJoin.pm rename to plugins/perl/lib/HexChat/List/Network/AutoJoin.pm index 8b4e40d2..cc51af25 100644 --- a/plugins/perl/lib/Xchat/List/Network/AutoJoin.pm +++ b/plugins/perl/lib/HexChat/List/Network/AutoJoin.pm @@ -1,4 +1,4 @@ -package Xchat::List::Network::AutoJoin; +package HexChat::List::Network::AutoJoin; use strict; use warnings; diff --git a/plugins/perl/lib/Xchat/List/Network/Entry.pm b/plugins/perl/lib/HexChat/List/Network/Entry.pm similarity index 92% rename from plugins/perl/lib/Xchat/List/Network/Entry.pm rename to plugins/perl/lib/HexChat/List/Network/Entry.pm index 6f2aa925..828a7791 100644 --- a/plugins/perl/lib/Xchat/List/Network/Entry.pm +++ b/plugins/perl/lib/HexChat/List/Network/Entry.pm @@ -1,4 +1,4 @@ -package Xchat::List::Network::Entry; +package HexChat::List::Network::Entry; use strict; use warnings; @@ -26,7 +26,7 @@ sub parse { # the order of the channels need to be maintained # list of { channel => .., key => ... } - autojoins => Xchat::List::Network::AutoJoin->new( '' ), + autojoins => HexChat::List::Network::AutoJoin->new( '' ), connect_commands => [], flags => {}, selected => undef, @@ -39,7 +39,7 @@ sub parse { my @fields = split /\n/, $data; chomp @fields; - $entry->{ autojoins } = Xchat::List::Network::AutoJoin->new(); + $entry->{ autojoins } = HexChat::List::Network::AutoJoin->new(); for my $field ( @fields ) { SWITCH: for ( $field ) { diff --git a/plugins/perl/lib/Xchat.pm b/plugins/perl/lib/Xchat.pm index 1ead64c3..2a95674e 100644 --- a/plugins/perl/lib/Xchat.pm +++ b/plugins/perl/lib/Xchat.pm @@ -1,525 +1 @@ -$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 &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 +require HexChat; diff --git a/plugins/perl/perl.c b/plugins/perl/perl.c index af7865d7..79baff5a 100644 --- a/plugins/perl/perl.c +++ b/plugins/perl/perl.c @@ -323,11 +323,11 @@ array2av (char *array[]) return av; } -/* sets $Xchat::Embed::current_package */ +/* sets $HexChat::Embed::current_package */ static void 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); } @@ -367,7 +367,7 @@ fd_cb (int fd, int flags, void *userdata) XPUSHs (sv_2mortal (newSViv (PTR2IV (data->hook)))); PUTBACK; - call_pv ("Xchat::unhook", G_EVAL); + call_pv ("HexChat::unhook", G_EVAL); SPAGAIN; SvREFCNT_dec (data->callback); @@ -429,7 +429,7 @@ timer_cb (void *userdata) XPUSHs (sv_mortalcopy (data->package)); PUTBACK; - call_pv ("Xchat::unhook", G_EVAL); + call_pv ("HexChat::unhook", G_EVAL); SPAGAIN; } } @@ -619,19 +619,19 @@ print_cb (char *word[], void *userdata) /* custom IRC perl functions for scripting */ -/* Xchat::Internal::register (scriptname, version, desc, shutdowncallback, filename) +/* HexChat::Internal::register (scriptname, version, desc, shutdowncallback, filename) * */ static -XS (XS_Xchat_register) +XS (XS_HexChat_register) { char *name, *version, *desc, *filename; void *gui_entry; dXSARGS; if (items != 4) { hexchat_printf (ph, - "Usage: Xchat::Internal::register(scriptname, version, desc, filename)"); + "Usage: HexChat::Internal::register(scriptname, version, desc, filename)"); } else { name = SvPV_nolen (ST (0)); version = SvPV_nolen (ST (1)); @@ -647,16 +647,16 @@ XS (XS_Xchat_register) } -/* Xchat::print(output) */ +/* HexChat::print(output) */ static -XS (XS_Xchat_print) +XS (XS_HexChat_print) { char *text = NULL; dXSARGS; if (items != 1) { - hexchat_print (ph, "Usage: Xchat::Internal::print(text)"); + hexchat_print (ph, "Usage: HexChat::Internal::print(text)"); } else { text = SvPV_nolen (ST (0)); hexchat_print (ph, text); @@ -665,7 +665,7 @@ XS (XS_Xchat_print) } static -XS (XS_Xchat_emit_print) +XS (XS_HexChat_emit_print) { char *event_name; int RETVAL; @@ -673,7 +673,7 @@ XS (XS_Xchat_emit_print) dXSARGS; if (items < 1) { - hexchat_print (ph, "Usage: Xchat::emit_print(event_name, ...)"); + hexchat_print (ph, "Usage: HexChat::emit_print(event_name, ...)"); } else { event_name = (char *) SvPV_nolen (ST (0)); RETVAL = 0; @@ -719,7 +719,7 @@ XS (XS_Xchat_emit_print) } static -XS (XS_Xchat_send_modes) +XS (XS_HexChat_send_modes) { AV *p_targets = NULL; int modes_per_line = 0; @@ -733,7 +733,7 @@ XS (XS_Xchat_send_modes) dXSARGS; if (items < 3 || items > 4) { hexchat_print (ph, - "Usage: Xchat::send_modes( targets, sign, mode, modes_per_line)" + "Usage: HexChat::send_modes( targets, sign, mode, modes_per_line)" ); } else { if (SvROK (ST (0))) { @@ -771,12 +771,12 @@ XS (XS_Xchat_send_modes) } } static -XS (XS_Xchat_get_info) +XS (XS_HexChat_get_info) { SV *temp = NULL; dXSARGS; if (items != 1) { - hexchat_print (ph, "Usage: Xchat::get_info(id)"); + hexchat_print (ph, "Usage: HexChat::get_info(id)"); } else { SV *id = ST (0); const char *RETVAL; @@ -810,13 +810,13 @@ XS (XS_Xchat_get_info) } static -XS (XS_Xchat_context_info) +XS (XS_HexChat_context_info) { const char *const *fields; dXSARGS; 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" ); XPUSHs (list_item_to_sv (NULL, fields)); @@ -824,14 +824,14 @@ XS (XS_Xchat_context_info) } static -XS (XS_Xchat_get_prefs) +XS (XS_HexChat_get_prefs) { const char *str; int integer; SV *temp = NULL; dXSARGS; if (items != 1) { - hexchat_print (ph, "Usage: Xchat::get_prefs(name)"); + hexchat_print (ph, "Usage: HexChat::get_prefs(name)"); } 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 -XS (XS_Xchat_hook_server) +XS (XS_HexChat_hook_server) { char *name; @@ -877,7 +877,7 @@ XS (XS_Xchat_hook_server) if (items != 5) { hexchat_print (ph, - "Usage: Xchat::Internal::hook_server(name, priority, callback, userdata, package)"); + "Usage: HexChat::Internal::hook_server(name, priority, callback, userdata, package)"); } else { name = SvPV_nolen (ST (0)); 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 -XS (XS_Xchat_hook_command) +XS (XS_HexChat_hook_command) { char *name; int pri; @@ -918,7 +918,7 @@ XS (XS_Xchat_hook_command) if (items != 6) { 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 { name = SvPV_nolen (ST (0)); 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 -XS (XS_Xchat_hook_print) +XS (XS_HexChat_hook_print) { char *name; @@ -965,7 +965,7 @@ XS (XS_Xchat_hook_print) dXSARGS; if (items != 5) { hexchat_print (ph, - "Usage: Xchat::Internal::hook_print(name, priority, callback, userdata, package)"); + "Usage: HexChat::Internal::hook_print(name, priority, callback, userdata, package)"); } else { name = SvPV_nolen (ST (0)); 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 -XS (XS_Xchat_hook_timer) +XS (XS_HexChat_hook_timer) { int timeout; SV *callback; @@ -1004,7 +1004,7 @@ XS (XS_Xchat_hook_timer) if (items != 4) { hexchat_print (ph, - "Usage: Xchat::Internal::hook_timer(timeout, callback, userdata, package)"); + "Usage: HexChat::Internal::hook_timer(timeout, callback, userdata, package)"); } else { timeout = (int) SvIV (ST (0)); 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 -XS (XS_Xchat_hook_fd) +XS (XS_HexChat_hook_fd) { int fd; SV *callback; @@ -1044,7 +1044,7 @@ XS (XS_Xchat_hook_fd) if (items != 5) { hexchat_print (ph, - "Usage: Xchat::Internal::hook_fd(fd, callback, flags, userdata)"); + "Usage: HexChat::Internal::hook_fd(fd, callback, flags, userdata)"); } else { fd = (int) SvIV (ST (0)); callback = ST (1); @@ -1083,14 +1083,14 @@ XS (XS_Xchat_hook_fd) } static -XS (XS_Xchat_unhook) +XS (XS_HexChat_unhook) { hexchat_hook *hook; HookData *userdata; int retCount = 0; dXSARGS; if (items != 1) { - hexchat_print (ph, "Usage: Xchat::unhook(hook)"); + hexchat_print (ph, "Usage: HexChat::unhook(hook)"); } else { hook = INT2PTR (hexchat_hook *, SvUV (ST (0))); userdata = (HookData *) hexchat_unhook (ph, hook); @@ -1117,15 +1117,15 @@ XS (XS_Xchat_unhook) XSRETURN_EMPTY; } -/* Xchat::Internal::command(command) */ +/* HexChat::Internal::command(command) */ static -XS (XS_Xchat_command) +XS (XS_HexChat_command) { char *cmd = NULL; dXSARGS; if (items != 1) { - hexchat_print (ph, "Usage: Xchat::Internal::command(command)"); + hexchat_print (ph, "Usage: HexChat::Internal::command(command)"); } else { cmd = SvPV_nolen (ST (0)); hexchat_command (ph, cmd); @@ -1135,7 +1135,7 @@ XS (XS_Xchat_command) } static -XS (XS_Xchat_find_context) +XS (XS_HexChat_find_context) { char *server = NULL; char *chan = NULL; @@ -1143,7 +1143,7 @@ XS (XS_Xchat_find_context) dXSARGS; if (items > 2) - hexchat_print (ph, "Usage: Xchat::find_context ([channel, [server]])"); + hexchat_print (ph, "Usage: HexChat::find_context ([channel, [server]])"); { switch (items) { @@ -1191,23 +1191,23 @@ XS (XS_Xchat_find_context) } static -XS (XS_Xchat_get_context) +XS (XS_HexChat_get_context) { dXSARGS; if (items != 0) { - hexchat_print (ph, "Usage: Xchat::get_context()"); + hexchat_print (ph, "Usage: HexChat::get_context()"); } else { XSRETURN_IV (PTR2IV (hexchat_get_context (ph))); } } static -XS (XS_Xchat_set_context) +XS (XS_HexChat_set_context) { hexchat_context *ctx; dXSARGS; if (items != 1) { - hexchat_print (ph, "Usage: Xchat::set_context(ctx)"); + hexchat_print (ph, "Usage: HexChat::set_context(ctx)"); } else { ctx = INT2PTR (hexchat_context *, SvUV (ST (0))); XSRETURN_IV ((IV) hexchat_set_context (ph, ctx)); @@ -1215,11 +1215,11 @@ XS (XS_Xchat_set_context) } static -XS (XS_Xchat_nickcmp) +XS (XS_HexChat_nickcmp) { dXSARGS; if (items != 2) { - hexchat_print (ph, "Usage: Xchat::nickcmp(s1, s2)"); + hexchat_print (ph, "Usage: HexChat::nickcmp(s1, s2)"); } else { XSRETURN_IV ((IV) hexchat_nickcmp (ph, SvPV_nolen (ST (0)), SvPV_nolen (ST (1)))); @@ -1227,7 +1227,7 @@ XS (XS_Xchat_nickcmp) } static -XS (XS_Xchat_get_list) +XS (XS_HexChat_get_list) { SV *name; hexchat_list *list; @@ -1236,7 +1236,7 @@ XS (XS_Xchat_get_list) dXSARGS; if (items != 1) { - hexchat_print (ph, "Usage: Xchat::get_list(name)"); + hexchat_print (ph, "Usage: HexChat::get_list(name)"); } else { SP -= items; /*remove the argument list from the stack */ @@ -1268,12 +1268,12 @@ XS (XS_Xchat_get_list) } static -XS (XS_Xchat_Embed_plugingui_remove) +XS (XS_HexChat_Embed_plugingui_remove) { void *gui_entry; dXSARGS; if (items != 1) { - hexchat_print (ph, "Usage: Xchat::Embed::plugingui_remove(handle)"); + hexchat_print (ph, "Usage: HexChat::Embed::plugingui_remove(handle)"); } else { gui_entry = INT2PTR (void *, SvUV (ST (0))); hexchat_plugingui_remove (ph, gui_entry); @@ -1281,6 +1281,72 @@ XS (XS_Xchat_Embed_plugingui_remove) 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 initializes XS subroutines (see the perlembed manpage) */ static void @@ -1292,31 +1358,36 @@ xs_init (pTHX) scripts by the 'use perlmod;' construction */ newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); /* load up all the custom IRC perl functions */ - newXS ("Xchat::Internal::register", XS_Xchat_register, __FILE__); - newXS ("Xchat::Internal::hook_server", XS_Xchat_hook_server, __FILE__); - newXS ("Xchat::Internal::hook_command", XS_Xchat_hook_command, __FILE__); - newXS ("Xchat::Internal::hook_print", XS_Xchat_hook_print, __FILE__); - newXS ("Xchat::Internal::hook_timer", XS_Xchat_hook_timer, __FILE__); - newXS ("Xchat::Internal::hook_fd", XS_Xchat_hook_fd, __FILE__); - newXS ("Xchat::Internal::unhook", XS_Xchat_unhook, __FILE__); - newXS ("Xchat::Internal::print", XS_Xchat_print, __FILE__); - newXS ("Xchat::Internal::command", XS_Xchat_command, __FILE__); - newXS ("Xchat::Internal::set_context", XS_Xchat_set_context, __FILE__); - newXS ("Xchat::Internal::get_info", XS_Xchat_get_info, __FILE__); - newXS ("Xchat::Internal::context_info", XS_Xchat_context_info, __FILE__); - newXS ("Xchat::Internal::get_list", XS_Xchat_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 ("HexChat::Internal::register", XS_HexChat_register, __FILE__); + newXS ("HexChat::Internal::hook_server", XS_HexChat_hook_server, __FILE__); + newXS ("HexChat::Internal::hook_command", XS_HexChat_hook_command, __FILE__); + newXS ("HexChat::Internal::hook_print", XS_HexChat_hook_print, __FILE__); + newXS ("HexChat::Internal::hook_timer", XS_HexChat_hook_timer, __FILE__); + newXS ("HexChat::Internal::hook_fd", XS_HexChat_hook_fd, __FILE__); + newXS ("HexChat::Internal::unhook", XS_HexChat_unhook, __FILE__); + newXS ("HexChat::Internal::print", XS_HexChat_print, __FILE__); + newXS ("HexChat::Internal::command", XS_HexChat_command, __FILE__); + newXS ("HexChat::Internal::set_context", XS_HexChat_set_context, __FILE__); + newXS ("HexChat::Internal::get_info", XS_HexChat_get_info, __FILE__); + newXS ("HexChat::Internal::context_info", XS_HexChat_context_info, __FILE__); + newXS ("HexChat::Internal::get_list", XS_HexChat_get_list, __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__); - stash = get_hv ("Xchat::", TRUE); + stash = get_hv ("HexChat::", TRUE); if (stash == NULL) { exit (1); } @@ -1328,7 +1399,8 @@ xs_init (pTHX) newCONSTSUB (stash, "PRI_LOWEST", newSViv (HEXCHAT_PRI_LOWEST)); 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_ALL", newSViv (HEXCHAT_EAT_ALL)); newCONSTSUB (stash, "FD_READ", newSViv (HEXCHAT_FD_READ)); @@ -1338,7 +1410,7 @@ xs_init (pTHX) newCONSTSUB (stash, "KEEP", newSViv (1)); newCONSTSUB (stash, "REMOVE", newSViv (0)); - version = get_sv( "Xchat::VERSION", 1 ); + version = get_sv( "HexChat::VERSION", 1 ); sv_setpv( version, PACKAGE_VERSION ); } @@ -1352,7 +1424,7 @@ perl_init (void) static const char xchat_definitions[] = { /* Redefine the $SIG{__WARN__} handler to have HexChat printing warnings in the main window. (TheHobbit) */ -#include "xchat.pm.h" +#include "hexchat.pm.h" }; #ifdef OLD_PERL static const char irc_definitions[] = { @@ -1448,7 +1520,7 @@ perl_load_file (char *filename) perl_init (); } - return execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::load", 0)), + return execute_perl (sv_2mortal (newSVpv ("HexChat::Embed::load", 0)), filename); } @@ -1458,7 +1530,7 @@ perl_end (void) { 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; perl_destruct (my_perl); perl_free (my_perl); @@ -1472,7 +1544,7 @@ static int perl_command_unloadall (char *word[], char *word_eol[], void *userdata) { 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; } @@ -1483,7 +1555,7 @@ static int perl_command_reloadall (char *word[], char *word_eol[], void *userdata) { 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; } else { @@ -1512,7 +1584,7 @@ perl_command_unload (char *word[], char *word_eol[], void *userdata) char *file = get_filename (word, word_eol); 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; } @@ -1525,7 +1597,7 @@ perl_command_reload (char *word[], char *word_eol[], void *eat) char *file = get_filename (word, word_eol); 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; } @@ -1535,6 +1607,15 @@ perl_command_reload (char *word[], char *word_eol[], void *eat) 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 hexchat_plugin_get_info (char **name, char **desc, char **version, void **reserved) @@ -1572,12 +1653,15 @@ hexchat_plugin_init (hexchat_plugin * plugin_handle, char **plugin_name, 0); hexchat_hook_command (ph, "reload", HEXCHAT_PRI_NORM, perl_command_reload, 0, 0); - hexchat_hook_command (ph, "pl_reload", HEXCHAT_PRI_NORM, perl_command_reload, 0, - (int*)1); + hexchat_hook_command (ph, "pl_reload", HEXCHAT_PRI_NORM, perl_command_reload, + "Reloads a Perl script. Syntax: /pl_reload ", (int*)1); 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, - 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 ", 0); /*perl_init (); */ hexchat_hook_timer (ph, 0, perl_auto_load, NULL ); diff --git a/plugins/perl/perl.vcxproj b/plugins/perl/perl.vcxproj index aa74c037..9d23ad58 100644 --- a/plugins/perl/perl.vcxproj +++ b/plugins/perl/perl.vcxproj @@ -81,7 +81,7 @@ move $(PerlLib).def "$(IntDir)" lib /nologo /machine:x86 "/def:$(IntDir)$(PerlLib).def" "/out:$(OutDir)\$(PerlLib).lib" "$(PerlPath)\bin\perl.exe" generate_header move irc.pm.h "$(IntDir)" -move xchat.pm.h "$(IntDir)" +move hexchat.pm.h "$(IntDir)" @@ -110,7 +110,7 @@ move $(PerlLib).def "$(IntDir)" lib /nologo /machine:x64 "/def:$(IntDir)$(PerlLib).def" "/out:$(OutDir)\$(PerlLib).lib" "$(PerlPath)\bin\perl.exe" generate_header move irc.pm.h "$(IntDir)" -move xchat.pm.h "$(IntDir)" +move hexchat.pm.h "$(IntDir)"