Merge branch 'master' into richoH-dev

15 files changed, 1387 insertions, 38 deletions

diff --git a/feature-tests/augment_inputline.pl b/feature-tests/augment_inputline.pl
index 577f756..97a129e 100644
--- a/feature-tests/augment_inputline.pl
+++ b/feature-tests/augment_inputline.pl
@@ -1,3 +1,12 @@
+=pod
+
+=head1 NAME
+
+test
+
+=cut
+
+
 use strict;
 use Irssi;
 use Irssi::TextUI; # for sbar_items_redraw
diff --git a/feature-tests/bindings.pl b/feature-tests/bindings.pl
new file mode 100644
index 0000000..ece220d
--- /dev/null
+++ b/feature-tests/bindings.pl
@@ -0,0 +1,114 @@
+use strict;
+use warnings;
+
+
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use Data::Dumper;
+
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => '',
+              description => '',
+              licence     => q(GNU GPLv2 or later),
+
+             );
+
+# code taken from adv_windowlist
+
+my $keymap;
+
+sub STATE_HEADER () { 0 }
+sub STATE_BODY   () { 1 }
+sub STATE_END    () { 2 }
+my $parse_state = STATE_HEADER;
+
+my $binding_formats = {};
+
+init();
+
+sub init {
+
+    $keymap = {};
+
+    Irssi::command_bind('showbinds', 'cmd_showbinds');
+	Irssi::signal_add('command bind' => 'watch_keymap');
+
+    $binding_formats = get_binding_formats();
+
+    capture_bind_data();
+}
+
+sub get_binding_formats {
+    my $theme = Irssi::current_theme();
+    my @keys = qw/bind_header bind_list bind_command_list
+                  bind_footer bind_unknown_id/;
+
+    my $ret = {};
+    foreach my $key (@keys) {
+        my $tmp = $theme->get_format('fe-common/core', $key);
+        #$tmp =~ s/%/%%/g; # escape colour codes?
+        $ret->{$key} = $tmp;
+    }
+    return $ret;
+}
+
+sub cmd_showbinds {
+    my ($args, @rest) = @_;
+
+    my $win = Irssi::active_win();
+    $win->print("Change window bindings:", Irssi::MSGLEVEL_CLIENTCRAP);
+    for my $w (sort keys %$keymap) {
+        my $x = $keymap->{$w};
+        $win->print("$w ==> $x", Irssi::MSGLEVEL_CLIENTCRAP);
+    }
+    $win->print("Done showing window bindings:", Irssi::MSGLEVEL_CLIENTCRAP);
+
+}
+
+sub sig_print_text {
+	my ($text_dest, $str, $str_stripped) = @_;
+
+    return unless $text_dest->{level} == Irssi::MSGLEVEL_CLIENTCRAP;
+    return unless $text_dest->{target} eq '';
+    return unless not defined $text_dest->{server};
+
+    # if ($parse_state = STATE_HEADER) {
+    #     if ($str =~ m/\Q$binding_formats->{bind_header}\E/) {
+    #         $parse_state = STATE_BODY;
+    #     }
+    # } elsif ($parse_state = STATE_BODY) {
+    print "Data is: $str_stripped";
+    if ($str_stripped =~ m/^.*?(\S{,20})\s+(\S+)\s+(\S+)/) {
+        $keymap->{$1} = "$2, $3";
+        print "Parsed $1 as $2, $3";
+    }
+    Irssi::signal_stop();
+    #     } elsif ($str =~ m/$binding_formats->{bind_footer}\E/) {
+    #         $parse_state = STATE_END;
+    #     }
+    # }
+}
+
+
+sub capture_bind_data {
+	Irssi::signal_remove('command bind' => 'watch_keymap');
+	Irssi::signal_add_first('print text' => 'sig_print_text');
+	Irssi::command('bind'); # stolen from grep
+	Irssi::signal_remove('print text' => 'sig_print_text');
+
+}
+
+
+# watch keymap changes
+sub watch_keymap {
+	Irssi::timeout_add_once(1000, 'capture_bind_data', undef);
+}
+
+
+
diff --git a/feature-tests/colour_test.pl b/feature-tests/colour_test.pl
new file mode 100644
index 0000000..875b63c
--- /dev/null
+++ b/feature-tests/colour_test.pl
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+
+
+use Irssi;
+
+my @colors = (0..255);
+my @names  = qw/black red green yellow blue magenta cyan white/;
+#my @bnames = map { "bold_$_" } @names;
+
+#@names = (@names, @bnames);
+
+foreach my $c (@colors) { 
+    my $n = $names[$c] // $c;
+    Irssi::print("\%$c This is bg color $n\%n");
+}
diff --git a/feature-tests/easy_exec.pl b/feature-tests/easy_exec.pl
index 669a00b..d342516 100644
--- a/feature-tests/easy_exec.pl
+++ b/feature-tests/easy_exec.pl
@@ -2,7 +2,7 @@ use strict;
 use warnings;
 
 # export everything.
-use Irssi; #(@Irssi::EXPORT_OK);
+use Irssi;
 use Irssi::Irc;
 use Irssi::TextUI;
 
@@ -18,33 +18,38 @@ our %IRSSI = (
               license     => 'Public Domain',
              );
 
