Adding upstream version 20231031.upstream/20231031upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 495 insertions, 0 deletions

diff --git a/scripts/go2.pl b/scripts/go2.pl
new file mode 100644
index 0000000..bdae0e7
--- /dev/null
+++ b/scripts/go2.pl
@@ -0,0 +1,495 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+use Irssi::TextUI;
+
+$VERSION = '1.1';
+%IRSSI = (
+    authors     => 'cxreg',
+    contact     => 'cxreg@pobox.com',
+    name        => 'go2',
+    description => 'Switch to the window with the given name or item',
+    license     => 'Public Domain',
+    url         => 'http://genericorp.net/~count/irssi/go',
+    changed     => '2017-05-02',
+);
+
+# Tab complete (0.8.12+)
+sub signal_complete_go {
+    my ( $complist, $window, $word, $linestart, $want_space ) = @_;
+
+    # This is cargo culted but I think it's right
+    my $k = Irssi::parse_special('$k');
+    return unless ( $linestart =~ /^\Q${k}\Ego/i );
+
+    # before we call the go command, remove the input, or else scripts like
+    # per_window_prompt.pl will save the /go call, which we don't want.
+    Irssi::gui_input_set('');
+
+    # call the go command
+    $window->command("go $word");
+
+    # we've come back from the go command and cleaned up the command line,
+    # now finish up
+    @$complist = ();
+    Irssi::signal_stop();
+}
+
+# Only do this in irssi 0.8.12 or better since input mangling didn't exist until then
+if ( Irssi::version >= 20070804 ) {
+    Irssi::signal_add_first( 'complete word', 'signal_complete_go' );
+}
+
+sub cmd_go2 {
+    my ($window, $suggestion, @matches);
+    my $buf = '';
+
+    # get a complete list of current windows
+    my @all_windows = Irssi::windows();
+
+    # Parse passed in argument
+    if ( length $_[0] ) {
+        $buf = shift;
+
+        # this messes up a quick jump to any channel or window named "help",
+        # so maybe this should be an option
+        if ( $buf eq 'help' ) {
+            _help();
+            return;
+        }
+
+        @matches = _match( $buf, @all_windows );
+
+        my @non_cur = grep { !$_->{active_win} } @matches;
+        if ( @matches and !@non_cur ) {
+            # The only match is the current window, bail out
+            return;
+        }
+
+        # First look for an (non-current) exact match
+        my @exact_matches = grep { $_->{exact} } @non_cur;
+        if ( @exact_matches == 1 ) {
+            $exact_matches[0]->{window}->set_active;
+            return;
+        }
+
+        # Then look for any single (non-current) match
+        if ( @non_cur == 1 ) {
+            $non_cur[0]->{window}->set_active;
+            return;
+        }
+
+        # If there's only 2 matches, we now know neither is current
+        # so just pick one.  This is ok because the next call would
+        # "toggle" to the other.  More than 2, though, and we'd end up
+        # ignoring windows
+        if ( @matches == 2 ) {
+            $matches[0]->{window}->set_active;
+            return;
+        }
+
+        # Otherwise, fall through to normal prompt
+        $suggestion = $matches[0];
+    }
+
+    while (1) {
+        # display the current input and suggestion
+        _draw_suggestion( $buf, $suggestion );
+
+        # read input one character at a time
+        my $chr = getc;
+
+        # break out on Enter
+        if ( $chr =~ /[\r\n]/ ) {
+            $window = $suggestion;
+            last;
+        }
+
+        # Esc means "stop trying"
+        elsif ( ord($chr) == 27 ) {
+            last;
+        }
+
+        # Tab to cycle through suggestions
+        elsif ( ord($chr) == 9 ) {
+            if(@matches) {
+                # get matches if we don't have any yet
+                push @matches, grep { $_ } shift @matches;
+            } else {
+                # otherwise switch to the next one
+                @matches = _match( $buf, @all_windows );
+            }
+
+            $suggestion = $matches[0];
+        }
+
+        # ^U means wipe out the input.  we might want to actually read this
+        # from the user's keybinding (for erase_line or maybe erase_to_beg_of_line)
+        # instead of assuming ^U
+        elsif ( ord($chr) == 21 ) {
+            $buf = '';
+            @matches = _match( $buf, @all_windows );
+            $suggestion = undef;
+        }
+
+        # handle backspace and delete
+        elsif ( ord($chr) == 127 or ord($chr) == 8 ) {
+            # remove the last char
+            $buf = substr( $buf, 0, length($buf) - 1 );
+
+            # get suggestions again
+            if ( @matches = _match( $buf, @all_windows ) ) {
+                $suggestion = $buf ? $matches[0] : undef;
+            } else {
+                $suggestion = undef;
+            }
+        }
+
+        # regular input
+        else {
+            # create a temporary new buffer
+            my $tmp = $buf . $chr;
+
+            if ( @matches = _match($tmp, @all_windows) ) {
+                # if the new character results in a match, keep it
+                $buf = $tmp;
+                $suggestion = $buf ? $matches[0] : undef;
+            } else {
+                # vbell on mistype
+                print STDOUT "\a";
+            }
+        }
+    }
+
+    # go to the selected window if there is one
+    if ($window) {
+        $window->{window}->set_active;
+    }
+
+    # refresh the screen to get the regular prompt back if needed
+    Irssi::command('redraw')
+}
+
+Irssi::command_bind('go', 'cmd_go2', 'go2.pl');
+
+sub _draw_suggestion {
+    my ( $b, $s ) = @_;
+
+    # $b might have a space and a second token which is a tag, remove it
+    # since that's getting displayed separately anyway
+    my $tag;
+    if ( $b =~ s/ (.*)// ) {
+        $tag = $1;
+    }
+
+    my $pre = '';
+    my $post = '';
+    if ($s) {
+        # No input, entire thing is a suggestion
+        if ( !$b ) {
+            $pre = '#' . $s->{window}->{refnum} . ' ';
+            $post = $s->{string};
+        }
+        # Matched window number
+        elsif ( $s->{match_obj} eq 'number' and $s->{string} =~ /\Q$b\E/i ) {
+            $pre = '#' . $`;
+            $post = $' . ' ' . ( $s->{window}->{active}->{name} || $s->{window}->{name} );
+        }
+        # Matched 'tag' (network or server)
+        elsif ( $s->{match_obj} eq 'tag' and $s->{string} =~ /\Q$b\E/i ) {
+            $pre = '#' . $s->{window}->{refnum} . ' ' .
+                ( $s->{window}->{active}->{name} || $s->{window}->{name} ) . " ($`";
+            $post = "$')";
+        }
+        # Matched window or item name
+        elsif ( $s->{string} =~ /\Q$b\E/i ) {
+            $pre = '#' . $s->{window}->{refnum} . ' ' . $`;
+            $post = $';
+        }
+
+        # special case 'tag'.  maybe this should be moved up into the case blocks
+        unless ( $s->{match_obj} eq 'tag' ) {
+            my $window_tag = $s->{window}->{active_server}->{tag};
+            if ( $window_tag ) {
+                if ( $tag ) {
+                    if ( $window_tag =~ /^\Q$tag\E/i ) {
+                        $post .= " ([/i]${tag}[i]$')"
+                    } else {
+                        print "BUG! Window had tag '$window_tag' and should have matched '$tag' but didn't!";
+                    }
+                } else {
+                    $post .= " ($window_tag)";
+                }
+            }
+        }
+    }
+
+    # ANSI escapes
+    my $inv    = "\x{1b}[7m";
+    my $no_inv = "\x{1b}[0m";
+
+    # Fix up inverse for pre and post text
+    if($pre) {
+        $pre = "[i]${pre}[/i]";
+        $pre =~ s/\[i\]/$inv/ig;
+        $pre =~ s/\[\/i\]/$no_inv/ig;
+    }
+    if($post) {
+        $post = "[i]${post}[/i]";
+        $post =~ s/\[i\]/$inv/ig;
+        $post =~ s/\[\/i\]/$no_inv/ig;
+    }
+
+    # FIXME - there has to be a "right way" to do this.
+    # it looks like the fe-text/gui-readline.c and gui-entry.c
+    # (and other gui-*) are not XS wrapped for whatever reason.
+    print STDOUT "\r" . ' 'x40 . "\rGoto: ";
+
+    print STDOUT $pre if $pre;   # before
+    print STDOUT $b;             # the matched string
+    print STDOUT $post if $post; # after
+}
+
+sub _match {
+    my ( $name, @wins ) = @_;
+    my @matches;
+
+    # $name might have a space and a second token which is a tag, remove it
+    # and try to match the window tag
+    my $tag;
+    if ( $name =~ s/ (.*)// ) {
+        $tag = $1;
+    }
+
+    my $awr = Irssi::active_win()->{refnum};
+    for (@wins) {
+        # Only add each window once, and prefer item, name, number, then tag
+        my @c;
+
+        # items
+        if (
+                length $_->{active}->{name}
+                and (
+                    (
+                        @c = $_->{active}->{name} =~ /(^(#)?)?\Q$name\E($)?/i
+                        and (
+                            # Match the network token if one was entered
+                            !$tag
+                            or (
+                                defined $_->{active_server}->{tag}
+                                and $_->{active_server}->{tag} =~ /^\Q$tag\E/i
+                            )
+                        )
+                    )
+                    # If we have an item name but no input, use the item name as the match string
+                    or !length($name)
+                )
+        ) {
+            push @matches, {
+                string        => $_->{active}->{name},
+                window        => $_,
+                match_obj     => 'item',
+                anchored      => ( defined $c[0] and !defined $c[1] ),
+                near_anchored => ( defined $c[0] and defined $c[1] ),
+                exact         => ( defined $c[0] and !defined $c[1] and defined $c[2] ),
+                active_win    => ( $awr == $_->{refnum} ),
+                # ignore non-chat activity
+                activity      => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ),
+            };
+            next;
+        }
+
+        # window names
+        if (
+                length $_->{name}
+                and (
+                    (
+                        @c = $_->{name} =~ /(^(#)?)?\Q$name\E($)?/i
+                        and (
+                            # Match the network token if one was entered
+                            !$tag
+                            or (
+                                defined $_->{active_server}->{tag}
+                                and $_->{active_server}->{tag} =~ /^\Q$tag\E/i
+                            )
+                        )
+                    )
+                    # If we have an window name but no input, use the window name as the match string
+                    or !length($name)
+                )
+        ) {
+            push @matches, {
+                string        => $_->{name},
+                window        => $_,
+                match_obj     => 'name',
+                anchored      => ( defined $c[0] and !defined $c[1] ),
+                # this is not really so useful for names, but it doesn't really hurt either
+                near_anchored => ( defined $c[0] and defined $c[1] ),
+                exact         => ( defined $c[0] and !defined $c[1] and defined $c[2] ),
+                active_win    => ( $awr == $_->{refnum} ),
+                # ignore non-chat activity
+                activity      => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ),
+            };
+            next;
+        }
+
+        # window numbers
+        if (
+                defined $_->{refnum}
+                and @c = $_->{refnum} =~ /(^)?\Q$name\E($)?/i
+                and (
+                    # Match the network token if one was entered
+                    !$tag
+                    or (
+                        defined $_->{active_server}->{tag}
+                        and $_->{active_server}->{tag} =~ /^\Q$tag\E/i
+                    )
+                )
+        ) {
+            push @matches, {
+                string     => $_->{refnum},
+                window     => $_,
+                match_obj  => 'number',
+                anchored   => defined $c[0],
+                exact      => ( defined $c[0] and defined $c[1] ),
+                active_win => ( $awr == $_->{refnum} ),
+                # ignore non-chat activity
+                activity   => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ),
+            };
+            next;
+        }
+
+        # network names
+        if (
+                defined $_->{active_server}->{tag}
+                and @c = $_->{active_server}->{tag} =~ /(^)?\Q$name\E($)?/i
+
+                # This doesn't seem to make a lot of sense but it makes for a
+                # weird user experience without it, particularly on tab
+                # cycling
+                and (
+                    !$tag
+                    or $_->{active_server}->{tag} =~ /^\Q$tag\E/i
+                )
+        ) {
+            # don't add by tag if we've already got
+            push @matches, {
+                string     => $_->{active_server}->{tag},
+                window     => $_,
+                match_obj  => 'tag',
+                anchored   => defined $c[0],
+                exact      => ( defined $c[0] and defined $c[1] ),
+                active_win => ( $awr == $_->{refnum} ),
+                # ignore non-chat activity
+                activity   => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ),
+            };
+            next;
+        }
+    }
+
+    # Try to sort intelligently.  Without input, order by window number.  Otherwise,
+    # put exact matches in front, then anchored matches, then alpha sort.  However,
+    # try not to suggest the currently selected window as the first choice.  In addition,
+    # we'll give preference to active windows.
+    #
+    # Here is a chart of the currently implemented sorting behavior:
+    #
+    #  * exact match (items, names, and numbers)
+    #    - activity level
+    #       - items, then names, then numbers
+    #
+    #  * anchored (items, names, and numbers)
+    #    - activity level
+    #       - items, then names, then numbers
+    #
+    #  * near-anchored (without leading #) (items and names)
+    #    - activity level
+    #       - items, then names
+    #
+    #  * exact for networks
+    #    - activity level
+    #
+    #  * anchored for networks
+    #    - activity level
+    #
+    #  * activity level
+    #
+    #  * alphabetical
+    #
+    @matches = sort {
+        my $which;
+        if ( !length($name) ) {
+            # no input, sort by number with preference to active windows
+            $which =
+                $b->{activity} <=> $a->{activity} ||
+                $a->{window}->{refnum} <=> $b->{window}->{refnum};
+        } else {
+            COMPARE: for my $objects ( [ 'item', 'name', 'number' ], [ 'tag' ] ) {
+                my $i;
+                my %object_rank = map { $_ => ++$i } @$objects;
+                for my $match ( 'exact', 'anchored', 'near_anchored' ) {
+
+                    # Make sure at least one is one of the desired match objects
+                    my $a_mo = grep { $_ eq $a->{match_obj} } @$objects;
+                    my $b_mo = grep { $_ eq $b->{match_obj} } @$objects;
+                    next unless $a_mo || $b_mo;
+
+                    # Make sure at least one is the current match type
+                    next unless $a->{$match} || $b->{$match};
+
+                    last COMPARE if $which =
+                        # if only one is a preferred match object
+                        $b_mo <=> $a_mo ||
+
+                        # if only one is the current match type
+                        $b->{$match} <=> $a->{$match} ||
+
+                        # Since both are the same level of match, bump up more active windows
+                        $b->{activity} <=> $a->{activity} ||
+
+                        # Same activity, order by object ranking (lower is better)
+                        $object_rank{$a->{match_obj}} <=> $object_rank{$b->{match_obj}};
+                }
+            }
+            # If we couldn't differentiate by now, bump current window to the bottom,
+            # sort by activity, and then alphabetically
+            $which =
+                $a->{active_win} <=> $b->{active_win} ||
+                $b->{activity} <=> $a->{activity} ||
+                $a->{string} cmp $b->{string}
+                unless $which;
+
+        }
+        $which;
+    } @matches;
+
+    return @matches;
+}
+
+sub _help {
+    print<<HELP;
+Go - jump directly to the correct destination
+
+Usage:
+    /go [destination]
+
+    The argument is optional, and if it is not provided or is ambiguous, you will be
+    sent to a prompt where you type in a few numbers or letters of the window name,
+    item (channel, nickname), window number, or connected network.  Once you have input
+    that matches one or more possible destinations, Go will print in inverse text what
+    it thinks you are looking for.  If there are multiple, the tab key will cycle through
+    them.  Press enter when you see the correct window to switch to it.
+
+    If you are using irssi 0.8.12 or better, you can tab complete from the input line
+    without having to press enter first.
+
+    If your destination has a second word (/go foo bar), then the second word (eg 'bar')
+    is assumed to be the network name, which is useful for disambiguation.  This works
+    both with input to /go and for text typed at the Goto: prompt.
+
+    You may find it useful to bind this action to a keystroke to expedite movement, which
+    will forego any argument and take you directly to the prompt:
+
+        /bind meta-w /go
+HELP
+}