add xchat r1489
This commit is contained in:
berkeviktor@aol.com
20
plugins/perl/Makefile.am
Normal file
20
plugins/perl/Makefile.am
Normal file
@ -0,0 +1,20 @@
|
||||
|
||||
EXTRA_DIST=alt_completion.pl xchat2-perldocs.html xchat2-perl.html \
|
||||
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
|
||||
|
||||
libdir = $(xchatlibdir)/plugins
|
||||
|
||||
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
|
||||
#CFLAGS = @CFLAGS@ -Wno-unused
|
||||
INCLUDES = $(PERL_CFLAGS) $(COMMON_CFLAGS) -I$(srcdir)/..
|
||||
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
|
||||
perl generate_header
|
||||
507
plugins/perl/alt_completion.pl
Normal file
507
plugins/perl/alt_completion.pl
Normal file
@ -0,0 +1,507 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Xchat ();
|
||||
use File::Spec ();
|
||||
use File::Basename qw(fileparse);
|
||||
|
||||
# if the last time you addressed someone was greater than this many minutes
|
||||
# ago, ignore it
|
||||
# this avoids having people you have talked to a long time ago coming up too
|
||||
# early in the completion list
|
||||
# Setting this to 0 will disable the check which is effectively the same as
|
||||
# setting it to infinity
|
||||
my $last_use_threshold = 10; # 10 minutes
|
||||
|
||||
# added to the front of a completion the same way as a suffix, only if
|
||||
# the word is at the beginning of the line
|
||||
my $prefix = '';
|
||||
|
||||
# ignore leading non-alphanumeric characters: -[\]^_`{|}
|
||||
# Assuming you have the following nicks in a channel:
|
||||
# [SomeNick] _SomeNick_ `SomeNick SomeNick SomeOtherNick
|
||||
# when $ignore_leading_non_alnum is set to 0
|
||||
# s<tab> will cycle through SomeNick and SomeOtherNick
|
||||
# when $ignore_leading_non_alnum is set to 1
|
||||
# s<tab> will cycle through [SomeNick] _SomeNick_ `SomeNick SomeNick
|
||||
# SomeOtherNick
|
||||
my $ignore_leading_non_alnum = 0;
|
||||
|
||||
# enable path completion
|
||||
my $path_completion = 1;
|
||||
my $base_path = '';
|
||||
|
||||
Xchat::register(
|
||||
"Tab Completion", "1.0401", "Alternative tab completion behavior"
|
||||
);
|
||||
Xchat::hook_print( "Key Press", \&complete );
|
||||
Xchat::hook_print( "Close Context", \&close_context );
|
||||
Xchat::hook_print( "Focus Tab", \&focus_tab );
|
||||
Xchat::hook_print( "Part", \&clean_selected );
|
||||
Xchat::hook_print( "Part with Reason", \&clean_selected );
|
||||
Xchat::hook_command( "", \&track_selected );
|
||||
|
||||
sub SHIFT() { 1 }
|
||||
sub CTRL() { 4 }
|
||||
sub ALT() { 8 }
|
||||
|
||||
sub TAB() { 0xFF09 }
|
||||
sub LEFT_TAB() { 0xFE20 }
|
||||
|
||||
my %completions;
|
||||
my %last_visit;
|
||||
my %selected;
|
||||
my %escape_map = (
|
||||
'[' => qr![\[{]!,
|
||||
'{' => qr![\[{]!,
|
||||
'}' => qr![\]}]!,
|
||||
']' => qr![\]}]!,
|
||||
'\\' => qr![\\\|]!,
|
||||
'|' => qr![\\\|]!,
|
||||
'.' => qr!\.!,
|
||||
'^' => qr!\^!,
|
||||
'$' => qr!\$!,
|
||||
'*' => qr!\*!,
|
||||
'+' => qr!\+!,
|
||||
'?' => qr!\?!,
|
||||
'(' => qr!\(!,
|
||||
')' => qr!\)!,
|
||||
'-' => qr!\-!,
|
||||
);
|
||||
|
||||
my $escapes = join "", keys %escape_map;
|
||||
$escapes = qr/[\Q$escapes\E]/;
|
||||
|
||||
# used to determine if a word is the start of a path
|
||||
my $path_pattern = qr{^(?:~|/|[[:alpha:]]:\\)};
|
||||
|
||||
sub complete {
|
||||
my ($key, $modifiers) = @{$_[0]};
|
||||
# if $_[0][0] contains the value of the key pressed
|
||||
# $_[0][1] contains modifiers
|
||||
# the value for tab is 0xFF09
|
||||
# the value for shift-tab(Left Tab) is 0xFE20
|
||||
# we don't care about other keys
|
||||
|
||||
# the key must be a tab and left tab
|
||||
return Xchat::EAT_NONE unless $key == TAB || $key == LEFT_TAB;
|
||||
|
||||
# if it is a tab then it must not have any modifiers
|
||||
return Xchat::EAT_NONE if $key == TAB && $modifiers & (CTRL|ALT|SHIFT);
|
||||
|
||||
# loop backwards for shift+tab/left tab
|
||||
my $delta = $modifiers & SHIFT ? -1 : 1;
|
||||
my $context = Xchat::get_context;
|
||||
$completions{$context} ||= {};
|
||||
|
||||
my $completions = $completions{$context};
|
||||
$completions->{pos} ||= -1;
|
||||
|
||||
my $suffix = Xchat::get_prefs( "completion_suffix" );
|
||||
$suffix =~ s/^\s+//;
|
||||
|
||||
my $input = Xchat::get_info( "inputbox" );
|
||||
my $cursor_pos = Xchat::get_info( "state_cursor" );
|
||||
my $left = substr( $input, 0, $cursor_pos );
|
||||
my $right = substr( $input, $cursor_pos );
|
||||
my $length = length $left;
|
||||
|
||||
# trim spaces from the end of $left to avoid grabbing the wrong word
|
||||
# this is mainly needed for completion at the very beginning where a space
|
||||
# is added after the completion
|
||||
$left =~ s/\s+$//;
|
||||
|
||||
# always add one to the index because
|
||||
# 1) if a space is found we want the position after it
|
||||
# 2) if a space isn't found then we get back -1
|
||||
my $word_start = rindex( $left, " " ) + 1;
|
||||
my $word = substr( $left, $word_start );
|
||||
$left = substr( $left, 0, -length $word );
|
||||
|
||||
if( $cursor_pos == $completions->{pos} ) {
|
||||
my $previous_word = $completions->{completed};
|
||||
my $new_left = $input;
|
||||
substr( $new_left, $cursor_pos ) = "";
|
||||
|
||||
if( $previous_word and $new_left =~ s/(\Q$previous_word\E)$// ) {
|
||||
$word = $1;
|
||||
$word_start = length( $new_left );
|
||||
$left = $new_left;
|
||||
}
|
||||
}
|
||||
|
||||
my $command_char = Xchat::get_prefs( "input_command_char" );
|
||||
# ignore commands
|
||||
if( ($word !~ m{^[${command_char}]})
|
||||
or ( $word =~ m{^[${command_char}]} and $word_start != 0 ) ) {
|
||||
|
||||
if( $cursor_pos == length $input # end of input box
|
||||
# not a valid nick char
|
||||
&& $input =~ /(?<![\x41-\x5A\x61-\x7A\x30-\x39\x5B-\x60\x7B-\x7D-])$/
|
||||
&& $cursor_pos != $completions->{pos} # not continuing a completion
|
||||
&& $word !~ m{^(?:[&#/~]|[[:alpha:]]:\\)} # not a channel or path
|
||||
) {
|
||||
# check for path completion
|
||||
unless( $path_completion and $word =~ $path_pattern ) {
|
||||
$word_start = $cursor_pos;
|
||||
$left = $input;
|
||||
$length = length $length;
|
||||
$right = "";
|
||||
$word = "";
|
||||
}
|
||||
}
|
||||
|
||||
if( $word_start == 0 && $prefix && $word =~ /^\Q$prefix/ ) {
|
||||
$word =~ s/^\Q$prefix//;
|
||||
}
|
||||
|
||||
my $completed; # this is going to be the "completed" word
|
||||
|
||||
# for parital completions and channel names so a : isn't added
|
||||
#$completions->{skip_suffix} = ($word =~ /^[&#]/) ? 1 : 0;
|
||||
|
||||
# continuing from a previous completion
|
||||
if(
|
||||
exists $completions->{matches} && @{$completions->{matches}}
|
||||
&& $cursor_pos == $completions->{pos}
|
||||
&& $word =~ /^\Q$completions->{matches}[$completions->{index}]/
|
||||
) {
|
||||
$completions->{index} += $delta;
|
||||
|
||||
if( $completions->{index} < 0 ) {
|
||||
$completions->{index} += @{$completions->{matches}};
|
||||
} else {
|
||||
$completions->{index} %= @{$completions->{matches}};
|
||||
}
|
||||
|
||||
} else {
|
||||
|
||||
if( $word =~ /^[&#]/ ) {
|
||||
# channel name completion
|
||||
$completions->{matches} = [ matching_channels( $word ) ];
|
||||
$completions->{skip_suffix} = 0;
|
||||
} elsif( $path_completion and $word =~ $path_pattern ) {
|
||||
# file name completion
|
||||
$completions->{matches} = [ matching_files( $word ) ];
|
||||
$completions->{skip_suffix} = 1;
|
||||
} else {
|
||||
# nick completion
|
||||
# fix $word so { equals [, ] equals }, \ equals |
|
||||
# and escape regex metacharacters
|
||||
$word =~ s/($escapes)/$escape_map{$1}/g;
|
||||
|
||||
$completions->{matches} = [ matching_nicks( $word ) ];
|
||||
$completions->{skip_suffix} = 0;
|
||||
}
|
||||
$completions->{index} = 0;
|
||||
|
||||
}
|
||||
$completed = $completions->{matches}[ $completions->{index} ];
|
||||
$completions->{completed} = $completed;
|
||||
|
||||
my $completion_amount = Xchat::get_prefs( "completion_amount" );
|
||||
|
||||
# don't cycle if the number of possible completions is greater than
|
||||
# completion_amount
|
||||
if(
|
||||
@{$completions->{matches}} > $completion_amount
|
||||
&& @{$completions->{matches}} != 1
|
||||
) {
|
||||
# don't print if we tabbed in the beginning and the list of possible
|
||||
# completions includes all nicks in the channel
|
||||
my $context_type = Xchat::context_info->{type};
|
||||
if( $context_type != 2 # not a channel
|
||||
or @{$completions->{matches}} < Xchat::get_list("users")
|
||||
) {
|
||||
Xchat::print( join " ", @{$completions->{matches}}, "\n" );
|
||||
}
|
||||
|
||||
$completed = lcs( $completions->{matches} );
|
||||
$completions->{skip_suffix} = 1;
|
||||
}
|
||||
|
||||
if( $completed ) {
|
||||
|
||||
if( $word_start == 0 && !$completions->{skip_suffix} ) {
|
||||
# at the start of the line append completion suffix
|
||||
Xchat::command( "settext $prefix$completed$suffix$right");
|
||||
$completions->{pos} = length( "$prefix$completed$suffix" );
|
||||
} else {
|
||||
Xchat::command( "settext $left$completed$right" );
|
||||
$completions->{pos} = length( "$left$completed" );
|
||||
}
|
||||
|
||||
Xchat::command( "setcursor $completions->{pos}" );
|
||||
}
|
||||
|
||||
=begin
|
||||
# debugging stuff
|
||||
local $, = " ";
|
||||
my $input_length = length $input;
|
||||
Xchat::print [
|
||||
qq{input[$input]},
|
||||
qq{input_length[$input_length]},
|
||||
qq{cursor[$cursor_pos]},
|
||||
qq{start[$word_start]},
|
||||
qq{length[$length]},
|
||||
qq{left[$left]},
|
||||
qq{word[$word]}, qq{right[$right]},
|
||||
qq{completed[}. ($completed||""). qq{]},
|
||||
qq{pos[$completions->{pos}]},
|
||||
];
|
||||
use Data::Dumper;
|
||||
local $Data::Dumper::Indent = 0;
|
||||
Xchat::print Dumper $completions->{matches};
|
||||
=cut
|
||||
|
||||
return Xchat::EAT_ALL;
|
||||
} else {
|
||||
return Xchat::EAT_NONE;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# all channels starting with $word
|
||||
sub matching_channels {
|
||||
my $word = shift;
|
||||
|
||||
# for use in compare_channels();
|
||||
our $current_chan;
|
||||
local $current_chan = Xchat::get_info( "channel" );
|
||||
|
||||
my $conn_id = Xchat::get_info( "id" );
|
||||
$word =~ s/^[&#]+//;
|
||||
|
||||
return
|
||||
map { $_->[1]->{channel} }
|
||||
sort compare_channels map {
|
||||
my $chan = $_->{channel};
|
||||
$chan =~ s/^[#&]+//;
|
||||
|
||||
# comparisons will be done based only on the name
|
||||
# matching name, same connection, only channels
|
||||
$chan =~ /^$word/i && $_->{id} == $conn_id ?
|
||||
[ $chan, $_ ] :
|
||||
()
|
||||
} channels();
|
||||
}
|
||||
|
||||
sub channels {
|
||||
return grep { $_->{type} == 2 } Xchat::get_list( "channels" );
|
||||
}
|
||||
|
||||
sub compare_channels {
|
||||
# package variable, value set in matching_channels()
|
||||
our $current_chan;
|
||||
|
||||
# turn off warnings generated from channels that have not yet been visited
|
||||
# since the script was loaded
|
||||
no warnings "uninitialized";
|
||||
|
||||
# the current channel is always first, then ordered by most recently visited
|
||||
return
|
||||
$a->[1]{channel} eq $current_chan ? -1 :
|
||||
$b->[1]{channel} eq $current_chan ? 1 :
|
||||
$last_visit{ $b->[1]{context} } <=> $last_visit{ $a->[1]{context} }
|
||||
|| $a->[1]{channel} cmp $b->[1]{channel};
|
||||
|
||||
}
|
||||
|
||||
sub matching_nicks {
|
||||
my $word_re = shift;
|
||||
|
||||
# for use in compare_nicks()
|
||||
our ($my_nick, $selections, $now);
|
||||
local $my_nick = Xchat::get_info( "nick" );
|
||||
local $selections = $selected{ Xchat::get_context() };
|
||||
local $now = time;
|
||||
|
||||
my $pattern = $ignore_leading_non_alnum ?
|
||||
qr/^[\-\[\]^_`{|}\\]*$word_re/i : qr/^$word_re/i;
|
||||
return
|
||||
map { $_->{nick} }
|
||||
sort compare_nicks grep {
|
||||
$_->{nick} =~ $pattern;
|
||||
} Xchat::get_list( "users" )
|
||||
|
||||
}
|
||||
|
||||
sub max {
|
||||
return unless @_;
|
||||
my $max = shift;
|
||||
for(@_) {
|
||||
$max = $_ if $_ > $max;
|
||||
}
|
||||
return $max;
|
||||
}
|
||||
|
||||
sub compare_times {
|
||||
# package variables set in matching_nicks()
|
||||
our $selections;
|
||||
our $now;
|
||||
|
||||
for my $nick ( $a->{nick}, $b->{nick} ) {
|
||||
# turn off the warnings that get generated from users who have yet
|
||||
# to speak since the script was loaded
|
||||
no warnings "uninitialized";
|
||||
|
||||
if( $last_use_threshold
|
||||
&& (( $now - $selections->{$nick}) > ($last_use_threshold * 60)) ) {
|
||||
delete $selections->{ $nick }
|
||||
}
|
||||
}
|
||||
my $a_time = $selections->{ $a->{nick} } || 0 ;
|
||||
my $b_time = $selections->{ $b->{nick} } || 0 ;
|
||||
|
||||
if( $a_time || $b_time ) {
|
||||
return $b_time <=> $a_time;
|
||||
} elsif( !$a_time && !$b_time ) {
|
||||
return $b->{lasttalk} <=> $a->{lasttalk};
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub compare_nicks {
|
||||
# more package variables, value set in matching_nicks()
|
||||
our $my_nick;
|
||||
|
||||
# our own nick is always last, then ordered by the people we spoke to most
|
||||
# recently and the people who were speaking most recently
|
||||
return
|
||||
$a->{nick} eq $my_nick ? 1 :
|
||||
$b->{nick} eq $my_nick ? -1 :
|
||||
compare_times()
|
||||
|| Xchat::nickcmp( $a->{nick}, $b->{nick} );
|
||||
|
||||
# $selections->{ $b->{nick} } <=> $selections->{ $a->{nick} }
|
||||
# || $b->{lasttalk} <=> $a->{lasttalk}
|
||||
|
||||
}
|
||||
|
||||
sub matching_files {
|
||||
my $word = shift;
|
||||
|
||||
my ($file, $input_dir) = fileparse( $word );
|
||||
|
||||
my $dir = expand_tilde( $input_dir );
|
||||
|
||||
if( opendir my $dir_handle, $dir ) {
|
||||
my @files;
|
||||
|
||||
if( $file ) {
|
||||
@files = grep {
|
||||
#Xchat::print( $_ );
|
||||
/^\Q$file/ } readdir $dir_handle;
|
||||
} else {
|
||||
@files = readdir $dir_handle;
|
||||
}
|
||||
|
||||
return map {
|
||||
File::Spec->catfile( $input_dir, $_ );
|
||||
} sort
|
||||
grep { !/^[.]{1,2}$/ } @files;
|
||||
} else {
|
||||
return ();
|
||||
}
|
||||
}
|
||||
|
||||
# Remove completion related data for tabs that are closed
|
||||
sub close_context {
|
||||
my $context = Xchat::get_context;
|
||||
delete $completions{$context};
|
||||
delete $last_visit{$context};
|
||||
return Xchat::EAT_NONE;
|
||||
}
|
||||
|
||||
# track visit times
|
||||
sub focus_tab {
|
||||
$last_visit{Xchat::get_context()} = time();
|
||||
return Xchat::EAT_NONE;
|
||||
}
|
||||
|
||||
# keep track of the last time a message was addressed to someone
|
||||
# a message is considered addressed to someone if their nick is used followed
|
||||
# by the completion suffix
|
||||
sub track_selected {
|
||||
my $input = $_[1][0];
|
||||
return Xchat::EAT_NONE unless defined $input;
|
||||
|
||||
my $suffix = Xchat::get_prefs( "completion_suffix" );
|
||||
for( grep defined, $input =~ /^(.+)\Q$suffix/, $_[0][0] ) {
|
||||
if( in_channel( $_ ) ) {
|
||||
$selected{Xchat::get_context()}{$_} = time();
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
return Xchat::EAT_NONE;
|
||||
}
|
||||
|
||||
# if a user is in the current channel
|
||||
# user_info() can also be used instead of the loop
|
||||
sub in_channel {
|
||||
my $target = shift;
|
||||
for my $nick ( nicks() ) {
|
||||
if( $nick eq $target ) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# list of nicks in the current channel
|
||||
sub nicks {
|
||||
return map { $_->{nick} } Xchat::get_list( "users" );
|
||||
}
|
||||
|
||||
# remove people from the selected list when they leave the channel
|
||||
sub clean_selected {
|
||||
delete $selected{ Xchat::get_context() }{$_[0][0]};
|
||||
return Xchat::EAT_NONE;
|
||||
}
|
||||
|
||||
# Longest common substring
|
||||
# Used for partial completion when using non-cycling completion
|
||||
sub lcs {
|
||||
my @nicks = @{+shift};
|
||||
return "" if @nicks == 0;
|
||||
return $nicks[0] if @nicks == 1;
|
||||
|
||||
my $substring = shift @nicks;
|
||||
|
||||
while(@nicks) {
|
||||
$substring = common_string( $substring, shift @nicks );
|
||||
}
|
||||
|
||||
return $substring;
|
||||
}
|
||||
|
||||
sub common_string {
|
||||
my ($nick1, $nick2) = @_;
|
||||
my $index = 0;
|
||||
|
||||
$index++ while(
|
||||
($index < length $nick1) && ($index < length $nick2) &&
|
||||
lc(substr( $nick1, $index, 1 )) eq lc(substr( $nick2, $index, 1 ))
|
||||
);
|
||||
|
||||
|
||||
return substr( $nick1, 0, $index );
|
||||
}
|
||||
|
||||
sub expand_tilde {
|
||||
my $file = shift;
|
||||
|
||||
$file =~ s/^~/home_dir()/e;
|
||||
return $file;
|
||||
}
|
||||
|
||||
sub home_dir {
|
||||
return $base_path if $base_path;
|
||||
|
||||
if ( $^O eq "MSWin32" ) {
|
||||
return $ENV{USERPROFILE};
|
||||
} else {
|
||||
return ((getpwuid($>))[7] || $ENV{HOME} || $ENV{LOGDIR});
|
||||
}
|
||||
}
|
||||
101
plugins/perl/char_count.pl
Normal file
101
plugins/perl/char_count.pl
Normal file
@ -0,0 +1,101 @@
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Xchat qw(:all);
|
||||
use Glib qw(TRUE FALSE);
|
||||
use Gtk2 -init;
|
||||
|
||||
sub get_inputbox {
|
||||
my $widget = Glib::Object->new_from_pointer( get_info( "win_ptr" ), 0 );
|
||||
my $input_box;
|
||||
|
||||
my @containers = ($widget);
|
||||
|
||||
while( @containers ) {
|
||||
my $container = shift @containers;
|
||||
|
||||
for my $child ( $container->get_children ) {
|
||||
if( $child->get( "name" ) eq 'xchat-inputbox' ) {
|
||||
$input_box = $child;
|
||||
last;
|
||||
} elsif( $child->isa( "Gtk2::Container" ) ) {
|
||||
push @containers, $child;
|
||||
}
|
||||
}
|
||||
}
|
||||
return $input_box;
|
||||
}
|
||||
|
||||
sub get_hbox {
|
||||
my $widget = shift;
|
||||
my $hbox;
|
||||
|
||||
while( $widget->parent ) {
|
||||
if( $widget->parent->isa( "Gtk2::HBox" ) ) {
|
||||
return $widget->parent;
|
||||
}
|
||||
$widget = $widget->parent;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
my $input_box = get_inputbox();
|
||||
|
||||
if( $input_box ) {
|
||||
my $hbox = get_hbox( $input_box );
|
||||
if( $hbox ) {
|
||||
my $label = Gtk2::Label->new();
|
||||
$label->set_alignment( 0.5, ($label->get_alignment)[1] );
|
||||
$hbox->pack_end( $label, 0, 0, 5 );
|
||||
$label->show();
|
||||
|
||||
my $update_label = sub {
|
||||
my $ctx_type = context_info->{"type"};
|
||||
hook_timer( 0, sub {
|
||||
if( $ctx_type == 2 || $ctx_type == 3 ) {
|
||||
my $count = length get_info "inputbox";
|
||||
$label->set_text( $count ? $count : "" );
|
||||
} else {
|
||||
$label->set_text( "" );
|
||||
}
|
||||
return REMOVE;
|
||||
});
|
||||
return EAT_NONE;
|
||||
};
|
||||
|
||||
hook_print( "Key Press", $update_label );
|
||||
hook_print( "Focus Tab", $update_label );
|
||||
hook_print( "Focus Window", $update_label );
|
||||
hook_command( "",
|
||||
sub {
|
||||
$label->set_text( "" );
|
||||
return EAT_NONE;
|
||||
}
|
||||
);
|
||||
|
||||
my @handlers;
|
||||
my $buffer = $input_box->get_buffer;
|
||||
my $handler = sub { $update_label->(); return TRUE };
|
||||
|
||||
if( $buffer->isa( "Gtk2::TextBuffer" ) ) {
|
||||
push @handlers, $buffer->signal_connect( "changed", $handler );
|
||||
} elsif( $buffer->isa( "Gtk2::EntryBuffer" ) ) {
|
||||
push @handlers,
|
||||
$buffer->signal_connect( "deleted-text", $handler );
|
||||
$buffer->signal_connect( "inserted-text", $handler );
|
||||
}
|
||||
|
||||
register( "Character Counter", "1.0.0",
|
||||
"Display the number of characters in the inputbox",
|
||||
sub {
|
||||
$hbox->remove( $label );
|
||||
$buffer->signal_handler_disconnect( $_ ) for @handlers;
|
||||
}
|
||||
);
|
||||
} else {
|
||||
prnt "Counldn't find hbox";
|
||||
}
|
||||
|
||||
} else {
|
||||
prnt "Couldn't fint input box";
|
||||
}
|
||||
50
plugins/perl/generate_header
Normal file
50
plugins/perl/generate_header
Normal file
@ -0,0 +1,50 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub header {
|
||||
my $file = shift;
|
||||
open my $input, "<", $file or die "Couldn't open '$file':$!";
|
||||
my @file = <$input>;
|
||||
close $file;
|
||||
return toc(@file);
|
||||
}
|
||||
|
||||
sub toc {
|
||||
my @lines = @_;
|
||||
for( @lines ) {
|
||||
if( /^\s*$/s ) { $_ = qq{"\\n"\n}; next; }
|
||||
if( /^\s*#/ ) { $_ = qq{"\\n"\n}; next; }
|
||||
s/\\/\\\\/g; # double the number of \'s
|
||||
s/"/\\"/g;
|
||||
s/^\s*/"/;
|
||||
s/\n/\\n"\n/;
|
||||
}
|
||||
return @lines;
|
||||
}
|
||||
|
||||
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",
|
||||
],
|
||||
[ "irc.pm.h", # output file
|
||||
"lib/IRC.pm" # input file
|
||||
]
|
||||
) {
|
||||
my ($output,@inputs) = @$files;
|
||||
|
||||
open my $header, ">", $output or die "Couldn't open '$output': $!";
|
||||
|
||||
for my $input ( @inputs ) {
|
||||
print $header qq["{\\n"\n];
|
||||
print $header qq{"#line 1 \\"$input\\"\\n"\n};
|
||||
print $header header( $input );
|
||||
print $header qq["}\\n"\n];
|
||||
}
|
||||
close $header;
|
||||
}
|
||||
27
plugins/perl/generate_html
Normal file
27
plugins/perl/generate_html
Normal file
@ -0,0 +1,27 @@
|
||||
#!/usr/bin/env perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use File::Basename qw(dirname);
|
||||
|
||||
sub __DIR__ {
|
||||
return dirname +(caller 0)[1];
|
||||
}
|
||||
|
||||
# this must go before use Pod::Html to use our private copy
|
||||
use lib __DIR__ . '/lib';
|
||||
use Pod::Html;
|
||||
|
||||
chdir( __DIR__ ) or die $!;
|
||||
pod2html(
|
||||
# "pod2html",
|
||||
"--header",
|
||||
"--infile=lib/Xchat.pod",
|
||||
"--outfile=xchat2-perl.html",
|
||||
);
|
||||
|
||||
#system( qw(tidy -m -i -xml -utf8 -quiet xchat2-perl.html) );
|
||||
unlink( "pod2htmd.tmp" );
|
||||
unlink( "pod2htmi.tmp" );
|
||||
|
||||
exec( "./syntax_highlight", "xchat2-perl.html" )
|
||||
or die $!;
|
||||
257
plugins/perl/lib/IRC.pm
Normal file
257
plugins/perl/lib/IRC.pm
Normal file
@ -0,0 +1,257 @@
|
||||
|
||||
package IRC;
|
||||
sub IRC::register {
|
||||
my ($script_name, $version, $callback) = @_;
|
||||
my $package = caller;
|
||||
$callback = Xchat::Embed::fix_callback( $package, $callback) if $callback;
|
||||
Xchat::register( $script_name, $version, undef, $callback );
|
||||
}
|
||||
|
||||
|
||||
sub IRC::add_command_handler {
|
||||
my ($command, $callback) = @_;
|
||||
my $package = caller;
|
||||
|
||||
$callback = Xchat::Embed::fix_callback( $package, $callback );
|
||||
|
||||
# starting index for word_eol array
|
||||
# this is for compatibility with '' as the command
|
||||
my $start_index = $command ? 1 : 0;
|
||||
|
||||
Xchat::hook_command( $command,
|
||||
sub {
|
||||
no strict 'refs';
|
||||
return &{$callback}($_[1][$start_index]);
|
||||
}
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
sub IRC::add_message_handler {
|
||||
my ($message, $callback) = @_;
|
||||
my $package = caller;
|
||||
$callback = Xchat::Embed::fix_callback( $package, $callback );
|
||||
|
||||
Xchat::hook_server( $message,
|
||||
sub {
|
||||
no strict 'refs';
|
||||
return &{$callback}( $_[1][0] );
|
||||
}
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
sub IRC::add_print_handler {
|
||||
my ($event, $callback) = @_;
|
||||
my $package = caller;
|
||||
$callback = Xchat::Embed::fix_callback( $package, $callback );
|
||||
Xchat::hook_print( $event,
|
||||
sub {
|
||||
my @word = @{$_[0]};
|
||||
no strict 'refs';
|
||||
return &{$callback}( join( ' ', @word[0..3] ), @word );
|
||||
}
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
sub IRC::add_timeout_handler {
|
||||
my ($timeout, $callback) = @_;
|
||||
my $package = caller;
|
||||
$callback = Xchat::Embed::fix_callback( $package, $callback );
|
||||
Xchat::hook_timer( $timeout,
|
||||
sub {
|
||||
no strict 'refs';
|
||||
&{$callback};
|
||||
return 0;
|
||||
}
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
sub IRC::command {
|
||||
my $command = shift;
|
||||
if( $command =~ m{^/} ) {
|
||||
$command =~ s{^/}{};
|
||||
Xchat::command( $command );
|
||||
} else {
|
||||
Xchat::command( qq[say $command] );
|
||||
}
|
||||
}
|
||||
|
||||
sub IRC::command_with_channel {
|
||||
my ($command, $channel, $server) = @_;
|
||||
my $old_ctx = Xchat::get_context;
|
||||
my $ctx = Xchat::find_context( $channel, $server );
|
||||
|
||||
if( $ctx ) {
|
||||
Xchat::set_context( $ctx );
|
||||
IRC::command( $command );
|
||||
Xchat::set_context( $ctx );
|
||||
}
|
||||
}
|
||||
|
||||
sub IRC::command_with_server {
|
||||
my ($command, $server) = @_;
|
||||
my $old_ctx = Xchat::get_context;
|
||||
my $ctx = Xchat::find_context( undef, $server );
|
||||
|
||||
if( $ctx ) {
|
||||
Xchat::set_context( $ctx );
|
||||
IRC::command( $command );
|
||||
Xchat::set_context( $ctx );
|
||||
}
|
||||
}
|
||||
|
||||
sub IRC::dcc_list {
|
||||
my @dccs;
|
||||
for my $dcc ( Xchat::get_list( 'dcc' ) ) {
|
||||
push @dccs, $dcc->{nick};
|
||||
push @dccs, $dcc->{file} ? $dcc->{file} : '';
|
||||
push @dccs, @{$dcc}{qw(type status cps size)};
|
||||
push @dccs, $dcc->{type} == 0 ? $dcc->{pos} : $dcc->{resume};
|
||||
push @dccs, $dcc->{address32};
|
||||
push @dccs, $dcc->{destfile} ? $dcc->{destfile} : '';
|
||||
}
|
||||
return @dccs;
|
||||
}
|
||||
|
||||
sub IRC::channel_list {
|
||||
my @channels;
|
||||
for my $channel ( Xchat::get_list( 'channels' ) ) {
|
||||
push @channels, @{$channel}{qw(channel server)},
|
||||
Xchat::context_info( $channel->{context} )->{nick};
|
||||
}
|
||||
return @channels;
|
||||
}
|
||||
|
||||
sub IRC::get_info {
|
||||
my $id = shift;
|
||||
my @ids = qw(version nick channel server xchatdir away network host topic);
|
||||
|
||||
if( $id >= 0 && $id <= 8 && $id != 5 ) {
|
||||
my $info = Xchat::get_info($ids[$id]);
|
||||
return defined $info ? $info : '';
|
||||
} else {
|
||||
if( $id == 5 ) {
|
||||
return Xchat::get_info( 'away' ) ? 1 : 0;
|
||||
} else {
|
||||
return 'Error2';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub IRC::get_prefs {
|
||||
return 'Unknown variable' unless defined $_[0];
|
||||
my $result = Xchat::get_prefs(shift);
|
||||
return defined $result ? $result : 'Unknown variable';
|
||||
}
|
||||
|
||||
sub IRC::ignore_list {
|
||||
my @ignores;
|
||||
for my $ignore ( Xchat::get_list( 'ignore' ) ) {
|
||||
push @ignores, $ignore->{mask};
|
||||
my $flags = $ignore->{flags};
|
||||
push @ignores, $flags & 1, $flags & 2, $flags & 4, $flags & 8, $flags & 16,
|
||||
$flags & 32, ':';
|
||||
}
|
||||
return @ignores;
|
||||
}
|
||||
|
||||
sub IRC::print {
|
||||
Xchat::print( $_ ) for @_;
|
||||
return;
|
||||
}
|
||||
|
||||
sub IRC::print_with_channel {
|
||||
Xchat::print( @_ );
|
||||
}
|
||||
|
||||
sub IRC::send_raw {
|
||||
Xchat::commandf( qq[quote %s], shift );
|
||||
}
|
||||
|
||||
sub IRC::server_list {
|
||||
my @servers;
|
||||
for my $channel ( Xchat::get_list( 'channels' ) ) {
|
||||
push @servers, $channel->{server} if $channel->{server};
|
||||
}
|
||||
return @servers;
|
||||
}
|
||||
|
||||
sub IRC::user_info {
|
||||
my $user;
|
||||
if( @_ > 0 ) {
|
||||
$user = Xchat::user_info( shift );
|
||||
} else {
|
||||
$user = Xchat::user_info();
|
||||
}
|
||||
|
||||
my @info;
|
||||
if( $user ) {
|
||||
push @info, $user->{nick};
|
||||
if( $user->{host} ) {
|
||||
push @info, $user->{host};
|
||||
} else {
|
||||
push @info, 'FETCHING';
|
||||
}
|
||||
push @info, $user->{prefix} eq '@' ? 1 : 0;
|
||||
push @info, $user->{prefix} eq '+' ? 1 : 0;
|
||||
}
|
||||
return @info;
|
||||
}
|
||||
|
||||
sub IRC::user_list {
|
||||
my ($channel, $server) = @_;
|
||||
my $ctx = Xchat::find_context( $channel, $server );
|
||||
my $old_ctx = Xchat::get_context;
|
||||
|
||||
if( $ctx ) {
|
||||
Xchat::set_context( $ctx );
|
||||
my @users;
|
||||
for my $user ( Xchat::get_list( 'users' ) ) {
|
||||
push @users, $user->{nick};
|
||||
if( $user->{host} ) {
|
||||
push @users, $user->{host};
|
||||
} else {
|
||||
push @users, 'FETCHING';
|
||||
}
|
||||
push @users, $user->{prefix} eq '@' ? 1 : 0;
|
||||
push @users, $user->{prefix} eq '+' ? 1 : 0;
|
||||
push @users, ':';
|
||||
}
|
||||
Xchat::set_context( $old_ctx );
|
||||
return @users;
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
sub IRC::user_list_short {
|
||||
my ($channel, $server) = @_;
|
||||
my $ctx = Xchat::find_context( $channel, $server );
|
||||
my $old_ctx = Xchat::get_context;
|
||||
|
||||
if( $ctx ) {
|
||||
Xchat::set_context( $ctx );
|
||||
my @users;
|
||||
for my $user ( Xchat::get_list( 'users' ) ) {
|
||||
my $nick = $user->{nick};
|
||||
my $host = $user->{host} || 'FETCHING';
|
||||
push @users, $nick, $host;
|
||||
}
|
||||
Xchat::set_context( $old_ctx );
|
||||
return @users;
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub IRC::add_user_list {}
|
||||
sub IRC::sub_user_list {}
|
||||
sub IRC::clear_user_list {}
|
||||
sub IRC::notify_list {}
|
||||
sub IRC::perl_script_list {}
|
||||
|
||||
1
|
||||
2399
plugins/perl/lib/Pod/Html.pm
Normal file
2399
plugins/perl/lib/Pod/Html.pm
Normal file
File diff suppressed because it is too large
Load Diff
506
plugins/perl/lib/Xchat.pm
Normal file
506
plugins/perl/lib/Xchat.pm
Normal file
@ -0,0 +1,506 @@
|
||||
BEGIN {
|
||||
$INC{'Xchat.pm'} = 'DUMMY';
|
||||
}
|
||||
|
||||
$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 = 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;
|
||||
$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 = Xchat::Embed::find_pkg();
|
||||
|
||||
$callback = Xchat::Embed::fix_callback( $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
|
||||
);
|
||||
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 = Xchat::Embed::find_pkg();
|
||||
|
||||
$callback = Xchat::Embed::fix_callback( $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
|
||||
);
|
||||
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 = Xchat::Embed::find_pkg();
|
||||
|
||||
$callback = Xchat::Embed::fix_callback( $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 $last_arg = @args - 1;
|
||||
|
||||
my @new = $cb->( \@args, $_[1], $event );
|
||||
|
||||
# a filter can either return the new results or it can modify
|
||||
# @_ in place.
|
||||
if( @new ) {
|
||||
emit_print( $event, @new[ 0 .. $last_arg ] );
|
||||
return EAT_ALL;
|
||||
} elsif(
|
||||
join( "\0", @{$_[0]} ) ne join( "\0", @args[ 0 .. $last_arg ] )
|
||||
) {
|
||||
emit_print( $event, @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
|
||||
);
|
||||
push @{$pkg_info->{hooks}}, $hook if defined $hook;
|
||||
return $hook;
|
||||
}
|
||||
|
||||
sub hook_timer {
|
||||
return undef unless @_ >= 2;
|
||||
my ($timeout, $callback, $data) = @_;
|
||||
my $package = Xchat::Embed::find_pkg();
|
||||
|
||||
$callback = Xchat::Embed::fix_callback( $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) = Xchat::Embed::find_pkg();
|
||||
$callback = Xchat::Embed::fix_callback( $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,
|
||||
}
|
||||
);
|
||||
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(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
|
||||
1326
plugins/perl/lib/Xchat.pod
Normal file
1326
plugins/perl/lib/Xchat.pod
Normal file
File diff suppressed because it is too large
Load Diff
253
plugins/perl/lib/Xchat/Embed.pm
Normal file
253
plugins/perl/lib/Xchat/Embed.pm
Normal file
@ -0,0 +1,253 @@
|
||||
package Xchat::Embed;
|
||||
use strict;
|
||||
use warnings;
|
||||
# list of loaded scripts keyed by their package names
|
||||
our %scripts;
|
||||
|
||||
sub load {
|
||||
my $file = expand_homedir( shift @_ );
|
||||
my $package = file2pkg( $file );
|
||||
|
||||
if( exists $scripts{$package} ) {
|
||||
my $pkg_info = pkg_info( $package );
|
||||
my $filename = File::Basename::basename( $pkg_info->{filename} );
|
||||
Xchat::printf(
|
||||
qq{'%s' already loaded from '%s'.\n},
|
||||
$filename, $pkg_info->{filename}
|
||||
);
|
||||
Xchat::print(
|
||||
'If this is a different script then it rename and try '.
|
||||
'loading it again.'
|
||||
);
|
||||
return 2;
|
||||
}
|
||||
|
||||
if( open my $source_handle, $file ) {
|
||||
my $source = do {local $/; <$source_handle>};
|
||||
close $source_handle;
|
||||
# we shouldn't care about things after __END__
|
||||
$source =~ s/^__END__.*//ms;
|
||||
|
||||
if(
|
||||
my @replacements = $source =~
|
||||
m/^\s*package ((?:[^\W:]+(?:::)?)+)\s*?;/mg
|
||||
) {
|
||||
|
||||
if ( @replacements > 1 ) {
|
||||
Xchat::print(
|
||||
"Too many package defintions, only 1 is allowed\n"
|
||||
);
|
||||
return 1;
|
||||
}
|
||||
|
||||
my $original_package = shift @replacements;
|
||||
|
||||
# remove original package declaration
|
||||
$source =~ s/^(package $original_package\s*;)/#$1/m;
|
||||
|
||||
# fixes things up for code calling subs with fully qualified names
|
||||
$source =~ s/${original_package}:://g;
|
||||
}
|
||||
|
||||
# this must come before the eval or the filename will not be found in
|
||||
# Xchat::register
|
||||
$scripts{$package}{filename} = $file;
|
||||
$scripts{$package}{loaded_at} = Time::HiRes::time();
|
||||
|
||||
my $full_path = File::Spec->rel2abs( $file );
|
||||
$source =~ s/^/#line 1 "$full_path"\n\x7Bpackage $package;/;
|
||||
|
||||
# make sure we add the closing } even if the last line is a comment
|
||||
if( $source =~ /^#.*\Z/m ) {
|
||||
$source =~ s/^(?=#.*\Z)/\x7D/m;
|
||||
} else {
|
||||
$source =~ s/\Z/\x7D/;
|
||||
}
|
||||
|
||||
_do_eval( $source );
|
||||
|
||||
unless( exists $scripts{$package}{gui_entry} ) {
|
||||
$scripts{$package}{gui_entry} =
|
||||
Xchat::Internal::register(
|
||||
"", "unknown", "", $file
|
||||
);
|
||||
}
|
||||
|
||||
if( $@ ) {
|
||||
# something went wrong
|
||||
$@ =~ s/\(eval \d+\)/$file/g;
|
||||
Xchat::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" );
|
||||
return 2;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub _do_eval {
|
||||
no strict;
|
||||
no warnings;
|
||||
eval $_[0];
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $file = shift @_;
|
||||
my $package = file2pkg( $file );
|
||||
my $pkg_info = pkg_info( $package );
|
||||
|
||||
if( $pkg_info ) {
|
||||
# take care of the shutdown callback
|
||||
if( exists $pkg_info->{shutdown} ) {
|
||||
# allow incorrectly written scripts to be unloaded
|
||||
eval {
|
||||
if( ref $pkg_info->{shutdown} eq 'CODE' ) {
|
||||
$pkg_info->{shutdown}->();
|
||||
} elsif ( $pkg_info->{shutdown} ) {
|
||||
no strict 'refs';
|
||||
&{$pkg_info->{shutdown}};
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
if( exists $pkg_info->{hooks} ) {
|
||||
for my $hook ( @{$pkg_info->{hooks}} ) {
|
||||
Xchat::unhook( $hook, $package );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if( exists $pkg_info->{gui_entry} ) {
|
||||
plugingui_remove( $pkg_info->{gui_entry} );
|
||||
}
|
||||
|
||||
Symbol::delete_package( $package );
|
||||
delete $scripts{$package};
|
||||
return Xchat::EAT_ALL;
|
||||
} else {
|
||||
Xchat::print( qq{"$file" is not loaded.\n} );
|
||||
return Xchat::EAT_NONE;
|
||||
}
|
||||
}
|
||||
|
||||
sub unload_all {
|
||||
for my $package ( keys %scripts ) {
|
||||
unload( $scripts{$package}->{filename} );
|
||||
}
|
||||
|
||||
return Xchat::EAT_ALL;
|
||||
}
|
||||
|
||||
sub reload {
|
||||
my $file = shift @_;
|
||||
my $package = file2pkg( $file );
|
||||
my $pkg_info = pkg_info( $package );
|
||||
my $fullpath = $file;
|
||||
|
||||
if( $pkg_info ) {
|
||||
$fullpath = $pkg_info->{filename};
|
||||
unload( $file );
|
||||
}
|
||||
|
||||
load( $fullpath );
|
||||
return Xchat::EAT_ALL;
|
||||
}
|
||||
|
||||
sub reload_all {
|
||||
my @dirs = Xchat::get_info( "xchatdirfs" ) || Xchat::get_info( "xchatdir" );
|
||||
push @dirs, File::Spec->catdir( $dirs[0], "plugins" );
|
||||
for my $dir ( @dirs ) {
|
||||
my $auto_load_glob = File::Spec->catfile( $dir, "*.pl" );
|
||||
my @scripts = map { $_->{filename} }
|
||||
sort { $a->{loaded_at} <=> $b->{loaded_at} } values %scripts;
|
||||
push @scripts, File::Glob::bsd_glob( $auto_load_glob );
|
||||
|
||||
my %seen;
|
||||
@scripts = grep { !$seen{ $_ }++ } @scripts;
|
||||
|
||||
unload_all();
|
||||
for my $script ( @scripts ) {
|
||||
if( !pkg_info( file2pkg( $script ) ) ) {
|
||||
load( $script );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub expand_homedir {
|
||||
my $file = shift @_;
|
||||
|
||||
if ( $^O eq "MSWin32" ) {
|
||||
$file =~ s/^~/$ENV{USERPROFILE}/;
|
||||
} else {
|
||||
$file =~ s{^~}{
|
||||
(getpwuid($>))[7] || $ENV{HOME} || $ENV{LOGDIR}
|
||||
}ex;
|
||||
}
|
||||
return $file;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
sub pkg_info {
|
||||
my $package = shift @_;
|
||||
return $scripts{$package};
|
||||
}
|
||||
|
||||
sub find_external_pkg {
|
||||
my $level = 1;
|
||||
|
||||
while( my @frame = caller( $level ) ) {
|
||||
return @frame if $frame[0] !~ /^Xchat/;
|
||||
$level++;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub find_pkg {
|
||||
my $level = 1;
|
||||
|
||||
while( my ($package, $file, $line) = caller( $level ) ) {
|
||||
return $package if $package =~ /^Xchat::Script::/;
|
||||
$level++;
|
||||
}
|
||||
|
||||
my @frame = find_external_pkg();
|
||||
my $location;
|
||||
|
||||
if( $frame[0] or $frame[1] ) {
|
||||
$location = $frame[1] ? $frame[1] : "package $frame[0]";
|
||||
$location .= " line $frame[2]";
|
||||
} else {
|
||||
$location = "unknown location";
|
||||
}
|
||||
|
||||
die "Unable to determine which script this hook belongs to. at $location\n";
|
||||
|
||||
}
|
||||
|
||||
sub fix_callback {
|
||||
my ($package, $callback) = @_;
|
||||
|
||||
unless( ref $callback ) {
|
||||
# change the package to the correct one in case it was hardcoded
|
||||
$callback =~ s/^.*:://;
|
||||
$callback = qq[${package}::$callback];
|
||||
|
||||
no strict 'subs';
|
||||
$callback = \&{$callback};
|
||||
}
|
||||
|
||||
return $callback;
|
||||
}
|
||||
|
||||
1
|
||||
32
plugins/perl/lib/Xchat/List/Network.pm
Normal file
32
plugins/perl/lib/Xchat/List/Network.pm
Normal file
@ -0,0 +1,32 @@
|
||||
package Xchat::List::Network;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Storable qw(dclone);
|
||||
my $last_modified;
|
||||
my @servers;
|
||||
|
||||
sub get {
|
||||
my $server_file = Xchat::get_info( "xchatdirfs" ) . "/servlist_.conf";
|
||||
|
||||
# recreate the list only if the server list file has changed
|
||||
if( -f $server_file &&
|
||||
(!defined $last_modified || $last_modified != -M $server_file ) ) {
|
||||
$last_modified = -M _;
|
||||
|
||||
if( open my $fh, "<", $server_file ) {
|
||||
local $/ = "\n\n";
|
||||
while( my $record = <$fh> ) {
|
||||
chomp $record;
|
||||
next if $record =~ /^v=/; # skip the version line
|
||||
push @servers, Xchat::List::Network::Entry::parse( $record );
|
||||
}
|
||||
} else {
|
||||
warn "Unable to open '$server_file': $!";
|
||||
}
|
||||
}
|
||||
|
||||
my $clone = dclone( \@servers );
|
||||
return @$clone;
|
||||
}
|
||||
|
||||
1
|
||||
82
plugins/perl/lib/Xchat/List/Network/AutoJoin.pm
Normal file
82
plugins/perl/lib/Xchat/List/Network/AutoJoin.pm
Normal file
@ -0,0 +1,82 @@
|
||||
package Xchat::List::Network::AutoJoin;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use overload
|
||||
# '%{}' => \&as_hash,
|
||||
# '@{}' => \&as_array,
|
||||
'""' => 'as_string',
|
||||
'0+' => 'as_bool';
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $line = shift;
|
||||
|
||||
my @autojoins;
|
||||
|
||||
if ( $line ) {
|
||||
my ( $channels, $keys ) = split / /, $line, 2;
|
||||
my @channels = split /,/, $channels;
|
||||
my @keys = split /,/, ($keys || '');
|
||||
|
||||
for my $channel ( @channels ) {
|
||||
my $key = shift @keys;
|
||||
$key = '' unless defined $key;
|
||||
|
||||
push @autojoins, {
|
||||
channel => $channel,
|
||||
key => $key,
|
||||
};
|
||||
}
|
||||
}
|
||||
return bless \@autojoins, $class;
|
||||
}
|
||||
|
||||
sub channels {
|
||||
my $self = shift;
|
||||
|
||||
if( wantarray ) {
|
||||
return map { $_->{channel} } @$self;
|
||||
} else {
|
||||
return scalar @$self;
|
||||
}
|
||||
}
|
||||
|
||||
sub keys {
|
||||
my $self = shift;
|
||||
return map { $_->{key} } @$self ;
|
||||
|
||||
}
|
||||
|
||||
sub pairs {
|
||||
my $self = shift;
|
||||
|
||||
my @channels = $self->channels;
|
||||
my @keys = $self->keys;
|
||||
|
||||
my @pairs = map { $_ => shift @keys } @channels;
|
||||
}
|
||||
|
||||
sub as_hash {
|
||||
my $self = shift;
|
||||
return +{ $self->pairs };
|
||||
}
|
||||
|
||||
sub as_string {
|
||||
my $self = shift;
|
||||
return join " ",
|
||||
join( ",", $self->channels ),
|
||||
join( ",", $self->keys );
|
||||
}
|
||||
|
||||
sub as_array {
|
||||
my $self = shift;
|
||||
return [ map { \%$_ } @$self ];
|
||||
}
|
||||
|
||||
sub as_bool {
|
||||
my $self = shift;
|
||||
return $self->channels ? 1 : "";
|
||||
}
|
||||
|
||||
1
|
||||
105
plugins/perl/lib/Xchat/List/Network/Entry.pm
Normal file
105
plugins/perl/lib/Xchat/List/Network/Entry.pm
Normal file
@ -0,0 +1,105 @@
|
||||
package Xchat::List::Network::Entry;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %key_for = (
|
||||
I => "irc_nick1",
|
||||
i => "irc_nick2",
|
||||
U => "irc_user_name",
|
||||
R => "irc_real_name",
|
||||
P => "server_password",
|
||||
B => "nickserv_password",
|
||||
N => "network",
|
||||
D => "selected",
|
||||
E => "encoding",
|
||||
);
|
||||
my $letter_key_re = join "|", keys %key_for;
|
||||
|
||||
sub parse {
|
||||
my $data = shift;
|
||||
my $entry = {
|
||||
irc_nick1 => undef,
|
||||
irc_nick2 => undef,
|
||||
irc_user_name => undef,
|
||||
irc_real_name => undef,
|
||||
server_password => undef,
|
||||
|
||||
# the order of the channels need to be maintained
|
||||
# list of { channel => .., key => ... }
|
||||
autojoins => Xchat::List::Network::AutoJoin->new( '' ),
|
||||
connect_commands => [],
|
||||
flags => {},
|
||||
selected => undef,
|
||||
encoding => undef,
|
||||
servers => [],
|
||||
nickserv_password => undef,
|
||||
network => undef,
|
||||
};
|
||||
|
||||
my @fields = split /\n/, $data;
|
||||
chomp @fields;
|
||||
|
||||
for my $field ( @fields ) {
|
||||
SWITCH: for ( $field ) {
|
||||
/^($letter_key_re)=(.*)/ && do {
|
||||
$entry->{ $key_for{ $1 } } = $2;
|
||||
last SWITCH;
|
||||
};
|
||||
|
||||
/^J.(.*)/ && do {
|
||||
$entry->{ autojoins } =
|
||||
Xchat::List::Network::AutoJoin->new( $1 );
|
||||
};
|
||||
|
||||
/^F.(.*)/ && do {
|
||||
$entry->{ flags } = parse_flags( $1 );
|
||||
};
|
||||
|
||||
/^S.(.+)/ && do {
|
||||
push @{$entry->{servers}}, parse_server( $1 );
|
||||
};
|
||||
|
||||
/^C.(.+)/ && do {
|
||||
push @{$entry->{connect_commands}}, $1;
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
# $entry->{ autojoins } = $entry->{ autojoin_channels };
|
||||
return $entry;
|
||||
}
|
||||
|
||||
sub parse_flags {
|
||||
my $value = shift || 0;
|
||||
my %flags;
|
||||
|
||||
$flags{ "cycle" } = $value & 1 ? 1 : 0;
|
||||
$flags{ "use_global" } = $value & 2 ? 1 : 0;
|
||||
$flags{ "use_ssl" } = $value & 4 ? 1 : 0;
|
||||
$flags{ "autoconnect" } = $value & 8 ? 1 : 0;
|
||||
$flags{ "use_proxy" } = $value & 16 ? 1 : 0;
|
||||
$flags{ "allow_invalid" } = $value & 32 ? 1 : 0;
|
||||
|
||||
return \%flags;
|
||||
}
|
||||
|
||||
sub parse_server {
|
||||
my $data = shift;
|
||||
if( $data ) {
|
||||
my ($host, $port) = split /\//, $data;
|
||||
unless( $port ) {
|
||||
my @parts = split /:/, $host;
|
||||
|
||||
# if more than 2 then we are probably dealing with a IPv6 address
|
||||
# if less than 2 then no port was specified
|
||||
if( @parts == 2 ) {
|
||||
$port = $parts[1];
|
||||
}
|
||||
}
|
||||
|
||||
$port ||= 6667;
|
||||
return { host => $host, port => $port };
|
||||
}
|
||||
}
|
||||
|
||||
1
|
||||
1522
plugins/perl/perl.c
Normal file
1522
plugins/perl/perl.c
Normal file
File diff suppressed because it is too large
Load Diff
4
plugins/perl/perl.def
Normal file
4
plugins/perl/perl.def
Normal file
@ -0,0 +1,4 @@
|
||||
EXPORTS
|
||||
xchat_plugin_init
|
||||
xchat_plugin_deinit
|
||||
xchat_plugin_get_info
|
||||
69
plugins/perl/syntax_highlight
Normal file
69
plugins/perl/syntax_highlight
Normal file
@ -0,0 +1,69 @@
|
||||
#!/usr/bin/env perl
|
||||
use 5.010;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Text::VimColor;
|
||||
use HTML::TokeParser::Simple;
|
||||
use HTML::Entities qw(decode_entities);
|
||||
use Path::Class;
|
||||
|
||||
my $html_file = shift;
|
||||
my $reader = file( $html_file )->openr;
|
||||
unlink $html_file;
|
||||
my $writer = file( $html_file )->openw;
|
||||
|
||||
my $parser = HTML::TokeParser::Simple->new( $reader );
|
||||
|
||||
while( my $token = $parser->get_token ) {
|
||||
|
||||
my $class_name = $token->get_attr( "class" );
|
||||
|
||||
if( $token->is_start_tag( "div" )
|
||||
&& ( $class_name && $class_name =~ qr/\bexample\b/ )
|
||||
) {
|
||||
my $start_tag = $token;
|
||||
$start_tag->set_attr( class => $class_name . " synNormal" );
|
||||
my @content;
|
||||
my $end_tag;
|
||||
|
||||
EXAMPLE:
|
||||
while( $token = $parser->get_token ) {
|
||||
if( $token->is_end_tag( "div" ) ) {
|
||||
$end_tag = $token;
|
||||
last EXAMPLE;
|
||||
}
|
||||
|
||||
if( $token->is_text ) {
|
||||
push @content, decode_entities( $token->as_is );
|
||||
}
|
||||
}
|
||||
|
||||
my $code = join "", @content;
|
||||
# say $code;
|
||||
my $vim = Text::VimColor->new(
|
||||
string => $code,
|
||||
filetype => "perl",
|
||||
vim_options => [qw( -RXZ -i NONE -u NONE -N -n)],
|
||||
);
|
||||
my $html = $vim->html;
|
||||
$html =~ s/^\s+//;
|
||||
$html =~ s/\s+$//;
|
||||
|
||||
print $writer $start_tag->as_is;
|
||||
|
||||
my $lines = $html =~ tr/\n/\n/;
|
||||
|
||||
say $writer "<div class='line_number'>";
|
||||
for my $line ( 0 .. $lines ) {
|
||||
say $writer "<div>",1 + $line,"</div>";
|
||||
}
|
||||
say $writer "</div>";
|
||||
|
||||
print $writer "<div class='content'><pre>";
|
||||
say $writer $html;
|
||||
say $writer "</pre></div>";
|
||||
print $writer $end_tag->as_is;
|
||||
} else {
|
||||
print $writer $token->as_is;
|
||||
}
|
||||
}
|
||||
1166
plugins/perl/xchat2-perl.html
Normal file
1166
plugins/perl/xchat2-perl.html
Normal file
File diff suppressed because it is too large
Load Diff
475
plugins/perl/xchat2-perldocs.html
Normal file
475
plugins/perl/xchat2-perldocs.html
Normal file
@ -0,0 +1,475 @@
|
||||
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"><html><head><title>XChat - IRC (chat) client for UNIX</title>
|
||||
<style type="text/css">
|
||||
body{font-family:sans-serif;background-color:#FFFBF0;}
|
||||
:link{color:#00C;}
|
||||
:visited{color:#609;}
|
||||
:active{color:#C00;}
|
||||
.date{background-color:#dddddd;font-family:terminal;font-size:small;}
|
||||
th,td{font-family:sans-serif;}
|
||||
h2{font-family:sans-serif;color:#990066;}
|
||||
</style></head>
|
||||
|
||||
<body>
|
||||
<h1><center>This interface is deprecated</center></h1>
|
||||
<table width="90%" cellpadding="0" cellspacing="0" border="0">
|
||||
<tbody><tr>
|
||||
|
||||
<td align="left" valign="top">
|
||||
<blockquote>
|
||||
<h2>Xchat Perl Docs</h2>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066">
|
||||
Introduction
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
<p>Good Hello!</p>
|
||||
<p>The purpose of this page is to give people some quick documentation on the
|
||||
things that they will encounter when they try to code scripts for X-Chat.
|
||||
It is <strong>not</strong> meant to be a comprehensive programming tutorial,
|
||||
by any means. If that's what you're looking for, then you can just keep on
|
||||
looking.</p>
|
||||
<p>If you're going to do any scripting with X-Chat at all, you will
|
||||
need to know perl. It also won't hurt to have had experience writing tcl for
|
||||
eggdrops or ircII scripts. Otherwise you're going to have to be very careful
|
||||
to avoid creating conditions which could flood you offline or do other
|
||||
not-so-optimal things. ;) Thankfully, it shouldn't take most intelligent
|
||||
people more than a week (month on the outside) enough perl to do some nice
|
||||
things in it.
|
||||
<a HREF="http://www.perl.com">Perl</a> is a very flexible language.</p>
|
||||
<p>You should probably also go read (or at least skim over and then carefully
|
||||
bookmark this copy of the thing that defines how IRC works: <a HREF="http://www.irchelp.org/irchelp/rfc1459.html">RFC 1459</a>.
|
||||
Other documents that scripters might find useful would be this
|
||||
<a HREF="http://www.irchelp.org/irchelp/ircd/numerics.html">nice list of server
|
||||
numerics</a>, and this list of <a HREF="http://www.irchelp.org/irchelp/ircd/hybrid6.html">changes
|
||||
for Hybrid 6</a> which is something everyone on EFNet should read. In fact, I
|
||||
<strong>strongly</strong> suggest saving copies of these documents to your local
|
||||
hard drive, because you <i>will</i> be back to look at them again soon.</p>
|
||||
<p>One last thing... While you may hear that RFC 1459 isn't being followed very
|
||||
well, and this is partly true, do your absolute best to stick with RFC-compliant
|
||||
behaviours anyway because otherwise there's a good chance that your script will
|
||||
never interoperate properly with others, or at least just piss off a lot of other
|
||||
people. <i>Pay special attention to section 2.2 of the RFC.</i></p>
|
||||
</blockquote>
|
||||
|
||||
<table ALIGN=CENTER WIDTH="75%" CELLPADDING=5 CELLSPACING=0>
|
||||
<tr><td ALIGN=CENTER BGCOLOR="#FF7070">
|
||||
<font COLOR="#FFFFFF" FACE="Verdana, Helvetica, Arial, Sans"><b>Standard Disclaimer</b>
|
||||
</font>
|
||||
</td></tr><tr> <td BGCOLOR="#FFCECE" ALIGN=CENTER><font COLOR="#800000" FACE="Helvetica, Lucida, Arial, Sans">
|
||||
This documentation is provided on an "as-is" basis and comes with no warranty of accuracy or usefulness, either expressed or implied. It is subject to change without any notice, and may contain omissions or errors which could cause your genitalia to shrivel and fall off, or spontaneously combust. If you have any further questions,<br>please feel free to seek professional help.</font>
|
||||
</td></tr></table>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
About Handlers
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
There are [currently] four basic ways to make things call the subroutines you write for X-Chat and they are:
|
||||
<ul><li>message handlers - Triggered by messagse sent from the IRC server to your client</li>
|
||||
<li>command handlers - triggered by / commands typed in by the user at the keyboard</li>
|
||||
<li>timeout handlers - triggered by gtk+</li>
|
||||
<li>print handlers - triggered just before xchat calls its built in print handlers for events</li></ul>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
About Exit Codes
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
These are very important. Every time you set up a handler, it takes precedent over the built-in functions and commands of X-Chat. That is, whatever thing which triggered your subroutine will go to your code before it goes to X-Chat to be dealt with. In this way you can replace almost every built-in function that the client has with your own routines. The thing to remember is that if your code exits by hitting the end of your subroutine, or by a plain 'return' statement, processing of the event will go on to whatever other things have set up hooks for the event, and then (provided nothing else exits with a return value of 1) to X-Chat itself. There is only one problem with this, (which is solved by the brokering handler that I'll explain that later) and that is that you cannot really control what order the custom routines get called. Normally they will execute in order of which ones were installed first, but a single script has no real way of knowing this. Beware.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
About @_
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
If you've never heard of @_ before, then you've obviously not coded in perl. When a message handler triggers, the raw line from the IRC server is passed to the subroutine you specify in @_. When a command handler is triggered, only the arguments are passed to the routine through @_ and they are not broken into a list, but left as one long string. You'll have to parse those yourself with split. (I advise using s/\s+/ /g to collapse the blank space to single space first.) When a timer handler is triggered, I *think* absolutely nothing is passed in @_, but it's not like anything terrifically important could be passed along anyway. Be especially careful when setting up message handlers for mode changes, since the modes are not broken up into individual events like they are with eggdrop. The upside of this is that X-Chat has no mode hooks of it's own, so you don't have to worry about it too much. (This is not the case with the brokering handler, however.)
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
About Context
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
There are some really nice things about coding for X-Chat, and the biggest one is that it's fairly good about determining the proper context for things. If a server sends something that triggers a message handler, then you can be sure that unless you specify otherwise, that your IRC::print or IRC::command function call will go back to that server and that server alone. If you really really need to know what the current context is, use the IRC::get_info function as detailed below.
|
||||
</blockquote>
|
||||
|
||||
<hr width="95%">
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
script initialization commands
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::register(scriptname, version, shutdownroutine, unused);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
<p>This is the first function your script should call, example:</p>
|
||||
<blockquote><p>IRC::register ("my script", "1.0", "", "");</p></blockquote>
|
||||
<p>The "shutdownroutine" arg is a function that will be called when X-Chat shuts down, so you get a chance to save config files etc. You can omit this arg, it is optional. The "unused" arg is reserved for future use, for now just provide "". This function also returns X-Chat's version number. </p>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
Handler initialization commands
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::add_message_handler(message, subroutine_name);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
<p>This function allows you to set up hooks to subroutines so that when a particular message arrives from the IRC server that you are connected to, it can be passed to a subroutine to be dealt with appropriately. The message argument is essentially the second solid token from the raw line sent by the IRC server, and X-Chat doesn't know that some numeric messages have associated text messages, so for now set up a handler for both if you want to be sure odd servers don't screw up your expectations. (Read: fear IRCNet.) The entire line sent by the IRC server will be passed to your subroutine in @_. For the completely uninitiated, messages are things like 'PRIVMSG', 'NOTICE', '372', etc.</p>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::add_command_handler(command, subroutine_name);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
<p>This function allows you to set up hooks for actual commands that the user can type into the text window. The arguments are passed to the subroutine via @_, and arrive as a single string. @_ will be null if no arguments are supplied. It's recommended that you be sure and collapse the excess whitespace with s/\s+/ /g before attempting to chop the line up with split. As mentioned earlier, exiting with an undefined return value will allow the command to be parsed by other handlers, while using a return value of 1 will signal the program that no further parsing needs to be done with this command.</p>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::add_timeout_handler(interval, subroutine_name);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
<p>This function allows you to set up hooks for subroutines to be called at a particular interval. The interval is measured in milliseconds, so don't use a particularly small value unless you wish to drive the CPU load through the roof. 1000ms = 1 second. No values will be passed to the routine via @_ and return values don't affect anything either.</p>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::add_print_handler(message, subroutine_name);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
<p>This function allows you to catch the system messages (those who generally start by three stars) and to execute a function each time an event appear. The events are those you can see in "Settings->Edit Events Texts". message is the name of the event (you can find it in the Edit Events box, "Events" column) , subroutine_name is the name of the function that will get messages. Be carrful: all the arguments are sent to function in $_[0] separated by spaces. </p>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
Output commands
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::print(text);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This is a very simple routine. All it does is put the contents of the text string to the current window. The current window will be whichever window a command was typed into when called from a command handler, or in whichever window the message command is appropriate to if it is called from within a message handler. As with any perl program, newlines are not assumed, so don't forget to end the line with \n if you don't want things to look screwey.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::print_with_channel( text, channelname, servername );
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This routine does the same thing as IRC::Print does, except it allows you to direct the output to a specific window. It returns 1 on success, 0 on fail.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::command(text);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This routine allows you to execute commands in the current context. The text string containing the command will be parsed by everything that would normally parse a command, including your own command handlers, so be careful. Newlines are assumed, thankfully.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::command_with_server(text, servername);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This routine allows you to specify the context of the server for which the command will be executed. It's not particularly useful unless you're managing a connection manually, yet the command still exists for it's usefulness in doing things like managing a bnc connection, etc. Newlines are assumed here as well.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::send_raw(text);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This routine is very useful in that it allows you to send a string directly to the IRC server you are connected to. It is assumed that the server will be the one you first connected to if there is no clear context for the command, otherwise it will go to whatever server triggered the message handler or command handler window. You must specify newlines here always or you can be guaranteed that strange things will happen. The text message you specify should be a proper RAW IRC message, so don't play with it if you don't know how to do these. Additionally, while newlines are also not assumed here as with the IRC::print function, the RFC specifies that newlines are a CR+LF pair, even if most servers will accept a mere newline. It's best to play it safe and use \r\n instead of just \n.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
Information retrieval commands
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::get_info(integer);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This function returns a bit of selected information depending on what the value of the integer is.
|
||||
Here's a list of the currently supported values:
|
||||
<ul><li>0 - xchat version</li>
|
||||
<li>1 - your nickname</li>
|
||||
<li>2 - channel</li>
|
||||
<li>3 - server</li>
|
||||
<li>4 - xchatdir</li>
|
||||
<li>5 - away status</li>
|
||||
<li>6 - network name</li>
|
||||
<li>7 - server hostname</li>
|
||||
<li>8 - channel topic</li></ul>
|
||||
<p>If you are requesting information that isn't available in the current context, then it will return null.</p>
|
||||
<p>Any numbers other than the above will return an error message.</p>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::get_prefs(var);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This command lets you read the preferences that are set in the xchat configuration file. Just look at the xchat.conf dir to see what variables are available to use with this command. Returns the value of the variable requested or "Unknown Variable" if the variable isn't available.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::user_info( nickname );
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
Returns a flat list of information on the nickname specified consisting of... nickname, nick host, and whether they have op or voice in the current context.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::channel_list( );
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This command returns a flat list which contains the current channel, server, and nickname for all channels the client is currently in. You'll have to break the list up into groups of three yourself. No arguments are necessary, or used [currently].
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::server_list( );
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This command returns a flat list of servers. (Note, it is incompatible with xchat 1.8 in that it also returns a list of servers you are NOT connected to as well.)
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::user_list(channel, server);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
<p>Works very much like the dcc_list command below, except that is returns information about the users on the channel provided as first argument. The second argument is the server and is optional.</p>
|
||||
<p>NOTE: If a user has both op and voice, only the op flag will be set to 1 by this command in xchat2.</p>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::user_list_short(channel, server);
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
<p>A simpler version of IRC::user_list that returns pairs of nick & user@host suitable for assigning to a hash.</p>
|
||||
<p>NOTE: If a user has both op and voice, only the op flag will be set to 1 by this command in xchat2.</p>
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::dcc_list( );
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This command does essentially the same thing as channel_list, giving you the details of each DCC connection currently in progress. I have no idea exactly what is returned because I haven't had a chance to poke at this one much, but suffice it to say that it's a flat list, and the first time you play with it the meaning of the returned values should be pretty obvious.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial">
|
||||
IRC::ignore_list( );
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
This command returns a flat list of the contents of your ignore list. You'll have to play with it a little as I have not had a chance to yet. Works basically the same as the other list commands.
|
||||
</blockquote>
|
||||
|
||||
<table width="95%" cellpadding="0" cellspacing="3" border="0" align="center">
|
||||
<tbody><tr><td bgcolor="#000000">
|
||||
<table width="100%" cellpadding="2" cellspacing="1" border="0"><tbody><tr>
|
||||
<td width="20%" align="left" bgcolor="#dddddd">
|
||||
<font face="Lucida, Helvetica, Arial" color="#990066;">
|
||||
Unimplemented commands that were available in xchat 1.8.x
|
||||
</font></td>
|
||||
</tr></tbody></table>
|
||||
</td></tr></tbody></table>
|
||||
|
||||
<blockquote>
|
||||
add_user_list , sub_user_list , clear_user_list, notify_list were available in xchat 1.8.x but are not implemented in xchat 2 at this time.
|
||||
</blockquote>
|
||||
|
||||
</blockquote>
|
||||
</td>
|
||||
</tr>
|
||||
</tbody></table>
|
||||
<br><hr>
|
||||
<font size="-10">This document originally written by Dagmar d'Surreal on March 26th, 1998 for xchat 1.4<br>
|
||||
Updated on July 30th, 1999 by Peter Zelezny<br>
|
||||
Updated on May 16th, 2003 by DaNumber8 to comply with the perl plugin for xchat2 version 2.0.3</font>
|
||||
</body></html>
|
||||
43
plugins/perl/xcperl_build.bat
Normal file
43
plugins/perl/xcperl_build.bat
Normal file
@ -0,0 +1,43 @@
|
||||
perl generate_header
|
||||
|
||||
gcc -W -Os -DWIN32 -I "C:\MinGW\include" -I .. -I "C:\ActivePerl-5.8.9\perl\lib\CORE" -L "C:\ActivePerl-5.8.9\perl\bin" -c perl.c -o perl5.8.9.o
|
||||
|
||||
dllwrap --def perl.def --dllname xcperl5.8.9.dll "C:\ActivePerl-5.8.9\perl\bin\perl58.dll" perl5.8.9.o
|
||||
|
||||
strip xcperl5.8.9.dll
|
||||
|
||||
|
||||
|
||||
gcc -W -Os -DWIN32 -I "C:\MinGW\include" -I .. -I "C:\Perl\lib\CORE" -L "C:\Perl\bin" -c perl.c -o perl5.10.0.o
|
||||
|
||||
dllwrap --def perl.def --dllname xcperl5.10.0.dll "C:\Perl\bin\perl510.dll" perl5.10.0.o
|
||||
|
||||
strip xcperl5.10.0.dll
|
||||
|
||||
|
||||
gcc -W -Os -DWIN32 -I "C:\MinGW\include" -I .. -I "C:\ActivePerl-5.10.1\perl\lib\CORE" -L "C:\ActivePerl-5.10.1\perl\bin" -c perl.c -o perl5.10.1.o
|
||||
|
||||
dllwrap --def perl.def --dllname xcperl5.10.1.dll "C:\ActivePerl-5.10.1\perl\bin\perl510.dll" perl5.10.1.o
|
||||
|
||||
strip xcperl5.10.1.dll
|
||||
|
||||
|
||||
gcc -W -Os -DWIN32 -I "C:\MinGW\include" -I .. -I "C:\ActivePerl-5.12.1\perl\lib\CORE" -L "C:\ActivePerl-5.12.1\perl\bin" -c perl.c -o perl5.12.1.o
|
||||
|
||||
dllwrap --def perl.def --dllname xcperl5.12.1.dll "C:\ActivePerl-5.12.1\perl\bin\perl512.dll" perl5.12.1.o
|
||||
|
||||
strip xcperl5.12.1.dll
|
||||
|
||||
gcc -W -Os -DWIN32 -I "C:\MinGW\include" -I .. -I "C:\strawberry-perl-5.10.1.3\perl\lib\CORE" -L "C:\strawberry-perl-5.10.1.3\perl\bin" -c perl.c -o perl-strawberry5.10.1.o
|
||||
|
||||
dllwrap --def perl.def --dllname xcperl-strawberry5.10.1.dll "C:\strawberry-perl-5.10.1.3\perl\bin\perl510.dll" perl5.10.1.o
|
||||
|
||||
strip xcperl-strawberry5.10.1.dll
|
||||
|
||||
|
||||
gcc -W -Os -DWIN32 -I "C:\MinGW\include" -I .. -I "C:\strawberry-perl-5.12.1.0-portable\perl\lib\CORE" -L "C:\strawberry-perl-5.12.1.0-portable\perl\bin" -c perl.c -o perl-strawberry5.12.1.o
|
||||
|
||||
dllwrap --def perl.def --dllname xcperl-strawberry5.12.1.dll "C:\strawberry-perl-5.12.1.0-portable\perl\bin\perl512.dll" perl5.12.1.o
|
||||
|
||||
strip xcperl-strawberry5.12.1.dll
|
||||
|
||||
Reference in New Issue
Block a user