1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
Please read this document before asking questions.
(1) WHAT IS THE TCL PLUGIN?
The XChat Tcl Plugin adds the complete Tcl scripting language to the
XChat 1.9.x and 2.x IRC client. The design philosophy behind the tcl
plugin was to give all the power of the C API. yet completely shield
the user from all the complexities of it. It is lightly modeled after
after Xircon; an old windows TCL enabled client with a little bit of
eggdrop functionality to it.
Features:
* Uses the popular TCL scripting language.
* Familiar to eggdrop bot owners.
* Adds many new XChat specific commands to the Tcl language for
handling of events, user commands, timers, etc.
* It's actually documented! (Hey, what a concept!)
* Works with XChat 1.9.x and 2.x.
* Open source (GPL)
The supplied documentation for Tcl Plugin commands can be
found in doc/tclplugin.html
For a comprehensive list of IRC server tokens, see
doc/tokens.txt
(2) HOW TO GET TCL PLUGIN
You can always find the latest version of the Tcl Plugin at:
http://www.scriptkitties.com/tclplugin
You must also have Tcl 8.3 or higher installed on your system.
Tcl can be obtained from:
http://sourceforge.net/projects/tcl
http://tcl.activestate.com (pre-compiled binaries)
Tcl Man Pages
http://tcl.activestate.com/man/
Tcl Tutorials:
http://hegel.ittc.ukans.edu/topics/tcltk/tutorial-noplugin/
http://jan.netcomp.monash.edu.au/ProgrammingUnixpackage IRC;
sub IRC::register {
my ($script_name, $version, $callback) = @_;
my $package = caller;
$callback = Xchat::Embed::fix_callback( $package, undef, $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, undef, $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, undef, $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, undef, $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, undef, $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 configdir 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
|
