tools/perl-5.8.0/lib/site_perl/5.8.0/Psh/Builtins/Bind.pm

package Psh::Builtins::Bind;

require Psh::Util;

=pod

=item * C<bind [-m keymap] [-lvd] [-q name]>

=item * C<bind [-m keymap] -f filename>

=item * C<bind [-m keymap] keyseq:function-name>


Display current readline key and function bindings,
or bind a key sequence to a readline function or
macro. The binding syntax accepted is identical to
that of .inputrc, but each binding must be passed
as a  separate  argument;  e.g.,  '"\C-x\C-r":
re-read-init-file'. Options, if supplied, have the
following meanings:

=over 8

=item -m keymap

Use keymap as the keymap to be affected by
the subsequent bindings. Acceptable keymap
names are emacs, emacs-standard, emacs-meta,
emacs-ctlx, vi, vi-move, vi-command, and vi-
insert. vi is equivalent to vi-command;
emacs is equivalent to emacs-standard.

=item -l

List the names of all readline functions

=item -v

List current function names and bindings

=item -d

Dump function names and bindings in such a
way that they can be re-read

=item -f filename

Read key bindings from filename

=item -q function

Query about which keys invoke the named

=back

=cut

#
# > TODO: How can we print out the current bindings in an
# > ReadLine-implementation-independent way? We should allow rebinding
# > of keys if Readline interface allows it, etc.
#
# This implementation supports GNU fully.  It also kind of supports Perl.
# All others it will refuse to work with.
#
# > Info:
# > Bind a key: GNU: bind_key Perl: bind
#
# I implemented GNU using parse_and_bind as it gives a result more
# consistant with what bash does.
#
# > Other interesting stuff
# > Perl: set(EditingMode) - vi or emacs keybindings
#
# I impelemented this as a "keymap".  (I notice that internally this
# is what the EditingMode's are refered to as anyway.)
#
# > Perl: set(TcshCompleteMode) - tcsh menu completion mode
# > GNU: lots and lots...
#

sub bi_bind {
    my $status = 0;
    if (defined($Psh::term) and $Psh::term->can('add_defun')) {
        my $args = pop;
        while (my $command = shift(@$args)) {
            if ($command eq '-l') {
                for my $function (sort($Psh::term->get_all_function_names)) {
                    Psh::Util::print_out("$function\n");
                }
            } elsif ($command eq '-m') { # Set keymap
                my $keymap_name = shift(@$args);
                my $map = $Psh::term->get_keymap_by_name($keymap_name);
                if (defined($map)) {
                    $Psh::term->set_keymap($map);
                } else {
                    Psh::Util::print_out(qq{bind: `$keymap_name': illegal keymap name\n});
                    $status = 1;
                }
            } elsif ($command eq '-v') { # Show values
                for my $function (sort($Psh::term->get_all_function_names)) {
                    Psh::Util::print_out("$function ");
                    my(@keys) = $Psh::term->invoking_keyseqs($function);
                    if (@keys) {
                        Psh::Util::print_out(qq{can be found on "},join('", "',@keys),qq{".\n});
                    } else {
                        Psh::Util::print_out("is not bound to any keys\n");
                    }
                }
            } elsif ($command eq '-d') { # Dump values
                for my $function (sort($Psh::term->get_all_function_names)) {
                    my(@keys) = $Psh::term->invoking_keyseqs($function);
                    if (@keys) {
                        foreach (@keys) {
                            Psh::Util::print_out(qq{"$_": $function\n});
                        }
                    } else {
                        Psh::Util::print_out("# $function (not bound)\n");
                    }
                }
            } elsif ($command eq '-f') { # Read file
                my $file = shift(@$args);
                $Psh::term->read_init_file($file);
                if ($!) {
                    Psh::Util::print_out("bind: cannot read $file: $!\n");
                    $status = 1;
                }
            } elsif ($command eq '-q') { # Query a single function
                my $function = shift(@$args);
                Psh::Util::print_out("$function ");
                my(@keys) = $Psh::term->invoking_keyseqs($function);
                if (@keys) {
                    Psh::Util::print_out(qq{can be found on "},join('", "',@keys),qq{".\n});
                } else {
                    Psh::Util::print_out("is not bound to any keys\n");
                }
            } elsif ($command =~ /:/) {
                unless ($command =~ /:./) {
                    # This let's the user do things like this:
                    #  bind "\en": history-search-forward "\ep": history-search backward
                    $command .= shift(@$args);
                }
                ### This is to make my bash-happy bind statements work.
                ### This is undoubtably dumb.  If someone could tell me
                ### how to make readline work with M- as meta, I'd be
                ### enternally grateful.
                $command =~ s/^M-(.)/"\\e$1"/g;
                ###
                $Psh::term->parse_and_bind($command);
            } else {
                # print help (unknown option)
                Psh::Util::print_out("bind: illegal option: $command\n");
                Psh::Util::print_out("usage: bind [-lvd] [-m keymap] [-f filename] [-q name] [keyseq:readline_func]\n");
                $status = 1;
                last;
            }
        }
    } elsif (defined($Psh::term) and $Psh::term->can('bind')) {
        # Term::ReadLine::Perl
        my $args = pop;
        while (my $command = shift(@$args)) {
            if ($command eq '-l') {
                Psh::Util::print_out("bind: -l option currently not supported by ".ref($Psh::term)."\n");
                $status = 1;
                last;
            } elsif ($command eq '-m') { # Set keymap
                my $keymap_name = shift(@$args);
                my $map = ($keymap_name =~ /^(emacs|vi)$/i)?$1:undef;
                if (defined($map)) {
                    $Psh::term->set('EditingMode',$map);
                } else {
                    Psh::Util::print_out(qq{bind: `$keymap_name': illegal keymap name\n});
                    $status = 1;
                }
            } elsif ($command eq '-v') { # Show values
                Psh::Util::print_out("bind: -v option currently not supported by ".ref($Psh::term)."\n");
                $status = 1;
                last;
            } elsif ($command eq '-d') { # Dump values
                Psh::Util::print_out("bind: -d option currently not supported by ".ref($Psh::term)."\n");
                $status = 1;
                last;
            } elsif ($command eq '-f') { # Read file
                Psh::Util::print_out("bind: -f option currently not supported by ".ref($Psh::term)."\n");
                $status = 1;
                last;
            } elsif ($command eq '-q') { # Query a single function
                Psh::Util::print_out("bind: -q option currently not supported by ".ref($Psh::term)."\n");
                $status = 1;
                last;
            } elsif ($command =~ /:/) {
                unless ($command =~ /:./) {
                    # This let's the user do things like this:
                    #  bind "\en": history-search-forward "\ep": history-search backward
                    $command .= shift(@$args);
                }
                my($keys,$function) = split(/\s*:\s*/,$command,2);
                $keys =~ s/^"(.*)"$/$1/ or
                $keys =~ s/^'(.*)'$/$1/;
                $Psh::term->bind($keys,$function);
            } else {
                # print help (unknown option)
                Psh::Util::print_out("bind: illegal option: $command\n");
                Psh::Util::print_out("usage: bind [-lvd] [-m keymap] [-f filename] [-q name] [keyseq:readline_func]\n");
                $status = 1;
                last;
            }
        }
    } elsif (defined($Psh::term) and ref($Psh::term)) {
        Psh::Util::print_out("bind requires a more capable readline than ".ref($Psh::term)."\n");
        $status = 1;
    } else {
        Psh::Util::print_out("bind: No effect in non-interactive terminal\n");
        $status = 1;
    }
    return ($status,undef);
}

1;