-#Irssi::signal_add_first 'command script exec', \&better_exec;
-Irssi::command_bind('script exec', \&better_exec);
-
-sub better_exec {
-    my ($args, $serv, $witem) = @_;
-    # todo: handle permanent arg?
-    my $perm = 0;
-    print "Args: $args";
-    if ($args =~ s/^\s*-permanent\s*(.*)$/$1/) {
-        $perm = 1;
-    }
-    print "Args now: $args";
-
-#    eval $args;
-    my $str = "//script exec " .
-     ($perm ? '-permanent' : '')
-     . 'use Irssi (@Irssi::EXPORT_OK); ' . $args;
-     print "Running: $str";
-
-#    Irssi::command($str);
-    Irssi::signal_continue($str, @_[1..$#_]);
-}
+# TODO: make this more tab-complete friendly
+init();
+
+sub init {
+    Irssi::command('/alias se script exec use Data::Dumper\;'
+                   .' use Irssi (@Irssi::EXPORT_OK)\; $0-');
+    Irssi::command('/alias sep script exec -permanent '
+                   . 'use Data::Dumper\; use Irssi (@Irssi::EXPORT_OK)\; $0-');
 
-sub Dump {
-    print Dumper(\@_);
+    Irssi::signal_add_last ('complete word', 'sig_complete_word');
 }
 
-sub test() {
-    print "This is a test";
+sub sig_complete_word {
+    my ($strings, $window, $word, $linestart, $want_space) = @_;
+    # only provide these completions if the input line is otherwise empty.
+    my $cmdchars = Irssi::settings_get_str('cmdchars');
+    my $quoted = quotemeta($cmdchars);
+    #print "Linestart: $linestart";
+    return unless ($linestart =~ /^${quoted}(?:se|sep)/);
+    
+    my $clean_word = $word;
+    $clean_word =~ s/^"//g;
+    $clean_word =~ s/"$//g;
+    $clean_word =~ s/->$//g;
+
+
+
+    my @expansions = @Irssi::EXPORT_OK;
+    push @$strings,  grep { $_ =~ m/^\Q$clean_word\E/ } @expansions;
+    print "Sebug: " . join(", ", @$strings);
+    $$want_space = 0;
+
+
+    Irssi::signal_stop() if (@$strings);
 }
diff --git a/feature-tests/exec.pl b/feature-tests/exec.pl
new file mode 100644
index 0000000..f6d6377
--- /dev/null
+++ b/feature-tests/exec.pl
@@ -0,0 +1,442 @@
+# exec.pl
+# a (currently stupid) alternative to the built-in /exec, because it's broken
+# on OSX. This thing stll needs a whole bunch of actual features, but for now,
+# you can actually run commands.
+
+# Obviously, that's pretty dangerous.  Use at your own risk.
+
+# EXEC [-] [-nosh] [-out | -msg <target> | -notice <target>] [-name <name>] <cmd line>
+# EXEC -out | -window | -msg <target> | -notice <target> | -close | -<signal> %<id>
+# EXEC -in %<id> <text to send to process>
+#
+#      -: Don't print "process terminated ..." message
+#
+#      -nosh: Don't start command through /bin/sh
+#
+#      -out: Send output to active channel/query
+#
+#      -msg: Send output to specified nick/channel
+#
+#      -notice: Send output to specified nick/channel as notices
+#
+#      -name: Name the process so it could be accessed easier
+#
+#      -window: Move the output of specified process to active window
+#
+#      -close: Forcibly close (or "forget") a process that doesn't die.
+#              This only removes all information from irssi concerning the
+#              process, it doesn't send SIGKILL or any other signal
+#              to the process.
+#
+#      -<signal>: Send a signal to process. <signal> can be either numeric
+#                 or one of the few most common ones (hup, term, kill, ...)
+#
+#      -in: Send text to standard input of the specified process
+#
+#      -interactive: Creates a query-like window item. Text written to it is
+#                    sent to executed process, like /EXEC -in.
+#
+# Execute specified command in background. Output of process is printed to
+# active window by default, but can be also sent as messages or notices to
+# specified nick or channel.
+#
+# Processes can be accessed either by their ID or name if you named it. Process
+# identifier must always begin with '%' character, like %0 or %name.
+#
+# Once the process is started, its output can still be redirected elsewhere with
+# the -window, -msg, etc. options. You can send text to standard input of the
+# process with -in option.
+#
+# -close option shouldn't probably be used if there's a better way to kill the
+# process. It is meant to remove the processes that don't die even with
+# SIGKILL. This option just closes the pipes used to communicate with the
+# process and frees all memory it used.
+#
+# EXEC without any arguments displays the list of started processes.
+#
+
+
+
+use 5.010;    # 5.10 or above, necessary to get the return value from a command.
+
+use strict;
+use warnings;
+use English '-no_match_vars';
+
+use Irssi;
+use POSIX;
+use Time::HiRes qw/sleep/;
+use IO::Handle;
+use IO::Pipe;
+use IPC::Open3;
+use Symbol 'geniosym';
+
+use Data::Dumper;
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => 'exec.pl',
+              description => '',
+              license     => 'Public Domain',
+             );
+
+my @processes = ();
+sub get_processes { return @processes }
+
+# the /exec command, nothing to do with the actual command being run.
+my $command;
+my $command_options;
+
+sub get_new_id {
+    my $i = 1;
+    foreach my $proc (@processes) {
+        if ($proc->{id} != $i) {
+            next;
+        }
+        $i++;
+    }
+    return $i;
+}
+
+sub add_process {
+    #my ($pid) = @_;
+    my $id = get_new_id();
+
+    my $new = {
+               id      => $id,
+               pid     => 0,
+               in_tag  => 0,
+               out_tag => 0,
+               err_tag => 0,
+               s_in    => geniosym(), #IO::Handle->new,
+               s_err   => geniosym(), #IO::Handle->new,
+               s_out   => geniosym(), #IO::Handle->new,
+               cmd     => '',
+               opts    => {},
+              };
+
+    # $new->{s_in}->autoflush(1);
+    # $new->{s_out}->autoflush(1);
+    # $new->{s_err}->autoflush(1);
+
+    push @processes, $new;
+
+    _msg("New process item created: $id");
+    return $new;
+}
+
+sub find_process_by_id {
+    my ($id) = @_;
+    my @matches =  grep { $_->{id} == $id } @processes;
+    _error("wtf, multiple id matches for $id. BUG") if @matches > 1;
+
+    return $matches[0];
+
+}
+sub find_process_by_pid {
+    my ($pid) = @_;
+    my @matches =  grep { $_->{pid} == $pid } @processes;
+    _error("wtf, multiple pid matches for $pid. BUG") if @matches > 1;
+
+    return $matches[0];
+}
+
+sub remove_process {
+    my ($id, $verbose) = @_;
+    my $del_index = 0;
+    foreach my $proc (@processes) {
+        if ($id == $proc->{id}) {
+            last;
+        }
+        $del_index++;
+    }
+    print "remove: del index: $del_index";
+    if ($del_index <= $#processes) {
+        my $dead = splice(@processes, $del_index, 1, ());
+        #_msg("removing " . Dumper($dead));
+
+        Irssi::input_remove($dead->{err_tag});
+        Irssi::input_remove($dead->{out_tag});
+
+        close $dead->{s_out};
+        close $dead->{s_in};
+        close $dead->{s_err};
+
+    } else {
+        $verbose = 1;
+        if ($verbose) {
+            print "remove: No such process with ID $id";
+        }
+    }
+}
+
+sub show_current_processes {
+    if (@processes == 0) {
+        print "No processes running";
+        return;
+    }
+    foreach my $p (@processes) {
+        printf("ID: %d, PID: %d, Command: %s", $p->{id}, $p->{pid}, $p->{cmd});
+    }
+}
+
+sub parse_options {
+    my ($args) = @_;
+    my @options = Irssi::command_parse_options($command, $args);
+    if (@options) {
+        my $opt_hash = $options[0];
+        my $rest     = $options[1];
+
+        $rest =~ s/^\s*(.*?)\s*$/$1/; # trim surrounding space.
+
+        #print Dumper([$opt_hash, $rest]);
+        if (length $rest) {
+            return ($opt_hash, $rest);
+        } else {
+            show_current_processes();
+            return ();
+        }
+    } else {
+        _error("Error parsing $command options");
+        return ();
+    }
+}
+
+sub schedule_cleanup {
+    my $fd = shift;
+    Irssi::timeout_add_once(100, sub { $_[0]->close }, $fd);
+}
+
+sub do_fork_and_exec {
+    my ($rec) = @_;
+
+    #Irssi::timeout_add_once(100, sub { die }, {});
+
+    return unless exists $rec->{cmd};
+    drop_privs();
+
+    _msg("Executing command " . join(", ", @{ $rec->{cmd} }));
+    my $c = join(" ", @{ $rec->{cmd} });
+    my $pid = open3($rec->{s_sin}, $rec->{s_out}, $rec->{s_err}, $c);
+
+    _msg("PID is $pid");
+    $rec->{pid} = $pid;
+
+    # _msg("Pid %s, in: %s, out: %s, err: %s, cmd: %s",
+    #      $pid, $sin, $sout, $serr, $cmd);
+
+    # _msg("filenos, Pid %s, in: %s, out: %s, err: %s",
+    #      $pid, $sin->fileno, $sout->fileno, $serr->fileno);
+
+    if (not defined $pid) {
+
+        _error("open3 failed: $! Aborting");
+
+        close($_) for ($rec->{s_in}, $rec->{s_err}, $rec->{s_out});
+        undef($_) for ($rec->{s_in}, $rec->{s_err}, $rec->{s_out});
+
+        return;
+    }
+
+    # parent
+    if ($pid) {
+
+#    eval {
+        print "fileno is " .  fileno($rec->{s_out});
+        $rec->{out_tag} = Irssi::input_add( fileno($rec->{s_out}),
+                                            Irssi::INPUT_READ,
+                                            \&child_output,
+                                            $rec);
+        #die unless $rec->{out_tag};
+
+        $rec->{err_tag} = Irssi::input_add(fileno($rec->{s_err}),
+                                           Irssi::INPUT_READ,
+                                           \&child_error,
+                                           $rec);
+        #die unless $rec->{err_tag};
+
+ #   };
+
+
+        Irssi::pidwait_add($pid);
+        die "input_add failed to initialise: $@" if $@;
+    }
+}
+
+sub drop_privs {
+    my @temp = ($EUID, $EGID);
+    my $orig_uid = $UID;
+    my $orig_gid = $GID;
+    $EUID = $UID;
+    $EGID = $GID;
+    # Drop privileges
+    $UID = $orig_uid;
+    $GID = $orig_gid;
+    # Make sure privs are really gone
+    ($EUID, $EGID) = @temp;
+    die "Can't drop privileges"
+      unless $UID == $EUID && $GID eq $EGID;
+}
+
+sub child_error {
+    my $rec = shift;
+
+    my $err_fh = $rec->{s_err};
+
+    my $done = 0;
+
+    while (not $done) {
+        my $data = '';
+        _msg("Stderr: starting sysread");
+        my $bytes_read = sysread($err_fh, $data, 256);
+        if (not defined $bytes_read) {
+            _error("stderr: sysread failed:: $!");
+            $done = 1;
+        } elsif ($bytes_read == 0) {
+            _msg("stderr: sysread got EOF");
+            $done = 1;
+        } elsif ($bytes_read < 256) {
+            # that's all, folks.
+            _msg("%%_stderr:%%_ read %d bytes: %s", $bytes_read, $data);
+        } else {
+            # we maybe need to read some more
+            _msg("%%_stderr:%%_ read %d bytes: %s, maybe more", $bytes_read, $data);
+        }
+    }
+
+    _msg('removing input stderr tag');
+    Irssi::input_remove($rec->{err_tag});
+
+}
+
+sub sig_pidwait {
+    my ($pidwait, $status) = @_;
+    my @matches = grep { $_->{pid} == $pidwait } @processes;
+    foreach my $m (@matches) {
+        _msg("PID %d has terminated. Status %d (or maybe %d .... %d)",
+             $pidwait, $status, $?, ${^CHILD_ERROR_NATIVE} );
+
+        remove_process($m->{id});
+    }
+}
+
+sub child_output {
+    my $rec = shift;
+    my $out_fh = $rec->{s_out};
+
+    my $done = 0;
+
+    while (not $done) {
+        my $data = '';
+        _msg("Stdout: starting sysread");
+        my $bytes_read = sysread($out_fh, $data, 256);
+        if (not defined $bytes_read) {
+            _error("stdout: sysread failed:: $!");
+            $done = 1;
+        } elsif ($bytes_read == 0) {
+            _msg("stdout: sysread got EOF");
+            $done = 1;
+        } elsif ($bytes_read < 256) {
+            # that's all, folks.
+            _msg("%%_stdout:%%_ read %d bytes: %s", $bytes_read, $data);
+        } else {
+            # we maybe need to read some more
+            _msg("%%_stdout:%%_ read %d bytes: %s, maybe more", $bytes_read, $data);
+        }
+    }
+
+    _msg('removing input stdout tag');
+    Irssi::input_remove($rec->{out_tag});
+
+    #schedule_cleanup($stdout_reader);
+    #$stdout_reader->close;
+}
+
+sub _error {
+    my ($msg, @params) = @_;
+    my $win = Irssi::active_win();
+    my $str = sprintf($msg, @params);
+    $win->print($str, Irssi::MSGLEVEL_CLIENTERROR);
+}
+
+sub _msg {
+    my ($msg, @params) = @_;
+    my $win = Irssi::active_win();
+    my $str = sprintf($msg, @params);
+    $win->print($str, Irssi::MSGLEVEL_CLIENTCRAP);
+}
+
+sub cmd_exec {
+
+    my ($args, $server, $witem) = @_;
+    Irssi::signal_stop;
+    my @options = parse_options($args);
+
+    if (@options) {
+        my $rec = add_process();
+        my ($options, $cmd) = @options;
+
+        $cmd = [split ' ', $cmd];
+
+        if (not exists $options->{nosh}) {
+            unshift @$cmd, ("/bin/sh -c");
+        }
+
+        $rec->{opts} = $options;
+        $rec->{cmd}  = $cmd;
+
+        do_fork_and_exec($rec)
+    }
+
+}
+
+sub cmd_input {
+    my ($args) = @_;
+    my $rec = $processes[0];    # HACK, make them specify.
+    if ($rec->{pid}) {
+        print "INput writing to $rec->{pid}";
+        my $fh = $rec->{s_in};
+
+        my $ret = syswrite($fh, "$args\n");
+        if (not defined $ret) {
+            print "Error writing to process $rec->{pid}: $!";
+        } else {
+            print "Wrote $ret bytes to $rec->{pid}";
+        }
+
+    } else {
+        _error("no execs are running to accept input");
+    }
+}
+
+sub exec_init {
+    $command = "exec";
+    $command_options = join ' ',
+      (
+       '!-', 'interactive', 'nosh', '+name', '+msg',
+       '+notice', 'window', 'close', '+level', 'quiet'
+      );
+
+    Irssi::command_bind($command, \&cmd_exec);
+    Irssi::command_set_options($command, $command_options);
+    Irssi::command_bind('input', \&cmd_input);
+
+    Irssi::signal_add('pidwait', \&sig_pidwait);
+}
+
+  exec_init();
+
+package Irssi::UI;
+
+{
+    no warnings 'redefine';
+
+    sub processes() {
+        return Irssi::Script::exec::get_processes();
+    }
+
+}
+
+1;
diff --git a/feature-tests/format-test.pl b/feature-tests/format-test.pl
index d8be412..7a38d9f 100644
--- a/feature-tests/format-test.pl
+++ b/feature-tests/format-test.pl
@@ -3,7 +3,7 @@ use warnings;
 
 
 use Irssi;
-
+use Data::Dumper;
 
 our $VERSION = '0.1';
 our %IRSSI = (
@@ -14,13 +14,26 @@ our %IRSSI = (
               license     => 'Public Domain',
              );
 
+sub actually_printformat {
+    my ($win, $level, $module, $format, @args) = @_;
+    my $ret = '';
+    {
+        # deeeeeeep black magic.
+        local *CORE::GLOBAL::caller = sub { $module };
+        $win->printformat($level, $format, @args);
+
+        $ret = Irssi::current_theme()->get_format($module, $format);
+    }
+    return $ret;
+}
+
 init();
 
 sub init {
-    Irssi::command_bind('ft', \&format_test);
-}
+    my $win = Irssi::active_win();
+    my $moo = actually_printformat($win, Irssi::MSGLEVEL_CLIENTCRAP, 'fe-common/irc',
+                                   "kill_server", "foo", "bar", "horse", "cake");
 
+    print Dumper($moo);
 
-sub format_test {
-    my ($args, $win, $server) = @_;
 }
diff --git a/feature-tests/getchan.pl b/feature-tests/getchan.pl
new file mode 100644
index 0000000..7d4ee55
--- /dev/null
+++ b/feature-tests/getchan.pl
@@ -0,0 +1,165 @@
+=pod
+
+=head1 NAME
+
+template.pl
+
+=head1 DESCRIPTION
+
+A minimalist template useful for basing actual scripts on.
+
+=head1 INSTALLATION
+
+Copy into your F<~/.irssi/scripts/> directory and load with
+C</SCRIPT LOAD F<filename>>.
+
+=head1 USAGE
+
+None, since it doesn't actually do anything.
+
+=head1 AUTHORS
+
+Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>>
+
+=head1 LICENCE
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+
+=head1 BUGS
+
+=head1 TODO
+
+Use this template to make an actual script.
+
+=cut
+
+use strict;
+use warnings;
+
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use Data::Dumper;
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => '',
+              description => '',
+              license     => 'MIT',
+              updated     => '$DATE'
+             );
+
+
+my $line_format;
+my $head_format;
+my $foot_format;
+
+my $channels = {};
+my @errors;
+my $state;
+
+sub get_format_string {
+    return Irssi::current_theme->get_format(@_);
+}
+
+
+sub get_channels {
+    # see here: https://github.com/shabble/irssi-docs/wiki/complete_themes
+    $line_format = get_format_string('fe-common/core', 'chansetup_line');
+    $head_format = get_format_string('fe-common/core', 'chansetup_header');
+    $foot_format = get_format_string('fe-common/core', 'chansetup_footer');
+
+    my $parse_line_format = "channel:\$0\tnet:\$1\tpass:\$2\tsettings:\$3";
+    Irssi::command("^FORMAT chansetup_line $parse_line_format");
+    Irssi::command("^FORMAT chansetup_header START");
+    Irssi::command("^FORMAT chansetup_footer END");
+
+    $state = 0;
+    Irssi::signal_add_first('print text', 'sig_print_text');
+    Irssi::command("CHANNEL LIST");
+    Irssi::signal_remove('print text', 'sig_print_text');
+
+}
+
+sub restore_formats {
+    Irssi::command("^FORMAT chansetup_line $line_format");
+    Irssi::command("^FORMAT chansetup_header $head_format");
+    if ($foot_format =~ m/^\s*$/) {
+        Irssi::command("^FORMAT -reset chansetup_footer");
+    } else {
+        Irssi::command("^FORMAT  chansetup_footer $foot_format");
+    }
+}
+
+sub sig_print_text {
+    my ($dest, $text, $stripped) = @_;
+
+    my $entry = {};
+
+    if ($state == 0 && $text =~ m/START/) {
+        $state = 1;
+    } elsif ($state == 1) {
+        # TODO: might we get multiple lines at once?
+        if ($text =~ m/channel:([^\t]+)\tnet:([^\t]+)\tpass:([^\t]*)\tsettings:(.*)$/) {
+            $entry->{channel}  = $1;
+            $entry->{network}  = $2;
+            $entry->{password} = $3;
+            $entry->{settings} = $4;
+
+            my $tag = "$2/$1";
+            $channels->{$tag} = $entry;
+
+        } elsif ($text =~ m/END/) {
+            $state = 0;
+        } else {
+            push @errors, "Failed to parse: '$text'";
+        }
+    }
+    Irssi::signal_stop();
+}
+
+sub go {
+    eval {
+        get_channels();
+    };
+    if ($@) {
+        print "Error: $@. Reloading theme to restore format";
+        Irssi::themes_reload();
+    } else {
+        restore_formats();
+    }
+    if (@errors) {
+        @errors = map { s/\t/    /g } @errors;
+        print Dumper(\@errors);
+    }
+    print Dumper($channels);
+}
+
+Irssi::command_bind('getchan', \&go);
+# in fe-common/core
+#
+#  chansetup_not_found = "Channel {channel $0} not found";
+#  chansetup_added = "Channel {channel $0} saved";
+#  chansetup_removed = "Channel {channel $0} removed";
+#  chansetup_header = "%#Channel         Network    Password   Settings";
+#  chansetup_line = "%#{channel $[15]0} %|$[10]1 $[10]2 $3";
+#  chansetup_footer = "";
diff --git a/feature-tests/key_sig.pl b/feature-tests/key_sig.pl
new file mode 100644
index 0000000..ef69d45
--- /dev/null
+++ b/feature-tests/key_sig.pl
@@ -0,0 +1,51 @@
+use strict;
+use warnings 'all';
+
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use Data::Dumper;
+
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => '',
+              description => '',
+              license     => 'Public Domain',
+             );
+
+my $bacon = 10;
+
+Irssi::signal_register({'key created' => [qw/Irssi::UI::Key/ ] });
+
+Irssi::signal_add('key created', \&sig_key_created);
+Irssi::signal_register({'key command' => [qw/string/]});
+Irssi::signal_add_first('key command' => \&sig_key_cmd);
+
+Irssi::signal_register({'key nothing' => [qw/string/]});
+Irssi::signal_add_first('key nothing' => \&sig_key_cmd);
+
+Irssi::signal_register({'keyboard created' => [qw/Irssi::UI::Keyboard/]});
+Irssi::signal_add_first('keyboard created' => \&sig_keyboard);
+
+sub sig_keyboard {
+    my ($data) = @_;
+    print "keyboard: " . Dumper($data);
+}
+
+sub sig_key_cmd {
+    my ($data) = @_;
+    print "key cmd: " . Dumper($data);
+
+}
+
+sub sig_key_created {
+    my @args = @_;
+
+    print "Key Created, Args: " . Dumper(\@args);
+}
+
+Irssi::command("bind meta-q /echo moo");
diff --git a/feature-tests/local_input_capture.pl b/feature-tests/local_input_capture.pl
new file mode 100644
index 0000000..847ff07
--- /dev/null
+++ b/feature-tests/local_input_capture.pl
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+
+
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use Data::Dumper;
+
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => '',
+              description => '',
+              license     => 'Public Domain',
+             );
+
+my $buffer = '';
+init();
+
+sub init {
+
+    Irssi::signal_add_first 'print text', 'sig_print_text';
+    Irssi::command 'echo Hello there';
+    Irssi::signal_remove 'print text', 'sig_print_text';
+    Irssi::command_bind 'showbuf', 'cmd_showbuf';
+}
+
+sub cmd_showbuf {
+    my ($args, $server, $win_item) = @_;
+    my $win;
+    if (defined $win_item) {
+        $win = $win_item->window();
+    } else {
+        $win = Irssi::active_win();
+    }
+
+    $win->print("buffer is: $buffer");
+    $buffer = '';
+}
+
+sub sig_print_text {
+    my ($text_dest, $str, $stripped_str) = @_;
+
+    $buffer .= $stripped_str;
+    Irssi::signal_stop;
+}
diff --git a/feature-tests/pipes.pl b/feature-tests/pipes.pl
new file mode 100644
index 0000000..50bff53
--- /dev/null
+++ b/feature-tests/pipes.pl
@@ -0,0 +1,87 @@
+use strict;
+use warnings;
+
+use Irssi;
+use POSIX;
+use Time::HiRes qw/sleep/;
+
+my $forked = 0;
+
+sub pipe_and_fork {
+    my ($read_handle, $write_handle);
+
+    pipe($read_handle, $write_handle);
+
+    my $oldfh = select($write_handle);
+    $| = 1;
+    select $oldfh;
+
+    return if $forked;
+
+    my $pid = fork();
+
+    if (not defined $pid) {
+        _error("Can't fork: Aborting");
+        close($read_handle);
+        close($write_handle);
+        return;
+    }
+
+    $forked = 1;
+
+    if ($pid > 0) { # this is the parent (Irssi)
+        close ($write_handle);
+        Irssi::pidwait_add($pid);
+        my $job = $pid;
+        my $tag;
+        my @args = ($read_handle, \$tag, $job);
+        $tag = Irssi::input_add(fileno($read_handle),
+                                      Irssi::INPUT_READ,
+                                      \&child_input,
+                                      \@args);
+
+    } else { # child
+        # make up some data - block if we like.
+        for (1..10) {
+            sleep rand 1;
+            print $write_handle "Some data: $_\n";
+        }
+        print $write_handle "__DONE__\n";
+        close $write_handle;
+
+        POSIX::_exit(1);
+    }
+}
+
+sub child_input {
+    my $args = shift;
+    my ($read_handle, $input_tag_ref, $job) = @$args;
+
+    my $data = <$read_handle>;
+
+    if ($data =~ m/__DONE__/) {
+        close($read_handle);
+        Irssi::input_remove($$input_tag_ref);
+        _msg("child finished");
+
+        $forked = 0;
+
+    } else {
+        _msg("Received from child: $data");
+    }
+
+}
+
+sub _error {
+    my ($msg) = @_;
+    my $win = Irssi::active_win();
+    $win->print($msg, Irssi::MSGLEVEL_CLIENTERROR);
+}
+
+sub _msg {
+    my ($msg) = @_;
+    my $win = Irssi::active_win();
+    $win->print($msg, Irssi::MSGLEVEL_CLIENTCRAP);
+}
+
+Irssi::command_bind("start_pipes", \&pipe_and_fork);
diff --git a/feature-tests/redir-input.pl b/feature-tests/redir-input.pl
index 94ca523..ed77d3c 100644
--- a/feature-tests/redir-input.pl
+++ b/feature-tests/redir-input.pl
@@ -20,11 +20,14 @@ our %IRSSI = (
 
 
 Irssi::command_bind("ri", \&cmd_ri);
-
+Irssi::signal_register({ 'gui entry redirect' => [ qw/string string intptr intptr/]});
 sub cmd_ri {
     my ($args, $server, $witem) = @_;
     my $win = Irssi::active_win();
-
+    my ($x, $y) = (0, 0);
+    Irssi::signal_emit('gui entry redirect', 'sub_blah', "bacon", $x, $y);
     #my $ref = Irssi::windows_refnum_last
-    $win->format_create_dest(Irssi::MSGLEVEL_ClIENTCRAP());
+#    $win->format_create_dest(Irssi::MSGLEVEL_ClIENTCRAP());
 }
+
+sub sub_blah { print "Moo" }
diff --git a/feature-tests/sig_unbind.pl b/feature-tests/sig_unbind.pl
new file mode 100644
index 0000000..3123182
--- /dev/null
+++ b/feature-tests/sig_unbind.pl
@@ -0,0 +1,58 @@
+use strict;
+use warnings;
+
+
+use Irssi (@Irssi::EXPORT_OK);
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use Data::Dumper;
+
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => '',
+              description => '',
+              license     => 'Public Domain',
+             );
+
+command_bind("dosig_r",
+             sub {
+                 my $ref = \&cmd_oink;
+                 _print("binding oink to $ref");
+                 signal_add("command oink", $ref);
+             });
+
+command_bind("undosig_r",
+             sub {
+                 my $ref = \&cmd_oink;
+
+                 _print("unbinding oink from $ref");
+
+                 signal_remove("command oink", $ref);
+                 });
+
+command_bind("dosig_s",
+             sub {
+                 signal_add("command oink", 'cmd_oink');
+             });
+
+command_bind("undosig_s",
+             sub {
+                 signal_remove("command oink", 'cmd_oink');
+                 });
+
+sub cmd_oink {
+    Irssi::active_win()->print("Oink:");
+}
+
+sub _print  {
+    Irssi::active_win()->print($_[0]);
+}
+
+command("dosig_r");
+command("oink");
+command("undosig_r");
+command("oink");
diff --git a/feature-tests/signal_logger.pl b/feature-tests/signal_logger.pl
new file mode 100644
index 0000000..3b3b9ad
--- /dev/null
+++ b/feature-tests/signal_logger.pl
@@ -0,0 +1,170 @@
+use strict;
+use warnings;
+
+
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+use Time::HiRes qw/time/;
+
+use Data::Dumper;
+
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => '',
+              description => '',
+              license     => 'Public Domain',
+             );
+
+my $enabled = 0;
+my $depth = 0;
+my $handlers = { };
+my @log = ();
+my @signals =
+(
+'send text',
+'send command',
+#'print text',
+#'gui print text',
+'beep',
+#'complete word',
+#'gui key pressed',
+'window changed',
+ "server add fill",
+ "server connect copy",
+ "server connect failed",
+ "server connected",
+ "server connecting",
+ "server disconnected",
+ "server event",
+ "server incoming",
+ "server lag disconnect",
+ "server lag",
+ "server looking",
+ "server nick changed",
+ "server quit",
+ "server reconnect not found",
+ "server reconnect remove",
+ "server reconnect save status",
+ "server sendmsg",
+ "server setup fill chatnet",
+ "server setup fill connect",
+ "server setup fill reconn",
+ "server setup read",
+ "server setup saved",
+ "default event",
+#'gui print text finished',
+
+);
+
+init();
+
+sub init {
+
+    @log = ();
+    $handlers = {};
+
+    Irssi::command_bind('siglog_on',    \&cmd_register_all_signals);
+    Irssi::command_bind('siglog_off',   \&cmd_unregister_all_signals);
+    Irssi::command_bind('siglog_dump',  \&cmd_log_dump);
+    Irssi::command_bind('siglog_stats', \&cmd_log_stats);
+}
+
+sub cmd_register_all_signals {
+
+
+    Irssi::active_win->print("Starting to log all signals");
+    $enabled = 1;
+
+    foreach my $sig_name (@signals) {
+
+        my $first_func = build_init_func($sig_name);
+        my $last_func  = build_end_func($sig_name);
+
+        $handlers->{$sig_name} = [ $first_func, $last_func ];
+
+        Irssi::signal_add_first($sig_name, $first_func);
+        Irssi::signal_add_last($sig_name,  $last_func);
+    }
+}
+
+sub cmd_unregister_all_signals {
+
+    foreach my $sig_name (@signals) {
+
+        my ($first_func, $last_func) = @{ $handlers->{$sig_name} };
+
+        Irssi::signal_remove($sig_name, $first_func);
+        Irssi::signal_remove($sig_name,  $last_func);
+    }
+    $enabled = 0;
+    Irssi::active_win->print("Signal logging disabled");
+
+}
+
+sub cmd_log_dump {
+
+    my $win = Irssi::active_win();
+    if ($enabled) {
+        cmd_unregister_all_signals();
+        $win->print("Disabled logging");
+    }
+    foreach my $lref (@log) {
+        my ($line, $indent) = @$lref;
+        my $xx = " " x $indent;
+        $win->print($xx . $line);
+    }
+}
+
+sub cmd_log_stats {
+
+    my $win = Irssi::active_win();
+    if ($enabled) {
+        cmd_unregister_all_signals();
+        $win->print("Disabled logging");
+    }
+}
+
+sub build_init_func {
+    my ($sig_name) = @_;
+
+    return sub {
+        my @args = @_;
+        my $args_str = '';
+        my $n = 0;
+
+        foreach my $arg (@args) {
+            $args_str .= "[$n] ";
+
+            if (not defined $arg) {
+                $args_str .= "undef, ";
+                next;
+            }
+
+            if (ref $arg) {
+                $args_str .= ref($arg) . ", "
+            } else {
+                $arg =~ s/^(.{20})/$1/;
+                $args_str .= "$arg, ";
+            }
+            $n++;
+        }
+        my $msg = sprintf("%f: %s - First %s", time(), $sig_name, $args_str);
+        push @log, [$msg, $depth];
+        $depth++;
+    }
+}
+
+sub build_end_func {
+    my ($sig_name) = @_;
+
+    return sub {
+        my $msg = sprintf("%f: %s - End", time(), $sig_name);
+        push @log, [$msg, $depth];
+        $depth--;
+    }
+}
+
diff --git a/feature-tests/signal_redir.pl b/feature-tests/signal_redir.pl
new file mode 100644
index 0000000..89da34c
--- /dev/null
+++ b/feature-tests/signal_redir.pl
@@ -0,0 +1,116 @@
+# mangled from cmpusers.pl (unpublished, afaik) by Bazerka <bazerka@quakenet.org>.
+# He is not to blame for any problems, contact me instead.
+
+use strict;
+use warnings;
+
+use Irssi;
+
+our $VERSION = "0.1";
+our %IRSSI =
+  (
+   authors     => "shabble, Bazerka",
+   contact     => 'shabble+irssi@metavore.org, shabble@#irssi/Freenode,'
+                . 'bazerka@quakenet.org',
+   name        => "signal_redir",
+   description => "Demonstration showing how to redirect a remote WHOIS" 
+                . "command so the results can be captured by a script.",
+   license     => "BSD",
+   url         => "https://github.com/shabble/irssi-scripts/",
+   changed     => "Fri Apr 1 00:05:39 2011"
+  );
+
+my $running = 0; # flag to prevent overlapping requests.
+my $debug = 1;
+sub redir_init {
+    # set up event to handler mappings
+    Irssi::signal_add
+        ({
+          'redir test_redir_whois_user'       => 'event_whois_user',
+          'redir test_redir_whois_channels'   => 'event_whois_channels',
+          'redir test_redir_whois_end'        => 'event_whois_end',
+          'redir test_redir_whois_nosuchnick' => 'event_whois_nosuchnick',
+          'redir test_redir_whois_timeout'    => 'event_whois_timeout',
+         });
+}
+
+sub request_whois {
+    my ($server, $nick) = @_;
+
+    $server->redirect_event
+      (
+       'whois', 1, $nick, 0,             # command, remote, arg, timeout
+       'redir test_redir_whois_timeout', # error handler
+       {
+        'event 311' => 'redir test_redir_whois_user', # event mappings
+        'event 318' => 'redir test_redir_whois_end',
+        'event 319' => 'redir test_redir_whois_channels',
+        'event 401' => 'redir test_redir_whois_nosuchnick',
+        ''          => 'event empty',
+       }
+      );
+    Irssi::print("Sending Command: WHOIS $nick", MSGLEVEL_CLIENTCRAP) if $debug;
+    # send the actual command directly to the server, rather than
+    # with $server->command()
+    $server->send_raw("WHOIS $nick");
+}
+
+sub event_whois_user {
+    my ($server, $data) = @_;
+    my ($nick, $user, $host) = ( split / +/, $data, 6 )[ 1, 2, 3 ];
+    Irssi::print("test_redir whois_user: $nick!$user\@$host", MSGLEVEL_CLIENTCRAP);
+}
+
+sub event_whois_channels {
+    my ($server, $data) = @_;
+    my ($nick, $channels) = ( split / +/, $data, 3 )[ 1, 2 ];
+    my $prefix = 'cowu.be'; # server name
+    my $args = "shabble";   # match criteria
+    my $event = 'event 319'; # triggering event
+    my $sig = $server->redirect_get_signal($prefix, $event, $args);
+    Irssi::print("test_redir whois_channels: $nick, $channels", MSGLEVEL_CLIENTCRAP);
+    Irssi::print("test_redir get_signal: $sig", MSGLEVEL_CLIENTCRAP);
+
+}
+
+sub event_whois_end {
+    my ($server, $data) = @_;
+    my ($nick) = ( split / +/, $data, 3 )[1];
+    Irssi::print("test_redir whois_end: $nick", MSGLEVEL_CLIENTCRAP);
+
+    return if $running == 0; # catch 318 -> 401 (nosuchnick followed by endofwhois)
+    $running = 0;
+}
+
+sub event_whois_nosuchnick {
+    my ($server, $data) = @_;
+    my $nick = ( split / +/, $data, 4)[1];
+    Irssi::active_win->print("test_redir error: no such nick $nick - aborting.",
+                             MSGLEVEL_CLIENTCRAP);
+    $running = 0;
+}
+
+sub event_whois_timeout {
+    my ($server, $data) = @_;
+    Irssi::print("test_redir whois_timeout", MSGLEVEL_CLIENTCRAP);
+    $running = 0;
+}
+
+sub cmd_test_redir {
+    my ($args, $server, $witem) = @_;
+    $args = lc $args;
+    my @nicks = split /\s+/, $args;
+
+    if ($running) {
+        Irssi::active_win->print
+            ("test_redir error: a request is currently being processed "
+             . "- please try again shortly.", MSGLEVEL_CLIENTCRAP);
+        return;
+    }
+    $running = 1;
+    request_whois($server, $nicks[0]);
+}
+
+redir_init();
+Irssi::command_bind("test_redir", \&cmd_test_redir);
+
diff --git a/feature-tests/template.pl b/feature-tests/template.pl
index f3ae68a..a49d742 100644
--- a/feature-tests/template.pl
+++ b/feature-tests/template.pl
@@ -1,19 +1,69 @@
+=pod
+
+=head1 NAME
+
+template.pl
+
+=head1 DESCRIPTION
+
+A minimalist template useful for basing actual scripts on.
+
+=head1 INSTALLATION
+
+Copy into your F<~/.irssi/scripts/> directory and load with
+C</SCRIPT LOAD F<filename>>.
+
+=head1 USAGE
+
+None, since it doesn't actually do anything.
+
+=head1 AUTHORS
+
+Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>>
+
+=head1 LICENCE
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+
+=head1 BUGS
+
+=head1 TODO
+
+Use this template to make an actual script.
+
+=cut
+
 use strict;
 use warnings;
 
-
 use Irssi;
 use Irssi::Irc;
 use Irssi::TextUI;
 
 use Data::Dumper;
 
-
 our $VERSION = '0.1';
 our %IRSSI = (
               authors     => 'shabble',
               contact     => 'shabble+irssi@metavore.org',
               name        => '',
               description => '',
-              license     => 'Public Domain',
+              license     => 'MIT',
+              updated     => '$DATE'
              );