# -*- Perl -*-
=pod

=head1 NAME

Term::ReadLine::Perl5::readline

=head1 DESCRIPTION

Wraps what was initially Perl4 into a Perl5 module. It is ugly, but at
least its a start.

=cut
use warnings;
package Term::ReadLine::Perl5::readline;

$VERSION = '1.20';

#
# Separation into my and vars needs more work.
# use strict 'vars';
#
use vars qw(@KeyMap %KeyMap $rl_screen_width $rl_start_default_at_beginning
          $rl_completion_function $rl_basic_word_break_characters
          $rl_completer_word_break_characters $rl_special_prefixes
          $rl_max_numeric_arg $rl_OperateCount
          $KillBuffer $dumb_term $stdin_not_tty $InsertMode
          $mode $winsz $force_redraw
          $minlength $rl_readline_name
          $rl_NoInitFromFile);

@ISA = qw(Exporter);
@EXPORT  = qw($minlength);


use Term::ReadLine;  # For Term::ReadLine::TermCap::ornaments
use File::HomeDir;
use File::Spec;
use Term::ReadKey;

use Term::ReadLine::Perl5::History;

my $autoload_broken = 1;        # currently: defined does not work with a-l
my $useioctl = 1;
my $usestty = 1;
my $max_include_depth = 10;     # follow $include's in init files this deep


my $HOME = File::HomeDir->my_home;

BEGIN {                 # Some old systems have ioctl "unsupported"
  *ioctl = sub ($$$) { eval { CORE::ioctl $_[0], $_[1], $_[2] } };
}

$rl_getc = \&rl_getc;
$minlength = 1;

&preinit;
&init;

#
# my ($InputLocMsg, $term_OUT, $term_IN);
# my ($winsz_t, $TIOCGWINSZ, $winsz, $rl_margin);
# my ($hook, %var_HorizontalScrollMode, %var_EditingMode, %var_OutputMeta);
# my ($var_HorizontalScrollMode, $var_EditingMode, $var_OutputMeta);
# my (%var_ConvertMeta, $var_ConvertMeta, %var_MarkModifiedLines, $var_MarkModifiedLines);
my $inDOS;
# my (%var_PreferVisibleBell, $var_PreferVisibleBell);
# my (%var_TcshCompleteMode, $var_TcshCompleteMode);
# my (%var_CompleteAddsuffix, $var_CompleteAddsuffix);
# my (@winchhooks);
# my ($BRKINT, $ECHO, $FIONREAD, $ICANON, $ICRNL, $IGNBRK, $IGNCR, $INLCR,
#     $ISIG, $ISTRIP, $NCCS, $OPOST, $RAW, $TCGETS, $TCOON, $TCSETS, $TCXONC,
#     $TERMIOS_CFLAG, $TERMIOS_IFLAG, $TERMIOS_LFLAG, $TERMIOS_NORMAL_IOFF,
#     $TERMIOS_NORMAL_ION, $TERMIOS_NORMAL_LOFF, $TERMIOS_NORMAL_LON,
#     $TERMIOS_NORMAL_OOFF, $TERMIOS_NORMAL_OON, $TERMIOS_OFLAG,
#     $TERMIOS_READLINE_IOFF, $TERMIOS_READLINE_ION, $TERMIOS_READLINE_LOFF,
#     $TERMIOS_READLINE_LON, $TERMIOS_READLINE_OOFF, $TERMIOS_READLINE_OON,
#     $TERMIOS_VMIN, $TERMIOS_VTIME, $TIOCGETP, $TIOCGWINSZ, $TIOCSETP,
#     $fion, $fionread_t, $mode, $sgttyb_t,
#     $termios, $termios_t, $winsz, $winsz_t);
# my ($line, $initialized);
#
# Global variables added for vi mode (I'm leaving them all commented
# out, like the declarations above, until SelfLoader issues
#     are resolved).

# True when we're in one of the vi modes.
my $Vi_mode;

# Array refs: saves keystrokes for '.' command.  Undefined when we're
#     not doing a '.'-able command.
my $Dot_buf;                # Working buffer
my $Last_vi_command;        # Gets $Dot_buf when a command is parsed

# These hold state for vi 'u' and 'U'.
my($Dot_state, $Vi_undo_state, $Vi_undo_all_state);

# Refs to hashes used for cursor movement
my($Vi_delete_patterns, $Vi_move_patterns,
   $Vi_change_patterns, $Vi_yank_patterns);

# Array ref: holds parameters from the last [fFtT] command, for ';'
#     and ','.
my $Last_findchar;

# Globals for history search commands (/, ?, n, N)
my $Vi_search_re;       # Regular expression (compiled by qr{})
my $Vi_search_reverse;  # True for '?' search, false for '/'

=head1 SUBROUTINES
=cut

sub get_window_size
{
    my $sig = shift;
    local($., $@, $!, $^E, $?);         # Preserve $! etc; the rest for hooks
    my ($num_cols,$num_rows);

    ($num_cols,$num_rows) =  Term::ReadKey::GetTerminalSize($term_OUT);
    $rl_screen_width = $num_cols - $rl_correct_sw
	if defined($num_cols) && $num_cols;
    $rl_margin = int($rl_screen_width/3);
    if (defined $sig) {
        $force_redraw = 1;
        &redisplay();
    }

    for my $hook (@winchhooks) {
      eval {&$hook()}; warn $@ if $@ and $^W;
    }
    local $^W = 0;              # WINCH may be illegal...
    $SIG{'WINCH'} = "readline::get_window_size";
}

# Fix: case-sensitivity of inputrc on/off keywords in
#      `set' commands. readline lib doesn't care about case.
# changed case of keys 'On' and 'Off' to 'on' and 'off'
# &rl_set changed so that it converts the value to
# lower case before hash lookup.
sub preinit
{
    ## Set up the input and output handles

    $term_IN = \*STDIN unless defined $term_IN;
    $term_OUT = \*STDOUT unless defined $term_OUT;
    ## not yet supported... always on.
    $var_HorizontalScrollMode = 1;
    $var_HorizontalScrollMode{'On'} = 1;
    $var_HorizontalScrollMode{'Off'} = 0;

    $var_EditingMode{'emacs'}    = *emacs_keymap;
    $var_EditingMode{'vi'}       = *vi_keymap;
    $var_EditingMode{'vicmd'}    = *vicmd_keymap;
    $var_EditingMode{'vipos'}    = *vipos_keymap;
    $var_EditingMode{'visearch'} = *visearch_keymap;

    ## this is an addition. Very nice.
    $var_TcshCompleteMode = 0;
    $var_TcshCompleteMode{'On'} = 1;
    $var_TcshCompleteMode{'Off'} = 0;

    $var_CompleteAddsuffix = 1;
    $var_CompleteAddsuffix{'On'} = 1;
    $var_CompleteAddsuffix{'Off'} = 0;

    $var_DeleteSelection = $var_DeleteSelection{'On'} = 1;
    $var_DeleteSelection{'Off'} = 0;
    *rl_delete_selection = \$var_DeleteSelection; # Alias

    ## not yet supported... always on
    for ('InputMeta', 'OutputMeta') {
        ${"var_$_"} = 1;
        ${"var_$_"}{'Off'} = 0;
        ${"var_$_"}{'On'} = 1;
    }

    ## not yet supported... always off
    for ('ConvertMeta', 'MetaFlag', 'MarkModifiedLines', 'PreferVisibleBell',
         'BlinkMatchingParen', 'VisibleStats', 'ShowAllIfAmbiguous',
         'PrintCompletionsHorizontally', 'MarkDirectories', 'ExpandTilde',
         'EnableKeypad', 'DisableCompletion', 'CompletionIgnoreCase') {
        ${"var_$_"} = 0;
        ${"var_$_"}{'Off'} = 0;
        ${"var_$_"}{'On'} = 1;
    }

    # WINCH hooks
    @winchhooks = ();

    $inDOS = $^O eq 'os2' || defined $ENV{OS2_SHELL} unless defined $inDOS;
    eval {require "ioctl.pl"}; ## try to get, don't die if not found.
    eval {require "sgtty.ph"}; ## try to get, don't die if not found.
    if ($inDOS and !defined $TIOCGWINSZ) {
	$TIOCGWINSZ=0;
	$TIOCGETP=1;
	$TIOCSETP=2;
	$sgttyb_t="I5 C8";
	$winsz_t="";
	$RAW=0xf002;
	$ECHO=0x0008;
    }
    $TIOCGETP = &TIOCGETP if defined(&TIOCGETP);
    $TIOCSETP = &TIOCSETP if defined(&TIOCSETP);
    $TIOCGWINSZ = &TIOCGWINSZ if defined(&TIOCGWINSZ);
    $FIONREAD = &FIONREAD if defined(&FIONREAD);
    $TCGETS = &TCGETS if defined(&TCGETS);
    $TCSETS = &TCSETS if defined(&TCSETS);
    $TCXONC = &TCXONC if defined(&TCXONC);
    $TIOCGETP   = 0x40067408 if !defined($TIOCGETP);
    $TIOCSETP   = 0x80067409 if !defined($TIOCSETP);
    $TIOCGWINSZ = 0x40087468 if !defined($TIOCGWINSZ);
    $FIONREAD   = 0x4004667f if !defined($FIONREAD);
    $TCGETS     = 0x40245408 if !defined($TCGETS);
    $TCSETS     = 0x80245409 if !defined($TCSETS);
    $TCXONC     = 0x20005406 if !defined($TCXONC);

    ## TTY modes
    $ECHO = &ECHO if defined(&ECHO);
    $RAW = &RAW if defined(&RAW);
    $RAW      = 040 if !defined($RAW);
    $ECHO     = 010 if !defined($ECHO);
    $mode = $RAW; ## could choose CBREAK for testing....

    $IGNBRK     = 1 if !defined($IGNBRK);
    $BRKINT     = 2 if !defined($BRKINT);
    $ISTRIP     = 040 if !defined($ISTRIP);
    $INLCR      = 0100 if !defined($INLCR);
    $IGNCR      = 0200 if !defined($IGNCR);
    $ICRNL      = 0400 if !defined($ICRNL);
    $OPOST      = 1 if !defined($OPOST);
    $ISIG       = 1 if !defined($ISIG);
    $ICANON     = 2 if !defined($ICANON);
    $TCOON      = 1 if !defined($TCOON);
    $TERMIOS_READLINE_ION = $BRKINT;
    $TERMIOS_READLINE_IOFF = $IGNBRK | $ISTRIP | $INLCR | $IGNCR | $ICRNL;
    $TERMIOS_READLINE_OON = 0;
    $TERMIOS_READLINE_OOFF = $OPOST;
    $TERMIOS_READLINE_LON = 0;
    $TERMIOS_READLINE_LOFF = $ISIG | $ICANON | $ECHO;
    $TERMIOS_NORMAL_ION = $BRKINT;
    $TERMIOS_NORMAL_IOFF = $IGNBRK;
    $TERMIOS_NORMAL_OON = $OPOST;
    $TERMIOS_NORMAL_OOFF = 0;
    $TERMIOS_NORMAL_LON = $ISIG | $ICANON | $ECHO;
    $TERMIOS_NORMAL_LOFF = 0;

    $sgttyb_t   = 'C4 S' if !defined($sgttyb_t);
    $winsz_t = "S S S S" if !defined($winsz_t);
    # rows,cols, xpixel, ypixel
    $winsz = pack($winsz_t,0,0,0,0);
    $NCCS = 17;
    $termios_t = "LLLLc" . ("c" x $NCCS);  # true for SunOS 4.1.3, at least...
    $termios = ''; ## just to shut up "perl -w".
    $termios = pack($termios, 0);  # who cares, just make it long enough
    $TERMIOS_IFLAG = 0;
    $TERMIOS_OFLAG = 1;
    ## $TERMIOS_CFLAG = 2;
    $TERMIOS_LFLAG = 3;
    $TERMIOS_VMIN = 5 + 4;
    $TERMIOS_VTIME = 5 + 5;
    $rl_delete_selection = 1;
    $rl_correct_sw = ($inDOS ? 1 : 0);
    $rl_scroll_nextline = 1 unless defined $rl_scroll_nextline;
    $rl_last_pos_can_backspace = ($inDOS ? 0 : 1) # Can backspace when the
      unless defined $rl_last_pos_can_backspace;  # whole line is filled?

    $rl_start_default_at_beginning = 0;
    $rl_vi_replace_default_on_insert = 0;
    $rl_screen_width = 79; ## default

    $rl_completion_function = "rl_filename_list"
        unless defined($rl_completion_function);
    $rl_basic_word_break_characters = "\\\t\n' \"`\@\$><=;|&{(";
    $rl_completer_word_break_characters = $rl_basic_word_break_characters;
    $rl_special_prefixes = '';
    ($rl_readline_name = $0) =~ s#.*[/\\]## if !defined($rl_readline_name);

    $rl_max_numeric_arg = 200 if !defined($rl_max_numeric_arg);
    $rl_OperateCount = 0 if !defined($rl_OperateCount);

    $rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
    @$rl_term_set or $rl_term_set = ["","","",""];

    $InsertMode=1;
    $KillBuffer='';
    $line='';
    $D = 0;
    $InputLocMsg = ' [initialization]';

    &InitKeymap(*emacs_keymap, 'SelfInsert', 'emacs_keymap',
                ($inDOS ? () : ('C-@',  'SetMark') ),
                'C-a',  'BeginningOfLine',
                'C-b',  'BackwardChar',
                'C-c',  'Interrupt',
                'C-d',  'DeleteChar',
                'C-e',  'EndOfLine',
                'C-f',  'ForwardChar',
                'C-g',  'Abort',
                'M-C-g',        'Abort',
                'C-h',  'BackwardDeleteChar',
                "TAB" , 'Complete',
                "C-j" , 'AcceptLine',
                'C-k',  'KillLine',
                'C-l',  'ClearScreen',
                "C-m" , 'AcceptLine',
                'C-n',  'NextHistory',
                'C-o',  'OperateAndGetNext',
                'C-p',  'PreviousHistory',
                'C-q',  'QuotedInsert',
                'C-r',  'ReverseSearchHistory',
                'C-s',  'ForwardSearchHistory',
                'C-t',  'TransposeChars',
                'C-u',  'UnixLineDiscard',
                ##'C-v',        'QuotedInsert',
                'C-v',  'HistorySearchForward',
                'C-w',  'UnixWordRubout',
                qq/"\cX\cX"/,   'ExchangePointAndMark',
                qq/"\cX\cR"/,   'ReReadInitFile',
                qq/"\cX?"/,     'PossibleCompletions',
                qq/"\cX*"/,     'InsertPossibleCompletions',
                qq/"\cX\cU"/,   'Undo',
                qq/"\cXu"/,     'Undo',
                qq/"\cX\cW"/,   'KillRegion',
                qq/"\cXw"/,     'CopyRegionAsKill',
                qq/"\cX\ec\\*"/,        'DoControlVersion',
                qq/"\cX\ec\0"/, 'SetMark',
                qq/"\cX\ec\@"/, 'SetMark',
                qq/"\cX\ec "/,  'SetMark',
                qq/"\cX\em\\*"/,        'DoMetaVersion',
                qq/"\cX\@c\\*"/,        'DoControlVersion',
                qq/"\cX\@c\0"/, 'SetMark',
                qq/"\cX\@c\@"/, 'SetMark',
                qq/"\cX\@c "/,  'SetMark',
                qq/"\cX\@m\\*"/,        'DoMetaVersion',
                'C-y',  'Yank',
                'C-z',  'Suspend',
                'C-\\', 'Ding',
                'C-^',  'Ding',
                'C-_',  'Undo',
                'DEL',  ($inDOS ?
                         'BackwardKillWord' : # <Control>+<Backspace>
                         'BackwardDeleteChar'
                        ),
                'M-<',  'BeginningOfHistory',
                'M->',  'EndOfHistory',
                'M-DEL',        'BackwardKillWord',
                'M-C-h',        'BackwardKillWord',
                'M-C-j',        'ViInput',
                'M-C-v',        'QuotedInsert',
                'M-b',  'BackwardWord',
                'M-c',  'CapitalizeWord',
                'M-d',  'KillWord',
                'M-f',  'ForwardWord',
                'M-h',  'PrintHistory',
                'M-l',  'DownCaseWord',
                'M-r',  'RevertLine',
                'M-t',  'TransposeWords',
                'M-u',  'UpcaseWord',
                'M-v',  'HistorySearchBackward',
                'M-y',  'YankPop',
                "M-?",  'PossibleCompletions',
                "M-TAB",        'TabInsert',
                'M-#',  'SaveLine',
                qq/"\e[A"/,  'previous-history',
                qq/"\e[B"/,  'next-history',
                qq/"\e[C"/,  'forward-char',
                qq/"\e[D"/,  'backward-char',
                qq/"\eOA"/,  'previous-history',
                qq/"\eOB"/,  'next-history',
                qq/"\eOC"/,  'forward-char',
                qq/"\eOD"/,  'backward-char',
                qq/"\eOy"/,  'HistorySearchBackward',   # vt: PageUp
                qq/"\eOs"/,  'HistorySearchForward',    # vt: PageDown
                qq/"\e[[A"/,  'previous-history',
                qq/"\e[[B"/,  'next-history',
                qq/"\e[[C"/,  'forward-char',
                qq/"\e[[D"/,  'backward-char',
                qq/"\e[2~"/,   'ToggleInsertMode', # X: <Insert>
                # Mods: 1 + bitmask: 1 Shift, 2 Alt, 4 Control, 8 (sometimes) Meta
                qq/"\e[2;2~"/,  'YankClipboard',    # <Shift>+<Insert>
                qq/"\e[3;2~"/,  'KillRegionClipboard',    # <Shift>+<Delete>
                #qq/"\0\16"/, 'Undo', # <Alt>+<Backspace>
                qq/"\eO5D"/, 'BackwardWord', # <Ctrl>+<Left arrow>
                qq/"\eO5C"/, 'ForwardWord', # <Ctrl>+<Right arrow>
                qq/"\e[5D"/, 'BackwardWord', # <Ctrl>+<Left arrow>
                qq/"\e[5C"/, 'ForwardWord', # <Ctrl>+<Right arrow>
                qq/"\eO5F"/, 'KillLine', # <Ctrl>+<End>
                qq/"\e[5F"/, 'KillLine', # <Ctrl>+<End>
                qq/"\e[4;5~"/, 'KillLine', # <Ctrl>+<End>
                qq/"\eO5s"/, 'EndOfHistory', # <Ctrl>+<Page Down>
                qq/"\e[6;5~"/, 'EndOfHistory', # <Ctrl>+<Page Down>
                qq/"\e[5H"/, 'BackwardKillLine', # <Ctrl>+<Home>
                qq/"\eO5H"/, 'BackwardKillLine', # <Ctrl>+<Home>
                qq/"\e[1;5~"/, 'BackwardKillLine', # <Ctrl>+<Home>
                qq/"\eO5y"/, 'BeginningOfHistory', # <Ctrl>+<Page Up>
                qq/"\e[5;5y"/, 'BeginningOfHistory', # <Ctrl>+<Page Up>
                qq/"\e[2;5~"/, 'CopyRegionAsKillClipboard', # <Ctrl>+<Insert>
                qq/"\e[3;5~"/, 'KillWord', # <Ctrl>+<Delete>

                # XTerm mouse editing (f202/f203 not in mainstream yet):
                # Paste may be:         move f200 STRING f201
                # or               f202 move f200 STRING f201 f203;
                # and Cut may be   f202 move delete f203
                qq/"\e[200~"/, 'BeginPasteGroup', # Pre-paste
                qq/"\e[201~"/, 'EndPasteGroup', # Post-paste
                qq/"\e[202~"/, 'BeginEditGroup', # Pre-edit
                qq/"\e[203~"/, 'EndEditGroup', # Post-edit

                # OSX xterm:
                # OSX xterm: home \eOH end \eOF delete \e[3~ help \e[28~ f13 \e[25~
                # gray- \eOm gray+ \eOk gray-enter \eOM gray* \eOj gray/ \eOo gray= \eO
                # grayClear \e\e.

                qq/"\eOH"/,   'BeginningOfLine',        # home
                qq/"\eOF"/,   'EndOfLine',              # end

                # HP xterm
                #qq/"\e[A"/,   'PreviousHistory',       # up    arrow
                #qq/"\e[B"/,   'NextHistory',           # down  arrow
                #qq/"\e[C"/,   'ForwardChar',           # right arrow
                #qq/"\e[D"/,   'BackwardChar',          # left  arrow
                qq/"\e[H"/,   'BeginningOfLine',        # home
                #'C-k',        'KillLine',              # clear display
                qq/"\e[5~"/,  'HistorySearchBackward',  # prev
                qq/"\e[6~"/,  'HistorySearchForward',   # next
                qq/"\e[\0"/,  'BeginningOfLine',        # home

                # These contradict:
                ($^O =~ /^hp\W?ux/i ? (
                  qq/"\e[1~"/,  'HistorySearchForward',   # find
                  qq/"\e[3~"/,  'ToggleInsertMode',     # insert char
                  qq/"\e[4~"/,  'ToggleInsertMode',     # select
                 ) : (          # "Normal" xterm
                  qq/"\e[1~"/,  'BeginningOfLine',      # home
                  qq/"\e[3~"/,  'DeleteChar',           # delete
                  qq/"\e[4~"/,  'EndOfLine',    # end
                )),

                # hpterm

                (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
                 (
                  qq/"\eA"/,    'PreviousHistory',     # up    arrow
                  qq/"\eB"/,    'NextHistory',         # down  arrow
                  qq/"\eC"/,    'ForwardChar',         # right arrow
                  qq/"\eD"/,    'BackwardChar',        # left  arrow
                  qq/"\eS"/,    'BeginningOfHistory',  # shift up    arrow
                  qq/"\eT"/,    'EndOfHistory',        # shift down  arrow
                  qq/"\e&r1R"/, 'EndOfLine',           # shift right arrow
                  qq/"\e&r1L"/, 'BeginningOfLine',     # shift left  arrow
                  qq/"\eJ"/,    'ClearScreen',         # clear display
                  qq/"\eM"/,    'UnixLineDiscard',     # delete line
                  qq/"\eK"/,    'KillLine',            # clear  line
                  qq/"\eG\eK"/, 'BackwardKillLine',    # shift clear line
                  qq/"\eP"/,    'DeleteChar',          # delete char
                  qq/"\eL"/,    'Yank',                # insert line
                  qq/"\eQ"/,    'ToggleInsertMode',    # insert char
                  qq/"\eV"/,    'HistorySearchBackward',# prev
                  qq/"\eU"/,    'HistorySearchForward',# next
                  qq/"\eh"/,    'BeginningOfLine',     # home
                  qq/"\eF"/,    'EndOfLine',           # shift home
                  qq/"\ei"/,    'Suspend',             # shift tab
                 ) :
                 ()
                ),
                ($inDOS ?
                 (
                  qq/"\0\2"/,  'SetMark', # 2: <Control>+<Space>
                  qq/"\0\3"/,  'SetMark', # 3: <Control>+<@>
                  qq/"\0\4"/,  'YankClipboard',    # 4: <Shift>+<Insert>
                  qq/"\0\5"/,  'KillRegionClipboard',    # 5: <Shift>+<Delete>
                  qq/"\0\16"/, 'Undo', # 14: <Alt>+<Backspace>
                  qq/"\0\65"/,  'PossibleCompletions', # 53: <Alt>+</>
                  qq/"\0\107"/, 'BeginningOfLine', # 71: <Home>
                  qq/"\0\110"/, 'previous-history', # 72: <Up arrow>
                  qq/"\0\111"/, 'HistorySearchBackward', # 73: <Page Up>
                  qq/"\0\113"/, 'backward-char', # 75: <Left arrow>
                  qq/"\0\115"/, 'forward-char', # 77: <Right arrow>
                  qq/"\0\117"/, 'EndOfLine', # 79: <End>
                  qq/"\0\120"/, 'next-history', # 80: <Down arrow>
                  qq/"\0\121"/, 'HistorySearchForward', # 81: <Page Down>
                  qq/"\0\122"/, 'ToggleInsertMode', # 82: <Insert>
                  qq/"\0\123"/, 'DeleteChar', # 83: <Delete>
                  qq/"\0\163"/, 'BackwardWord', # 115: <Ctrl>+<Left arrow>
                  qq/"\0\164"/, 'ForwardWord', # 116: <Ctrl>+<Right arrow>
                  qq/"\0\165"/, 'KillLine', # 117: <Ctrl>+<End>
                  qq/"\0\166"/, 'EndOfHistory', # 118: <Ctrl>+<Page Down>
                  qq/"\0\167"/, 'BackwardKillLine', # 119: <Ctrl>+<Home>
                  qq/"\0\204"/, 'BeginningOfHistory', # 132: <Ctrl>+<Page Up>
                  qq/"\0\x92"/, 'CopyRegionAsKillClipboard', # 146: <Ctrl>+<Insert>
                  qq/"\0\223"/, 'KillWord', # 147: <Ctrl>+<Delete>
                  qq/"\0#"/, 'PrintHistory', # Alt-H
                 )
                 : ( 'C-@',     'Ding')
                )
               );

    *KeyMap = *emacs_keymap;
    my @add_bindings = ();
    foreach ('-', '0' .. '9') { push(@add_bindings, "M-$_", 'DigitArgument'); }
    foreach ("A" .. "Z") {
      next if  # defined($KeyMap[27]) && defined (%{"$KeyMap{name}_27"}) &&
        defined $ {"$KeyMap{name}_27"}[ord $_];
      push(@add_bindings, "M-$_", 'DoLowercaseVersion');
    }
    if ($inDOS) {
        # Default translation of Alt-char
        $ {"$KeyMap{name}_0"}{'Esc'} = *{"$KeyMap{name}_27"};
        $ {"$KeyMap{name}_0"}{'default'} = 'F_DoEscVersion';
    }
    &rl_bind(@add_bindings);

    # Vi input mode.
    &InitKeymap(*vi_keymap, 'SelfInsert', 'vi_keymap',

                "\e",   'ViEndInsert',
                'C-c',  'Interrupt',
                'C-h',  'BackwardDeleteChar',
                'C-w',  'UnixWordRubout',
                'C-u',  'UnixLineDiscard',
                'C-v',  'QuotedInsert',
                'DEL',  'BackwardDeleteChar',
                "\n",   'ViAcceptInsert',
                "\r",   'ViAcceptInsert',
               );

    # Vi command mode.
    &InitKeymap(*vicmd_keymap, 'Ding', 'vicmd_keymap',

                'C-c',  'Interrupt',
                'C-e',  'EmacsEditingMode',
                'C-h',  'ViMoveCursor',
                'C-l',  'ClearScreen',
                "\n",   'ViAcceptLine',
                "\r",   'ViAcceptLine',

                ' ',    'ViMoveCursor',
                '#',    'SaveLine',
                '$',    'ViMoveCursor',
                '%',    'ViMoveCursor',
                '*',    'ViInsertPossibleCompletions',
                '+',    'NextHistory',
                ',',    'ViMoveCursor',
                '-',    'PreviousHistory',
                '.',    'ViRepeatLastCommand',
                '/',    'ViSearch',

                '0',    'ViMoveCursor',
                '1',    'ViDigit',
                '2',    'ViDigit',
                '3',    'ViDigit',
                '4',    'ViDigit',
                '5',    'ViDigit',
                '6',    'ViDigit',
                '7',    'ViDigit',
                '8',    'ViDigit',
                '9',    'ViDigit',

                ';',    'ViMoveCursor',
                '=',    'ViPossibleCompletions',
                '?',    'ViSearch',

                'A',    'ViAppendLine',
                'B',    'ViMoveCursor',
                'C',    'ViChangeLine',
                'D',    'ViDeleteLine',
                'E',    'ViMoveCursor',
                'F',    'ViMoveCursor',
                'G',    'ViHistoryLine',
                'H',    'PrintHistory',
                'I',    'ViBeginInput',
                'N',    'ViRepeatSearch',
                'P',    'ViPutBefore',
                'R',    'ViReplaceMode',
                'S',    'ViChangeEntireLine',
                'T',    'ViMoveCursor',
                'U',    'ViUndoAll',
                'W',    'ViMoveCursor',
                'X',    'ViBackwardDeleteChar',
                'Y',    'ViYankLine',

                '\\',   'ViComplete',
                '^',    'ViMoveCursor',

                'a',    'ViAppend',
                'b',    'ViMoveCursor',
                'c',    'ViChange',
                'd',    'ViDelete',
                'e',    'ViMoveCursor',
                'f',    'ViMoveCursorFind',
                'h',    'ViMoveCursor',
                'i',    'ViInput',
                'j',    'NextHistory',
                'k',    'PreviousHistory',
                'l',    'ViMoveCursor',
                'n',    'ViRepeatSearch',
                'p',    'ViPut',
                'r',    'ViReplaceChar',
                's',    'ViChangeChar',
                't',    'ViMoveCursorTo',
                'u',    'ViUndo',
                'w',    'ViMoveCursor',
                'x',    'ViDeleteChar',
                'y',    'ViYank',

                '|',    'ViMoveCursor',
                '~',    'ViToggleCase',

                (($inDOS
                  and (not $ENV{'TERM'} or $ENV{'TERM'} !~ /^(vt|xterm)/i)) ?
                 (
                  qq/"\0\110"/, 'PreviousHistory',   # 72: <Up arrow>
                  qq/"\0\120"/, 'NextHistory',       # 80: <Down arrow>
                  qq/"\0\113"/, 'BackwardChar',        # 75: <Left arrow>
                  qq/"\0\115"/, 'ForwardChar',         # 77: <Right arrow>
                  "\e",         'ViCommandMode',
                 ) :

                 (('M-C-j','EmacsEditingMode'), # Conflicts with \e otherwise
                  (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
                   (
                    qq/"\eA"/,    'PreviousHistory',   # up    arrow
                    qq/"\eB"/,    'NextHistory',       # down  arrow
                    qq/"\eC"/,    'ForwardChar',               # right arrow
                    qq/"\eD"/,    'BackwardChar',              # left  arrow
                    qq/"\e\\*"/,  'ViAfterEsc',
                   ) :

                   # Default
                   (
                    qq/"\e[A"/,   'PreviousHistory',    # up    arrow
                    qq/"\e[B"/,   'NextHistory',        # down  arrow
                    qq/"\e[C"/,   'ForwardChar',                # right arrow
                    qq/"\e[D"/,   'BackwardChar',               # left  arrow
                    qq/"\e\\*"/,  'ViAfterEsc',
                    qq/"\e[\\*"/, 'ViAfterEsc',
                   )
                ))),
               );

    # Vi positioning commands (suffixed to vi commands like 'd').
    &InitKeymap(*vipos_keymap, 'ViNonPosition', 'vipos_keymap',

                '^',    'ViFirstWord',
                '0',    'BeginningOfLine',
                '1',    'ViDigit',
                '2',    'ViDigit',
                '3',    'ViDigit',
                '4',    'ViDigit',
                '5',    'ViDigit',
                '6',    'ViDigit',
                '7',    'ViDigit',
                '8',    'ViDigit',
                '9',    'ViDigit',
                '$',    'EndOfLine',
                'h',    'BackwardChar',
                'l',    'ForwardChar',
                ' ',    'ForwardChar',
                'C-h',  'BackwardChar',
                'f',    'ViForwardFindChar',
                'F',    'ViBackwardFindChar',
                't',    'ViForwardToChar',
                'T',    'ViBackwardToChar',
                ';',    'ViRepeatFindChar',
                ',',    'ViInverseRepeatFindChar',
                '%',    'ViFindMatchingParens',
                '|',    'ViMoveToColumn',

                # Arrow keys
                ($inDOS ?
                 (
                  qq/"\0\115"/, 'ForwardChar',         # 77: <Right arrow>
                  qq/"\0\113"/, 'BackwardChar',        # 75: <Left arrow>
                  "\e",         'ViPositionEsc',
                 ) :

                ($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
                 (
                  qq/"\eC"/,    'ForwardChar',         # right arrow
                  qq/"\eD"/,    'BackwardChar',        # left  arrow
                  qq/"\e\\*"/,  'ViPositionEsc',
                 ) :

                # Default
                 (
                  qq/"\e[C"/,   'ForwardChar',          # right arrow
                  qq/"\e[D"/,   'BackwardChar',         # left  arrow
                  qq/"\e\\*"/,  'ViPositionEsc',
                  qq/"\e[\\*"/, 'ViPositionEsc',
                 )
                ),
               );

    # Vi search string input mode for '/' and '?'.
    &InitKeymap(*visearch_keymap, 'SelfInsert', 'visearch_keymap',

                "\e",   'Ding',
                'C-c',  'Interrupt',
                'C-h',  'ViSearchBackwardDeleteChar',
                'C-w',  'UnixWordRubout',
                'C-u',  'UnixLineDiscard',
                'C-v',  'QuotedInsert',
                'DEL',  'ViSearchBackwardDeleteChar',
                "\n",   'ViEndSearch',
                "\r",   'ViEndSearch',
               );

    # These constant hashes hold the arguments to &forward_scan() or
    #     &backward_scan() for vi positioning commands, which all
    #     behave a little differently for delete, move, change, and yank.
    #
    # Note: I originally coded these as qr{}, but changed them to q{} for
    #       compatibility with older perls at the expense of some performance.
    #
    # Note: Some of the more obscure key combinations behave slightly
    #       differently in different vi implementation.  This module matches
    #       the behavior of /usr/ucb/vi, which is different from the
    #       behavior of vim, nvi, and the ksh command line.  One example is
    #       the command '2de', when applied to the string ('^' represents the
    #       cursor, not a character of the string):
    #
    #           ^5.6   7...88888888
    #
    #       With /usr/ucb/vi and with this module, the result is
    #
    #           ^...88888888
    #
    #       but with the other three vi implementations, the result is
    #
    #           ^   7...88888888

    $Vi_delete_patterns = {
        ord('w')  =>  q{(?:\w+|[^\w\s]+|)\s*},
        ord('W')  =>  q{\S*\s*},
        ord('b')  =>  q{\w+\s*|[^\w\s]+\s*|^\s+},
        ord('B')  =>  q{\S+\s*|^\s+},
        ord('e')  =>  q{.\s*\w+|.\s*[^\w\s]+|.\s*$},
        ord('E')  =>  q{.\s*\S+|.\s*$},
    };

    $Vi_move_patterns = {
        ord('w')  =>  q{(?:\w+|[^\w\s]+|)\s*},
        ord('W')  =>  q{\S*\s*},
        ord('b')  =>  q{\w+\s*|[^\w\s]+\s*|^\s+},
        ord('B')  =>  q{\S+\s*|^\s+},
        ord('e')  =>  q{.\s*\w*(?=\w)|.\s*[^\w\s]*(?=[^\w\s])|.?\s*(?=\s$)},
        ord('E')  =>  q{.\s*\S*(?=\S)|.?\s*(?=\s$)},
    };

    $Vi_change_patterns = {
        ord('w')  =>  q{\w+|[^\w\s]+|\s},
        ord('W')  =>  q{\S+|\s},
        ord('b')  =>  q{\w+\s*|[^\w\s]+\s*|^\s+},
        ord('B')  =>  q{\S+\s*|^\s+},
        ord('e')  =>  q{.\s*\w+|.\s*[^\w\s]+|.\s*$},
        ord('E')  =>  q{.\s*\S+|.\s*$},
    };

    $Vi_yank_patterns = {
        ord('w')  =>  q{(?:\w+|[^\w\s]+|)\s*},
        ord('W')  =>  q{\S*\s*},
        ord('b')  =>  q{\w+\s*|[^\w\s]+\s*|^\s+},
        ord('B')  =>  q{\S+\s*|^\s+},
        ord('e')  =>  q{.\s*\w*(?=\w)|.\s*[^\w\s]*(?=[^\w\s])|.?\s*(?=\s$)},
        ord('E')  =>  q{.\s*\S*(?=\S)|.?\s*(?=\s$)},
    };

    my $default_mode = 'emacs';

    *KeyMap = $var_EditingMode = $var_EditingMode{$default_mode};

##    my $name;
##    for $name ( keys %{'readline::'} ) {
##      # Create aliases accessible via tied interface
##      *{"rl_$1"} = \$ {"var_$1"} if $name =~ /$var_(.*)/;
##    }

    1;                          # Returning a glob causes a bug in db5.001m
}

sub init
{
    if ($ENV{'TERM'} and ($ENV{'TERM'} eq 'emacs' || $ENV{'TERM'} eq 'dumb')) {
        $dumb_term = 1;
    } elsif (! -c $term_IN && $term_IN eq \*STDIN) { # Believe if it is given
        $stdin_not_tty = 1;
    } else {
        &get_window_size;
        &F_ReReadInitFile if !defined($rl_NoInitFromFile);
        $InputLocMsg = '';
        *KeyMap = $var_EditingMode;
    }

    $initialized = 1;
}


=head2 InitKeyMap

C<InitKeymap(*keymap, 'default', 'name', bindings...)>

=cut

sub InitKeymap
{
    local(*KeyMap) = shift(@_);
    my $default = shift(@_);
    my $name = $KeyMap{'name'} = shift(@_);

    # 'default' is now optional - if '', &do_command() defaults it to
    #     'F_Ding'.  Meta-maps now don't set a default - this lets
    #     us detect multiple '\*' default declarations.              JP
    if ($default ne '') {
        my $func = $KeyMap{'default'} = "F_$default";
        ### Temporarily disabled
        die qq/Bad default function [$func] for keymap "$name"/
          if !$autoload_broken and !defined(&$func);
    }

    &rl_bind if @_ > 0; ## The rest of @_ gets passed silently.
}

sub filler_Pending ($) {
  my $keys = shift;
  sub {
    my $c = shift;
    push @Pending, map chr, @$keys;
    return if not @$keys or $c == 1 or not defined(my $in = &getc_with_pending);
    # provide the numeric argument
    local(*KeyMap) = $var_EditingMode;
    $doingNumArg = 1;           # Allow NumArg inside NumArg
    &do_command(*KeyMap, $c, ord $in);
    return;
  }
}


=head2 _unescape

C<_unescape($string)> -> List of keys

This internal function that takes C<$string> possibly containing
escape sequences, and converts to a series of octal keys.

It has special rules for dealing with readline-specific escape-sequence
commands.

New-style key bindings are enclosed in double-quotes.
Characters are taken verbatim except the special cases:

    \C-x    Control x (for any x)
    \M-x    Meta x (for any x)
    \e      Escape
    \*      Set the keymap default   (JP: added this)
            (must be the last character of the sequence)
    \x      x  (unless it fits the above pattern)

Special case "\C-\M-x", should be treated like "\M-\C-x".

=cut

my @ESCAPE_REGEXPS = (
    # Ctrl-meta <x>
    [ qr/^\\C-\\M-(.)/, sub { ord("\e"), ctrl(ord(shift)) } ],
    # Meta <e>
    [ qr/^\\(M-|e)/, sub { ord("\e") } ],
    # Ctrl <x>
    [ qr/^\\C-(.)/, sub { ctrl(ord(shift)) } ],
    # hex value
    [ qr/^\\x([0-9a-fA-F]{2})/, sub { hex(shift) } ],
    # octal value
    [ qr/^\\([0-7]{3})/, sub { oct(shift) } ],
    # default
    [ qr/^\\\*$/, sub { 'default'; } ],
    # EOT (Ctrl-D)
    [ qr/^\\d/, sub { 4 } ],
    # Backspace
    [ qr/\\b/, sub { 0x7f } ],
    # Escape Sequence
    [ qr/\\(.)/,
      sub {
          my $chr = shift;
          ord(($chr =~ /^[afnrtv]$/) ? eval(qq("\\$chr")) : $chr);
      } ],
    );

sub _unescape ($) {
  my($key, @keys) = shift;

  CHAR: while (length($key) > 0) {
    foreach my $command (@ESCAPE_REGEXPS) {
      my $regex = $command->[0];
      if ($key =~ s/^$regex//) {
        push @keys, $command->[1]->($1);
        next CHAR;
      }
    }
    push @keys, ord($key);
    substr($key,0,1) = '';
  }
  @keys
}

sub RL_func ($) {
  my $name_or_macro = shift;
  if ($name_or_macro =~ /^"((?:\\.|[^\\\"])*)"|^'((?:\\.|[^\\\'])*)'/s) {
    filler_Pending [_unescape "$+"];
  } else {
    "F_$name_or_macro";
  }
}

=head2 actually_do_binding

C<actually_do_binding($function1, \@sequence1, ...)>

Actually inserts the binding for C<@sequence> to C<$function> into the
current map. C<@sequence> is an array of character ordinals.

If C<sequence> is more than one element long, all but the last will
cause meta maps to be created.

C<$Function> will have an implicit C<F_> prepended to it.

=cut

sub actually_do_binding
{
  while (@_) {
    my $func = shift;
    my ($key, @keys) = @{shift()};
    $key += 0;
    local(*KeyMap) = *KeyMap;
    my $map;
    while (@keys) {
      if (defined($KeyMap[$key]) && ($KeyMap[$key] ne 'F_PrefixMeta')) {
        warn "Warning$InputLocMsg: ".
          "Re-binding char #$key from [$KeyMap[$key]] to meta for [@keys] => $func.\n" if $^W;
      }
      $KeyMap[$key] = 'F_PrefixMeta';
      $map = "$KeyMap{'name'}_$key";
      InitKeymap(*$map, '', $map) if !(%$map);
      *KeyMap = *$map;
      $key = shift @keys;
      #&actually_do_binding($func, \@keys);
    }

    my $name = $KeyMap{'name'};
    if ($key eq 'default') {      # JP: added
        warn "Warning$InputLocMsg: ".
          " changing default action to $func in $name key map\n"
          if $^W && defined $KeyMap{'default'};

        $KeyMap{'default'} = RL_func $func;
    }
    else {
        if (defined($KeyMap[$key]) && $KeyMap[$key] eq 'F_PrefixMeta'
            && $func ne 'PrefixMeta')
          {
            warn "Warning$InputLocMsg: ".
              " Re-binding char #$key to non-meta ($func) in $name key map\n"
              if $^W;
          }
        $KeyMap[$key] = RL_func $func;
    }
  }
}

=head2 rl_bind

Accepts an array as pairs ($keyspec, $function, [$keyspec, $function]...).
and maps the associated bindings to the current KeyMap.

C<$keyspec> should be the name of key sequence in one of two forms:

Old (GNU readline documented) form:
     M-x        to indicate Meta-x
     C-x        to indicate Ctrl-x
     M-C-x      to indicate Meta-Ctrl-x
     x          simple char x

where 'x' above can be a single character, or the special:

     special    means
     --------   -----
     space      space   ( )
     spc        space   ( )
     tab        tab     (\t)
     del        delete  (0x7f)
     rubout     delete  (0x7f)
     newline    newline (\n)
     lfd        newline (\n)
     ret        return  (\r)
     return     return  (\r)
     escape     escape  (\e)
     esc        escape  (\e)

New form:
  "chars"   (note the required double-quotes)

where each char in the list represents a character in the sequence, except
for the special sequences:

          \\C-x         Ctrl-x
          \\M-x         Meta-x
          \\M-C-x       Meta-Ctrl-x
          \\e           escape.
          \\x           x (if not one of the above)


C<$function> should be in the form C<BeginningOfLine> or C<beginning-of-line>.

It is an error for the function to not be known....

As an example, the following lines in .inputrc will bind one's xterm
arrow keys:

    "\e[[A": previous-history
    "\e[[B": next-history
    "\e[[C": forward-char
    "\e[[D": backward-char

=cut

sub rl_bind
{
    my (@keys, $key, $func, $ord, @arr);

    while (defined($key = shift(@_)) && defined($func = shift(@_)))
    {
        ##
        ## Change the function name from something like
        ##      backward-kill-line
        ## to
        ##      BackwardKillLine
        ## if not already there.
        ##
        unless ($func =~ /^[\"\']/) {
          $func = "\u$func";
          $func =~ s/-(.)/\u$1/g;

          # Temporary disabled
          if (!$autoload_broken and !defined($ {'readline::'}{"F_$func"})) {
            warn "Warning$InputLocMsg: bad bind function [$func]\n" if $^W;
            next;
          }
        }

        ## print "sequence [$key] func [$func]\n"; ##DEBUG

        @keys = ();
        ## See if it's a new-style binding.
        if ($key =~ m/"((?:\\.|[^\\])*)"/s) {
            @keys = _unescape "$1";
        } else {
            ## old-style binding... only one key (or Meta+key)
            my ($isctrl, $orig) = (0, $key);
            $isctrl = $key =~ s/\b(C|Control|CTRL)-//i;
            push(@keys, ord("\e")) if $key =~ s/\b(M|Meta)-//i; ## is meta?
            ## Isolate key part. This matches GNU's implementation.
            ## If the key is '-', be careful not to delete it!
            $key =~ s/.*-(.)/$1/;
            if    ($key =~ /^(space|spc)$/i)   { $key = ' ';    }
            elsif ($key =~ /^(rubout|del)$/i)  { $key = "\x7f"; }
            elsif ($key =~ /^tab$/i)           { $key = "\t";   }
            elsif ($key =~ /^(return|ret)$/i)  { $key = "\r";   }
            elsif ($key =~ /^(newline|lfd)$/i) { $key = "\n";   }
            elsif ($key =~ /^(escape|esc)$/i)  { $key = "\e";   }
            elsif (length($key) > 1) {
                warn "Warning$InputLocMsg: strange binding [$orig]\n" if $^W;
            }
            $key = ord($key);
            $key = &ctrl($key) if $isctrl;
            push(@keys, $key);
        }

        #
        ## Now do the mapping of the sequence represented in @keys
         #
        # print "&actually_do_binding($func, @keys)\n"; ##DEBUG
        push @arr, $func, [@keys];
        #&actually_do_binding($func, \@keys);
    }
    &actually_do_binding(@arr);
}

=head2 read_an_init_file

C<read_an_init_file(inputrc_file)>

Reads and executes I<inputrc_file> which does things like Sets input
key bindings in key maps.

If there was a problem return 0.  Otherwise return 1;

=cut

sub read_an_init_file {
    my $file = shift;
    my $include_depth = shift;
    local *RC;

    $file = File::Spec->catfile($HOME, $file) unless -f $file;
    return 0 unless open RC, "< $file";
    my (@action) = ('exec'); ## exec, skip, ignore (until appropriate endif)
    my (@level) = ();        ## if, else

    local $/ = "\n";
    while (<RC>) {
        s/^\s+//;
        next if m/^\s*(#|$)/;
        $InputLocMsg = " [$file line $.]";
        if (/^\$if\s+(.*)/) {
            my($test) = $1;
            push(@level, 'if');
            if ($action[$#action] ne 'exec') {
                ## We're supposed to be skipping or ignoring this level,
                ## so for subsequent levels we really ignore completely.
                push(@action, 'ignore');
            } else {
                ## We're executing this IF... do the test.
                ## The test is either "term=xxxx", or just a string that
                ## we compare to $rl_readline_name;
                if ($test =~ /term=([a-z0-9]+)/) {
                    $test = ($ENV{'TERM'} && $1 eq $ENV{'TERM'});
                } else {
                    $test = $test =~ /^(perl|$rl_readline_name)\s*$/i;
                }
                push(@action, $test ? 'exec' : 'skip');
            }
            next;
        } elsif (/^\$endif\b/) {
            die qq/\rWarning$InputLocMsg: unmatched endif\n/ if @level == 0;
            pop(@level);
            pop(@action);
            next;
        } elsif (/^\$else\b/) {
            die qq/\rWarning$InputLocMsg: unmatched else\n/ if
                @level == 0 || $level[$#level] ne 'if';
            $level[$#level] = 'else'; ## an IF turns into an ELSE
            if ($action[$#action] eq 'skip') {
                $action[$#action] = 'exec'; ## if were SKIPing, now EXEC
            } else {
                $action[$#action] = 'ignore'; ## otherwise, just IGNORE.
            }
            next;
        } elsif (/^\$include\s+(\S+)/) {
            if ($include_depth > $max_include_depth) {
                warn "Deep recursion in \$include directives in $file.\n";
            } else {
                read_an_init_file($1, $include_depth + 1);
            }
        } elsif ($action[$#action] ne 'exec') {
            ## skipping this one....
        # Readline permits trailing comments in inputrc
        # For example, /etc/inputrc on Mandrake Linux boxes has trailing
    # comments
        } elsif (m/\s*set\s+(\S+)\s+(\S*)/) { # Allow trailing comment
            &rl_set($1, $2, $file);
        } elsif (m/^\s*(\S+):\s+("(?:\\.|[^\\\"])*"|'(\\.|[^\\\'])*')/) { # Allow trailing comment
            &rl_bind($1, $2);
        } elsif (m/^\s*(\S+|"[^\"]+"):\s+(\S+)/) { # Allow trailing comment
            &rl_bind($1, $2);
        } else {
            chomp;
            warn "\rWarning$InputLocMsg: Bad line [$_]\n" if $^W;
        }
    }
    close(RC);
    return 1;
}

sub F_ReReadInitFile
{
    my ($file) = $ENV{'TRP_INPUTRC'};
    $file = $ENV{'INPUTRC'} unless defined $file;
    unless (defined $file) {
        return unless defined $HOME;
        $file = File::Spec->catfile($HOME, '.inputrc');
    }
    read_an_init_file($file, 0);
}

sub get_ornaments_selected {
    return if @$rl_term_set >= 6;
    local $^W=0;
    my $Orig = Term::ReadLine::TermCap::ornaments(__PACKAGE__);
    eval {
        # Term::ReadLine does not expose its $terminal, so make another
        require Term::Cap;
        my $terminal = Tgetent Term::Cap ({OSPEED=>9600});
        # and be sure the terminal supports highlighting
        $terminal->Trequire('mr');
    };
    if (!$@ and $Orig ne ',,,'){
        my @set = @$rl_term_set;

        Term::ReadLine::TermCap::ornaments(__PACKAGE__,
                                        join(',',
                                             (split(/,/, $Orig))[0,1])
                                        . ',mr,me') ;
        @set[4,5] = @$rl_term_set[2,3];
        Term::ReadLine::TermCap::ornaments(__PACKAGE__, $Orig);
        @$rl_term_set = @set;
    } else {
        @$rl_term_set[4,5] = @$rl_term_set[2,3];
    }
}

sub get_line {
  scalar <$term_IN>;
}

=head2 readline_dumb

A version readline for a dumb terminal, that is one that doesn't have
many terminal editing capabilities.

=cut

sub readline_dumb
{
    local $\ = '';
    print $term_OUT $prompt;
    local $/ = "\n";
    return undef
        if !defined($line = get_line);
    chomp($line);
    $| = $oldbar;
    select $old;
    return $line;
}

=head2 readline

C<&readline::readline($prompt, $default)>

The main routine to call interactively read lines.

C<$default> can be omitted. The next input line is returned or
C<undef> on EOF.

=cut

sub readline
{
    $Term::ReadLine::Perl5::term->register_Tk
      if not $Term::ReadLine::registered and $Term::ReadLine::toloop
        and defined &Tk::DoOneEvent;
    if ($stdin_not_tty) {
        local $/ = "\n";
        return undef if !defined($line = <$term_IN>);
        chomp($line);
        return $line;
    }

    $old = select $term_OUT;
    $oldbar = $|;
    local($|) = 1;
    local($input);

    ## prompt should be given to us....
    $prompt = defined($_[0]) ? $_[0] : 'INPUT> ';

    # Try to move cursor to the beginning of the next line if this line
    # contains anything.

    # On DOSish 80-wide console
    #   perl -we "print 1 x shift, qq(\b2\r3); sleep 2" 79
    # prints 3 on the same line,
    #   perl -we "print 1 x shift, qq(\b2\r3); sleep 2" 80
    # on the next; $rl_screen_width is 79.

    # on XTerm one needs to increase the number by 1.

    print $term_OUT ' ' x ($rl_screen_width - !$rl_last_pos_can_backspace) . "\b  \r"
      if $rl_scroll_nextline;

    if ($dumb_term) {
        return readline_dumb;
    }

    # test if we resume an 'Operate' command
    if ($rl_OperateCount > 0 && (!defined $_[1] || $_[1] eq '')) {
        ## it's from a valid previous 'Operate' command and
        ## user didn't give a default line
        ## we leave $rl_HistoryIndex untouched
        $line = $rl_History[$rl_HistoryIndex];
    } else {
        ## set history pointer at the end of history
        $rl_HistoryIndex = $#rl_History + 1;
        $rl_OperateCount = 0;
        $line = defined $_[1] ? $_[1] : '';
    }
    $rl_OperateCount-- if $rl_OperateCount > 0;

    $line_for_revert = $line;

# I don't think we need to do this, actually...
#    while (&ioctl(STDIN,$FIONREAD,$fion))
#    {
#       local($n_chars_available) = unpack ($fionread_t, $fion);
#       ## print "n_chars = $n_chars_available\n";
#       last if $n_chars_available == 0;
#       $line .= getc_with_pending;  # should we prepend if $rl_start_default_at_beginning?
#    }

    $D = $rl_start_default_at_beginning ? 0 : length($line); ## set dot.
    $LastCommandKilledText = 0;     ## heck, was no last command.
    $lastcommand = '';              ## Well, there you go.
    $line_rl_mark = -1;

    ##
    ## some stuff for &redisplay.
    ##
    $lastredisplay = '';        ## Was no last redisplay for this time.
    $lastlen = length($lastredisplay);
    $lastpromptlen = 0;
    $lastdelta = 0;             ## Cursor was nowhere
    $si = 0;                    ## Want line to start left-justified
    $force_redraw = 1;          ## Want to display with brute force.
    if (!eval {SetTTY()}) {     ## Put into raw mode.
        warn $@ if $@;
        $dumb_term = 1;
        return readline_dumb;
    }

    *KeyMap = $var_EditingMode;
    undef($AcceptLine);         ## When set, will return its value.
    undef($ReturnEOF);          ## ...unless this on, then return undef.
    @Pending = ();              ## Contains characters to use as input.
    @undo = ();                 ## Undo history starts empty for each line.
    @undoGroupS = ();           ## Undo groups start empty for each line.
    undef $memorizedArg;        ## No digitArgument memorized
    undef $memorizedPos;        ## No position memorized

    undef $Vi_undo_state;
    undef $Vi_undo_all_state;

    # We need to do some additional initialization for vi mode.
    # RS: bug reports/platform issues are welcome: russ@dvns.com
    if ($KeyMap{'name'} eq 'vi_keymap'){
        &F_ViInput();
        if ($rl_vi_replace_default_on_insert){
            local $^W=0;
            my $Orig = Term::ReadLine::TermCap::ornaments(__PACKAGE__);
           eval {
               # Term::ReadLine does not expose its $terminal, so make another
               require Term::Cap;
               my $terminal = Tgetent Term::Cap ({OSPEED=>9600});
               # and be sure the terminal supports highlighting
               $terminal->Trequire('mr');
           };
           if (!$@ and $Orig ne ',,,'){
               Term::ReadLine::TermCap::ornaments(__PACKAGE__,
                                               join(',',
                                                    (split(/,/, $Orig))[0,1])
                                               . ',mr,me');
        }
            my $F_SelfInsert_Real = \&F_SelfInsert;
            *F_SelfInsert = sub {
                Term::ReadLine::TermCap::ornaments(__PACKAGE__);
                &F_ViChangeEntireLine;
                local $^W=0;
                *F_SelfInsert = $F_SelfInsert_Real;
                &F_SelfInsert;
            };
            my $F_ViEndInsert_Real = \&F_ViEndInsert;
            *F_ViEndInsert = sub {
               Term::ReadLine::TermCap::ornaments(__PACKAGE__, $Orig);
                local $^W=0;
                *F_SelfInsert = $F_SelfInsert_Real;
                *F_ViEndInsert = $F_ViEndInsert_Real;
                &F_ViEndInsert;
               $force_redraw = 1;
               redisplay();
            };
        }
    }

    if ($rl_default_selected) {
        redisplay_high();
    } else {
        &redisplay();          ## Show the line (prompt+default at this point).
    }

    # pretend input if we 'Operate' on more than one line
    &F_OperateAndGetNext($rl_OperateCount) if $rl_OperateCount > 0;

    $rl_first_char = 1;
    while (!defined($AcceptLine)) {
        ## get a character of input
        $input = &getc_with_pending(); # bug in debugger, returns 42. - No more!

        unless (defined $input) {
          # XXX What to do???  Until this is clear, just pretend we got EOF
          $AcceptLine = $ReturnEOF = 1;
          last;
        }
        preserve_state();

        $ThisCommandKilledText = 0;
        ##print "\n\rline is @$D:[$line]\n\r"; ##DEBUG
        my $cmd = get_command($var_EditingMode, ord($input));
        if ( $rl_first_char && $cmd =~ /^F_(SelfInsert$|Yank)/
             && length $line && $rl_default_selected ) {
          # (Backward)?DeleteChar specialcased in the code
            $line = '';
            $D = 0;
            $cmd = 'F_BackwardDeleteChar' if $cmd eq 'F_DeleteChar';
        }
        undef $doingNumArg;
        &$cmd(1, ord($input));                  ## actually execute input
        $rl_first_char = 0;
        $lastcommand = $cmd;
        *KeyMap = $var_EditingMode;           # JP: added

        # In Vi command mode, don't position the cursor beyond the last
        #     character of the line buffer.
        &F_BackwardChar(1) if $Vi_mode and $line ne ''
            and &at_end_of_line and $KeyMap{'name'} eq 'vicmd_keymap';

        &redisplay();
        $LastCommandKilledText = $ThisCommandKilledText;
    }

    undef @undo; ## Release the memory.
    undef @undoGroupS; ## Release the memory.
    &ResetTTY;   ## Restore the tty state.
    $| = $oldbar;
    select $old;
    return undef if defined($ReturnEOF);
    #print STDOUT "|al=`$AcceptLine'";
    $AcceptLine; ## return the line accepted.
}

=head2 ctrl

C<ctrl($ord)>

Returns the ordinal number for the corresponding control code.

For example I<ctrl(ord('a'))> returns the ordinal for I<Ctrl-A>
or 1. I<ctrl(ord('A'))> does the same thing.

=cut

sub ctrl {
    $_[0] ^ (($_[0]>=ord('a') && $_[0]<=ord('z')) ? 0x60 : 0x40);
}



sub SetTTY {
    return if $dumb_term || $stdin_not_tty;
    #return system 'stty raw -echo' if defined &DB::DB;
    Term::ReadKey::ReadMode(4, $term_IN);
    if ($^O eq 'MSWin32') {
	# If we reached this, Perl isn't cygwin; Enter sends \r; thus we need binmode
	# XXXX Do we need to undo???  $term_IN is most probably private now...
	binmode $term_IN;
    }
    return 1;
}

sub ResetTTY {
    return if $dumb_term || $stdin_not_tty;
    return Term::ReadKey::ReadMode(0, $term_IN);
}

=head2 substr_with_props

C<substr_with_props($prompt, $string, $from, $len, $ket, $bsel, $esel)>

Gives the I<substr()> of C<$prompt.$string> with embedded face-change
commands.

=cut

sub substr_with_props {
  my ($p, $s, $from, $len, $ket, $bsel, $esel) = @_;
  my $lp = length $p;

  defined $from or $from = 0;
  defined $len or $len = length($p) + length($s) - $from;
  unless (defined $ket) {
    warn 'bug in Term::ReadLine::Perl5, please report to its author';
    $ket = '';
  }
  # We may draw over to put cursor in a correct position:
  $ket = '' if $len < length($p) + length($s) - $from; # Not redrawn

  if ($from >= $lp) {
    $p = '';
    $s = substr $s, $from - $lp;
    $lp = 0;
  } else {
    $p = substr $p, $from;
    $lp -= $from;
    $from = 0;
  }
  $s = substr $s, 0, $len - $lp;
  $p =~ s/^(\s*)//; my $bs = $1;
  $p =~ s/(\s*)$//; my $as = $1;
  $p = $rl_term_set->[0] . $p . $rl_term_set->[1] if length $p;
  $p = "$bs$p$as";
  $ket = chop $s if $ket;
  if (defined $bsel and $bsel != $esel) {
    $bsel = $len if $bsel > $len;
    $esel = $len if $esel > $len;
  }
  if (defined $bsel and $bsel != $esel) {
    get_ornaments_selected;
    $bsel -= $lp; $esel -= $lp;
    my ($pre, $sel, $post) =
      (substr($s, 0, $bsel),
       substr($s, $bsel, $esel-$bsel),
       substr($s, $esel));
    $pre  = $rl_term_set->[2] . $pre  . $rl_term_set->[3] if length $pre;
    $sel  = $rl_term_set->[4] . $sel  . $rl_term_set->[5] if length $sel;
    $post = $rl_term_set->[2] . $post . $rl_term_set->[3] if length $post;
    $s = "$pre$sel$post"
  } else {
    $s = $rl_term_set->[2] . $s . $rl_term_set->[3] if length $s;
  }

  if (!$lp) {                   # Should not happen...
    return $s;
  } elsif (!length $s) {        # Should not happen
    return $p;
  } else {                      # Do not underline spaces in the prompt
    return "$p$s"
      . (length $ket ? ($rl_term_set->[0] . $ket . $rl_term_set->[1]) : '');
  }
}

sub redisplay_high {
  get_ornaments_selected();
  @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3];
  &redisplay();                 ## Show the line, default inverted.
  @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3];
  $force_redraw = 1;
}

=head2 redisplay

C<redisplay()>

Updates the screen to reflect the current value if C<$line>.

For the purposes of this routine, we prepend the prompt to a local copy of
C<$line> so that we display the prompt as well.  We then modify it to reflect
that some characters have different sizes. That is, control-C is represented
as C<^C>, tabs are expanded, etc.

This routine is somewhat complicated by two-byte characters.... must
make sure never to try do display just half of one.

I<Note>: If an argument is given, it is used instead of the prompt.

This is some nasty code.

=cut

sub redisplay
{
    ## local $line has prompt also; take that into account with $D.
    local($prompt) = defined($_[0]) ? $_[0] : $prompt;
    $prompt = '' unless defined($prompt);
    my ($thislen, $have_bra);
    my($dline) = $prompt . $line;
    local($D) = $D + length($prompt);
    my ($bsel, $esel);
    if (defined pos $line) {
      $bsel = (pos $line) + length $prompt;
    }
    my ($have_ket) = '';

    ##
    ## If the line contains anything that might require special processing
    ## for displaying (such as tabs, control characters, etc.), we will
    ## take care of that now....
    ##
    if ($dline =~ m/[^\x20-\x7e]/)
    {
        local($new, $Dinc, $c) = ('', 0);

        ## Look at each character of $dline in turn.....
        for (my $i = 0; $i < length($dline); $i++) {
            $c = substr($dline, $i, 1);

            ## A tab to expand...
            if ($c eq "\t") {
                $c = ' ' x  (8 - (($i-length($prompt)) % 8));

            ## A control character....
            } elsif ($c =~ tr/\000-\037//) {
                $c = sprintf("^%c", ord($c)+ord('@'));

            ## the delete character....
            } elsif (ord($c) == 127) {
                $c = '^?';
            }
            $new .= $c;

            ## Bump over $D if this char is expanded and left of $D.
            $Dinc += length($c) - 1 if (length($c) > 1 && $i < $D);
            ## Bump over $bsel if this char is expanded and left of $bsel.
            $bsel += length($c) - 1 if (defined $bsel && length($c) > 1 && $i < $bsel);
        }
        $dline = $new;
        $D += $Dinc;
    }

    ##
    ## Now $dline is what we'd like to display (with a prepended prompt)
    ## $D is the position of the cursor on it.
    ##
    ## If it's too long to fit on the line, we must decide what we can fit.
    ##
    ## If we end up moving the screen index ($si) [index of the leftmost
    ## character on the screen], to some place other than the front of the
    ## the line, we'll have to make sure that it's not on the first byte of
    ## a 2-byte character, 'cause we'll be placing a '<' marker there, and
    ## that would screw up the 2-byte character.
    ##
    ## $si is preserved between several displays (if possible).
    ##
    ## Similarly, if the line needs chopped off, we make sure that the
    ## placement of the tailing '>' won't screw up any 2-byte character in
    ## the vicinity.

    # Now $si keeps the value from previous display
    if ($D == length($prompt)   # If prompts fits exactly, show only if need not show trailing '>'
        and length($prompt) < $rl_screen_width - (0 != length $dline)) {
        $si = 0;   ## prefer displaying the whole prompt
    } elsif ($si >= $D) {       # point to the left of what was displayed
        $si = &max(0, $D - $rl_margin);
        $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
    } elsif ($si + $rl_screen_width <= $D) { # Point to the right of ...
        $si = &min(length($dline), ($D - $rl_screen_width) + $rl_margin);
        $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
    } elsif (length($dline) - $si < $rl_screen_width - $rl_margin and $si) {
        # Too little of the line shown
        $si = &max(0, length($dline) - $rl_screen_width + 3);
        $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
    } else {
        ## Fine as-is.... don't need to change $si.
    }
    $have_bra = 1 if $si != 0; # Need the "chopped-off" marker

    $thislen = &min(length($dline) - $si, $rl_screen_width);
    if ($si + $thislen < length($dline)) {
        ## need to place a '>'... make sure to place on first byte.
        $thislen-- if &OnSecondByte($si+$thislen-1);
        substr($dline, $si+$thislen-1,1) = '>';
        $have_ket = 1;
    }

    ##
    ## Now know what to display.
    ## Must get substr($dline, $si, $thislen) on the screen,
    ## with the cursor at $D-$si characters from the left edge.
    ##
    $dline = substr($dline, $si, $thislen);
    $delta = $D - $si;  ## delta is cursor distance from beginning of $dline.
    if (defined $bsel) {        # Highlight the selected part
      $bsel -= $si;
      $esel = $delta;
      ($bsel, $esel) = ($esel, $bsel) if $bsel > $esel;
      $bsel = 0 if $bsel < 0;
      if ($have_ket) {
        $esel = $thislen - 1 if $esel > $thislen - 1;
      } else {
        $esel = $thislen if $esel > $thislen;
      }
    }
    if ($si >= length($prompt)) { # Keep $dline for $lastredisplay...
      $prompt = ($have_bra ? "<" : "");
      $dline = substr $dline, 1 if length($dline); # After prompt
      $bsel = 1 if defined $bsel and $bsel == 0;
    } else {
      $dline = substr($dline, (length $prompt) - $si);
      $prompt = substr($prompt,$si);
      substr($prompt, 0, 1) = '<' if $si > 0;
    }
    # Now $dline is the part after the prompt...

    ##
    ## Now must output $dline, with cursor $delta spaces from left of TTY
    ##

    local ($\, $,) = ('','');

    ##
    ## If $force_redraw is not set, we can attempt to optimize the redisplay
    ## However, if we don't happen to find an easy way to optimize, we just
    ## fall through to the brute-force method of re-drawing the whole line.
    ##
    if (not $force_redraw and not defined $bsel)
    {
        ## can try to optimize here a bit.

        ## For when we only need to move the cursor
        if ($lastredisplay eq $dline and $lastpromptlen == length $prompt) {
            ## If we need to move forward, just overwrite as far as we need.
            if ($lastdelta < $delta) {
                print $term_OUT
                  substr_with_props($prompt, $dline,
                                    $lastdelta, $delta-$lastdelta, $have_ket);
            ## Need to move back.
            } elsif($lastdelta > $delta) {
                ## Two ways to move back... use the fastest. One is to just
                ## backspace the proper amount. The other is to jump to the
                ## the beginning of the line and overwrite from there....
                my $out = substr_with_props($prompt, $dline, 0, $delta, $have_ket);
                if ($lastdelta - $delta <= length $out) {
                    print $term_OUT "\b" x ($lastdelta - $delta);
                } else {
                    print $term_OUT "\r", $out;
                }
            }
            ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
              = ($thislen, $dline, $delta, length $prompt);
            # print $term_OUT "\a"; # Debugging
            return;
        }

        ## for when we've just added stuff to the end
        if ($thislen > $lastlen &&
            $lastdelta == $lastlen &&
            $delta == $thislen &&
            $lastpromptlen == length($prompt) &&
            substr($dline, 0, $lastlen - $lastpromptlen) eq $lastredisplay)
        {
            print $term_OUT substr_with_props($prompt, $dline,
                                              $lastdelta, undef, $have_ket);
            # print $term_OUT "\a"; # Debugging
            ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
              = ($thislen, $dline, $delta, length $prompt);
            return;
        }

        ## There is much more opportunity for optimizing.....
        ## something to work on later.....
    }

    ##
    ## Brute force method of redisplaying... redraw the whole thing.
    ##

    print $term_OUT "\r", substr_with_props($prompt, $dline, 0, undef, $have_ket, $bsel, $esel);
    my $back = length ($dline) + length ($prompt) - $delta;
    $back += $lastlen - $thislen,
        print $term_OUT ' ' x ($lastlen - $thislen) if $lastlen and $lastlen > $thislen;

    if ($back) {
        my $out = substr_with_props($prompt, $dline, 0, $delta, $have_ket, $bsel, $esel);
        if ($back <= length $out and not defined $bsel) {
            print $term_OUT "\b" x $back;
        } else {
            print $term_OUT "\r", $out;
        }
    }

    ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
      = ($thislen, $dline, $delta, length $prompt);

    $force_redraw = 0;
}

sub min { $_[0] < $_[1] ? $_[0] : $_[1]; }

sub getc_with_pending {

    my $key = @Pending ? shift(@Pending) : &$rl_getc;

    # Save keystrokes for vi '.' command
    push(@$Dot_buf, $key) if $Dot_buf;

    $key;
}

sub rl_getc {
    $Term::ReadLine::Perl5::term->Tk_loop
	if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
    return Term::ReadKey::ReadKey(0, $term_IN);
}

=head2 get_command

C<get_command(*keymap, $ord_command_char)>

If the C<*keymap>) has an entry for C<$ord_command_char>, it is returned.
Otherwise, the default command in C<$Keymap{'default'}> is returned if that
exists. If C<$Keymap{'default'}> is false, C<'F_Ding'> is returned.

=cut

sub get_command
{
    local *KeyMap = shift;
    my ($key) = @_;
    my $cmd = defined($KeyMap[$key]) ? $KeyMap[$key]
                                     : ($KeyMap{'default'} || 'F_Ding');
    if (!defined($cmd) || $cmd eq ''){
        warn "internal error (key=$key)";
        $cmd = 'F_Ding';
    }
    $cmd
}

=head2 do_command

C<do_command(*keymap, $numericarg, $key)>

If the C<*keymap> has an entry for C<$key>, it is executed.
Otherwise, the default command for the keymap is executed.

=cut

sub do_command
{
    my ($keymap, $count, $key) = @_;
    my $cmd = get_command($keymap, $key);

    local *KeyMap = $keymap;            # &$cmd may expect it...
    &$cmd($count, $key);
    $lastcommand = $cmd;
}

=head2 savestate

C<savestate()>

Save whatever state we wish to save as an anonymous array.  The only
other function that needs to know about its encoding is
getstate/preserve_state.

=cut

sub savestate
{
    [$D, $si, $LastCommandKilledText, $KillBuffer, $line, @_];
}

=head2 preserve_state

C<preserve_tate()>

=cut

sub preserve_state {
    return if $Vi_mode;
    push(@undo, savestate()), return unless @undo;
    my $last = $undo[-1];
    my @only_movement;
    if ( #$last->[1] == $si and $last->[2] eq $LastCommandKilledText
         # and $last->[3] eq $KillBuffer and
         $last->[4] eq $line ) {
        # Only position changed; remove old only-position-changed records
        pop @undo if $undo[-1]->[5];
        @only_movement = 1;
    }
    push(@undo, savestate(@only_movement));
}

=head2 F_SelfInsert

C<F_SelfInsert($count, $ord)>

C<$ord> is an ASCII ordinal; inserts C<$count> of them into C<$line>.

=cut

sub F_SelfInsert
{
    remove_selection();
    my ($count, $ord) = @_;
    my $text2add = pack('C', $ord) x $count;
    if ($InsertMode) {
        substr($line,$D,0) .= $text2add;
    } else {
        ## note: this can screw up with 2-byte characters.
        substr($line,$D,length($text2add)) = $text2add;
    }
    $D += length($text2add);
}

=head2 F_AcceptLine

Return the line as-is to the user.

=cut

sub F_AcceptLine
{
    &add_line_to_history($line, $minlength);
    $AcceptLine = $line;
    local $\ = '';
    print $term_OUT "\r\n";
    $force_redraw = 0;
    (pos $line) = undef;        # Another way to force redraw...
}

sub remove_selection {
    if ( $rl_first_char && length $line && $rl_default_selected ) {
      $line = '';
      $D = 0;
      return 1;
    }
    if ($rl_delete_selection and defined pos $line and $D != pos $line) {
      kill_text(pos $line, $D);
      return 1;
    }
    return;
}

sub max     { $_[0] > $_[1] ? $_[0] : $_[1]; }
sub isupper { ord($_[0]) >= ord('A') && ord($_[0]) <= ord('Z'); }
sub islower { ord($_[0]) >= ord('a') && ord($_[0]) <= ord('z'); }

=head2 rl_set

C<rl_set($var_name, $value_string)>

Sets the named variable as per the given value, if both are appropriate.
Allows the user of the package to set such things as HorizontalScrollMode
and EditingMode.  Value_string may be of the form

      HorizontalScrollMode
      horizontal-scroll-mode

Also called during the parsing of F<~/.inputrc> for "set var value" lines.

The previous value is returned, or undef on error.

Consider the following example for how to add additional variables
accessible via rl_set (and hence via F<~/.inputrc>).

Want:

We want an external variable called "FooTime" (or "foo-time").
It may have values "January", "Monday", or "Noon".
Internally, we'll want those values to translate to 1, 2, and 12.

How:

Have an internal variable $var_FooTime that will represent the current
internal value, and initialize it to the default value.
Make an array %var_FooTime whose keys and values are are the external
(January, Monday, Noon) and internal (1, 2, 12) values:

    $var_FooTime = $var_FooTime{'January'} =  1; #default
                   $var_FooTime{'Monday'}  =  2;
                   $var_FooTime{'Noon'}    = 12;

=cut

sub rl_set
{
    local($var, $val) = @_;

    # &preinit's keys are all Capitalized
    $val = ucfirst lc $val if $val =~ /^(on|off)$/i;

    $var = 'CompleteAddsuffix' if $var eq 'visible-stats';

    ## if the variable is in the form "some-name", change to "SomeName"
    local($_) = "\u$var";
    local($return) = undef;
    s/-(.)/\u$1/g;

    # Skip unknown variables:
    return unless defined $ {'readline::'}{"var_$_"};
    local(*V);    # avoid <Undefined value assign to typeglob> warning
    { local $^W; *V = $ {'readline::'}{"var_$_"}; }
    if (!defined($V)) {                 # XXX Duplicate check?
        warn("Warning$InputLocMsg:\n".
             "  Invalid variable `$var'\n") if $^W;
    } elsif (!defined($V{$val})) {
        local(@selections) = keys(%V);
        warn("Warning$InputLocMsg:\n".
             "  Invalid value `$val' for variable `$var'.\n".
             "  Choose from [@selections].\n") if $^W;
    } else {
        $return = $V;
        $V = $V{$val}; ## make the setting
    }
    $return;
}

=head2 OnSecondByte

C<OnSecondByte($index)>

Returns true if the byte at C<$index> into C<$line> is the second byte
of a two-byte character.

=cut

sub OnSecondByte
{
    return 0 if !$_rl_japanese_mb || $_[0] == 0 || $_[0] == length($line);

    die 'internal error' if $_[0] > length($line);

    ##
    ## must start looking from the beginning of the line .... can
    ## have one- and two-byte characters interspersed, so can't tell
    ## without starting from some know location.....
    ##
    for (my $i = 0; $i < $_[0]; $i++) {
        next if ord(substr($line, $i, 1)) < 0x80;
        ## We have the first byte... must bump up $i to skip past the 2nd.
        ## If that one we're skipping past is the index, it should be changed
        ## to point to the first byte of the pair (therefore, decremented).
        return 1 if ++$i == $_[0];
    }
    0; ## seemed to be OK.
}


=head2 CharSize

C<CharSize($index)>

Returns the size of the character at the given C<$index> in the
current line.  Most characters are just one byte in length.  However,
if the byte at the index and the one after both have the high bit set
and $_rl_japanese_mb is set, those two bytes are one character of size
two.

Assumes that C<$index> points to the first of a 2-byte char if not
pointing to a 1-byte char.

TODO: handle Unicode

=cut
sub CharSize
{
    my $index = shift;
    return 2 if $_rl_japanese_mb &&
                ord(substr($line, $index,   1)) >= 0x80 &&
                ord(substr($line, $index+1, 1)) >= 0x80;
    1;
}

sub GetTTY
{
    $base_termios = $termios;  # make it long enough
    &ioctl($term_IN,$TCGETS,$base_termios) || die "Can't ioctl TCGETS: $!";
}

sub XonTTY
{
    # I don't know which of these I actually need to do this to, so we'll
    # just cover all bases.

    &ioctl($term_IN,$TCXONC,$TCOON);    # || die "Can't ioctl TCXONC STDIN: $!";
    &ioctl($term_OUT,$TCXONC,$TCOON);   # || die "Can't ioctl TCXONC STDOUT: $!";
}

sub ___SetTTY
{
# print "before SetTTY\n\r";
# system 'stty -a';

    &XonTTY;

    &GetTTY
        if !defined($base_termios);

    @termios = unpack($termios_t,$base_termios);
    $termios[$TERMIOS_IFLAG] |= $TERMIOS_READLINE_ION;
    $termios[$TERMIOS_IFLAG] &= ~$TERMIOS_READLINE_IOFF;
    $termios[$TERMIOS_OFLAG] |= $TERMIOS_READLINE_OON;
    $termios[$TERMIOS_OFLAG] &= ~$TERMIOS_READLINE_OOFF;
    $termios[$TERMIOS_LFLAG] |= $TERMIOS_READLINE_LON;
    $termios[$TERMIOS_LFLAG] &= ~$TERMIOS_READLINE_LOFF;
    $termios[$TERMIOS_VMIN] = 1;
    $termios[$TERMIOS_VTIME] = 0;
    $termios = pack($termios_t,@termios);
    &ioctl($term_IN,$TCSETS,$termios) || die "Can't ioctl TCSETS: $!";

# print "after SetTTY\n\r";
# system 'stty -a';
}

sub normal_tty_mode
{
    return if $stdin_not_tty || $dumb_term || !$initialized;
    &XonTTY;
    &GetTTY if !defined($base_termios);
    &ResetTTY;
}

sub ___ResetTTY
{
# print "before ResetTTY\n\r";
# system 'stty -a';

    @termios = unpack($termios_t,$base_termios);
    $termios[$TERMIOS_IFLAG] |= $TERMIOS_NORMAL_ION;
    $termios[$TERMIOS_IFLAG] &= ~$TERMIOS_NORMAL_IOFF;
    $termios[$TERMIOS_OFLAG] |= $TERMIOS_NORMAL_OON;
    $termios[$TERMIOS_OFLAG] &= ~$TERMIOS_NORMAL_OOFF;
    $termios[$TERMIOS_LFLAG] |= $TERMIOS_NORMAL_LON;
    $termios[$TERMIOS_LFLAG] &= ~$TERMIOS_NORMAL_LOFF;
    $termios = pack($termios_t,@termios);
    &ioctl($term_IN,$TCSETS,$termios) || die "Can't ioctl TCSETS: $!";

# print "after ResetTTY\n\r";
# system 'stty -a';
}

=head2 WordBreak

C<WordBreak(index)>

Returns true if the character at I<index> into $line is a basic word
break character, false otherwise.

=cut

sub WordBreak
{
    index($rl_basic_word_break_characters,
	  substr($line,$_[0],1)) != -1;
}

sub getstate
{
    ($D, $si, $LastCommandKilledText, $KillBuffer, $line) = @{$_[0]};
    $ThisCommandKilledText = $LastCommandKilledText;
}

=head2 kill_text

kills from D=$_[0] to $_[1] (to the killbuffer if $_[2] is true)

=cut

sub kill_text
{
    my($from, $to, $save) = (&min($_[0], $_[1]), &max($_[0], $_[1]), $_[2]);
    my $len = $to - $from;
    if ($save) {
        $KillBuffer = '' if !$LastCommandKilledText;
        if ($from < $LastCommandKilledText - 1) {
          $KillBuffer = substr($line, $from, $len) . $KillBuffer;
        } else {
          $KillBuffer .= substr($line, $from, $len);
        }
        $ThisCommandKilledText = 1 + $from;
    }
    substr($line, $from, $len) = '';

    ## adjust $D
    if ($D > $from) {
        $D -= $len;
        $D = $from if $D < $from;
    }
}


###########################################################################
## Bindable functions... pretty much in the same order as in readline.c ###
###########################################################################

=head2 at_end_of_line

Returns true if $D at the end of the line.

=cut

sub at_end_of_line
{
    ($D + &CharSize($D)) == (length($line) + 1);
}

=head2 F_ForwardChar

Move forward (right) $count characters.

=cut

sub F_ForwardChar
{
    my $count = shift;
    return &F_BackwardChar(-$count) if $count < 0;

    while (!&at_end_of_line && $count-- > 0) {
        $D += &CharSize($D);
    }
}

=head2 F_BackwaredChar

Move backward (left) $count characters.

=cut

sub F_BackwardChar
{
    my $count = shift;
    return &F_ForwardChar(-$count) if $count < 0;

    while (($D > 0) && ($count-- > 0)) {
        $D--;                      ## Move back one regardless,
        $D-- if &OnSecondByte($D); ## another if over a big char.
    }
}

=head2 F_BeginningOfLine

Go to beginning of line.

=cut

sub F_BeginningOfLine
{
    $D = 0;
}

=head2 F_EndOfLine

Move to the end of the line.

=cut

sub F_EndOfLine
{
    &F_ForwardChar(100) while !&at_end_of_line;
}


=head2 F_ForwardWord

Move to the end of this/next word.
Done as many times as $count says.

=cut

sub F_ForwardWord
{
    my $count = shift;
    return &F_BackwardWord(-$count) if $count < 0;

    while (!&at_end_of_line && $count-- > 0)
    {
        ## skip forward to the next word (if not already on one)
        &F_ForwardChar(1) while !&at_end_of_line && &WordBreak($D);
        ## skip forward to end of word
        &F_ForwardChar(1) while !&at_end_of_line && !&WordBreak($D);
    }
}

=head2 F_BackwardWord

Move to the beginning of this/next word.
Done as many times as $count says.

=cut

sub F_BackwardWord
{
    my $count = shift;
    return &F_ForwardWord(-$count) if $count < 0;

    while ($D > 0 && $count-- > 0) {
        ## skip backward to the next word (if not already on one)
        &F_BackwardChar(1) while (($D > 0) && &WordBreak($D-1));
        ## skip backward to start of word
        &F_BackwardChar(1) while (($D > 0) && !&WordBreak($D-1));
    }
}

=head2 F_RedrawCurrentLine

Refresh the input line.

=cut

sub F_RedrawCurrentLine
{
    $force_redraw = 1;
}

=head2 F_ClearScreen

Clear the screen and refresh the line.
If given a numeric arg other than 1, simply refreshes the line.

=cut

sub F_ClearScreen
{
    my $count = shift;
    return &F_RedrawCurrentLine if $count != 1;

    $rl_CLEAR = `clear` if !defined($rl_CLEAR);
    local $\ = '';
    print $term_OUT $rl_CLEAR;
    $force_redraw = 1;
}

=head2 F_QuotedInsert

Insert the next character read verbatim.

=cut

sub F_QuotedInsert
{
    my $count = shift;
    &F_SelfInsert($count, ord(&getc_with_pending));
}

=head2 F_TabInsert

Insert a tab.

=cut

sub F_TabInsert
{
    my $count = shift;
    &F_SelfInsert($count, ord("\t"));
}

=head2 F_OperateAndGetNext

Accept the current line and fetch from the history the next line
relative to current line for default.

=cut

sub F_OperateAndGetNext
{
    my $count = shift;

    &F_AcceptLine;

    my $remainingEntries = $#rl_History - $rl_HistoryIndex;
    if ($count > 0 && $remainingEntries >= 0) {  # there is something to repeat
        if ($remainingEntries > 0) {  # if we are not on last line
            $rl_HistoryIndex++;       # fetch next one
            $count = $remainingEntries if $count > $remainingEntries;
        }
        $rl_OperateCount = $count;
    }
}

=head2 F_BackwaredDeleteChar

Removes $count chars to left of cursor (if not at beginning of line).
If $count > 1, deleted chars saved to kill buffer.

=cut

sub F_BackwardDeleteChar
{
    return if remove_selection();

    my $count = shift;
    return F_DeleteChar(-$count) if $count < 0;
    my $oldD = $D;
    &F_BackwardChar($count);
    return if $D == $oldD;
    &kill_text($oldD, $D, $count > 1);
}

=head2 F_DeleteChar

Removes the $count chars from under the cursor.
If there is no line and the last command was different, tells
readline to return EOF.
If there is a line, and the cursor is at the end of it, and we're in
tcsh completion mode, then list possible completions.
If $count > 1, deleted chars saved to kill buffer.

=cut

sub F_DeleteChar
{
    return if remove_selection();

    my $count = shift;
    return F_DeleteBackwardChar(-$count) if $count < 0;
    if (length($line) == 0) {   # EOF sent (probably OK in DOS too)
        $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar';
        return;
    }
    if ($D == length ($line))
    {
        &complete_internal('?') if $var_TcshCompleteMode;
        return;
    }
    my $oldD = $D;
    &F_ForwardChar($count);
    return if $D == $oldD;
    &kill_text($oldD, $D, $count > 1);
}

=head2 F_UnixWordRubout

Kill to previous whitespace.

=cut

sub F_UnixWordRubout
{
    return &F_Ding if $D == 0;
    (my $oldD, local $rl_basic_word_break_characters) = ($D, "\t ");
                             # JP:  Fixed a bug here - both were 'my'
    F_BackwardWord(1);
    kill_text($D, $oldD, 1);
}

=head2 F_UnixLineDiscard

Kill line from cursor to beginning of line.

=cut

sub F_UnixLineDiscard
{
    return &F_Ding if $D == 0;
    kill_text(0, $D, 1);
}

sub F_UpcaseWord     { &changecase($_[0], 'up');   }
sub F_DownCaseWord   { &changecase($_[0], 'down'); }
sub F_CapitalizeWord { &changecase($_[0], 'cap');  }

##
## Translated from GNUs readline.c
## One arg is 'up' to upcase $_[0] words,
##            'down' to downcase them,
##         or something else to capitalize them.
## If $_[0] is negative, the dot is not moved.
##
sub changecase
{
    my $op = $_[1];

    my ($start, $state, $c, $olddot) = ($D, 0);
    if ($_[0] < 0)
    {
        $olddot = $D;
        $_[0] = -$_[0];
    }

    &F_ForwardWord;  ## goes forward $_[0] words.

    while ($start < $D) {
        $c = substr($line, $start, 1);

        if ($op eq 'up') {
            $c = uc $c;
        } elsif ($op eq 'down') {
            $c = lc $c;
        } else { ## must be 'cap'
            if ($state == 1) {
                $c = lc $c;
            } else {
                $c = uc $c;
                $state = 1;
            }
            $state = 0 if $c !~ tr/a-zA-Z//;
        }

        substr($line, $start, 1) = $c;
        $start++;
    }
    $D = $olddot if defined($olddot);
}

sub F_TransposeWords {
    my $c = shift;
    return F_Ding() unless $c;
    # Find "this" word
    F_BackwardWord(1);
    my $p0 = $D;
    F_ForwardWord(1);
    my $p1 = $D;
    return F_Ding() if $p1 == $p0;
    my ($p2, $p3) = ($p0, $p1);
    if ($c > 0) {
      F_ForwardWord($c);
      $p3 = $D;
      F_BackwardWord(1);
      $p2 = $D;
    } else {
      F_BackwardWord(1 - $c);
      $p0 = $D;
      F_ForwardWord(1);
      $p1 = $D;
    }
    return F_Ding() if $p3 == $p2 or $p2 < $p1;
    my $r = substr $line, $p2, $p3 - $p2;
    substr($line, $p2, $p3 - $p2) = substr $line, $p0, $p1 - $p0;
    substr($line, $p0, $p1 - $p0) = $r;
    $D = $c > 0 ? $p3 : $p0 + $p3 - $p2; # End of "this" word after edit
    return 1;
## Exchange words: C-Left, C-right, C-right, C-left.  If positions do
## not overlap, we get two things to transpose.  Repeat count?
}

##
## Switch char at dot with char before it.
## If at the end of the line, switch the previous two...
## (NOTE: this could screw up multibyte characters.. should do correctly)
sub F_TransposeChars
{
    if ($D == length($line) && $D >= 2) {
        substr($line,$D-2,2) = substr($line,$D-1,1).substr($line,$D-2,1);
    } elsif ($D >= 1) {
        substr($line,$D-1,2) = substr($line,$D,1)  .substr($line,$D-1,1);
    } else {
        &F_Ding;
    }
}

sub F_PreviousHistory {
    &get_line_from_history($rl_HistoryIndex - shift);
}

sub F_NextHistory {
    &get_line_from_history($rl_HistoryIndex + shift);
}



sub F_BeginningOfHistory
{
    &get_line_from_history(0);
}

sub F_EndOfHistory
{
    &get_line_from_history(@rl_History);
}

sub F_ReverseSearchHistory
{
    &DoSearch($_[0] >= 0 ? 1 : 0);
}

sub F_ForwardSearchHistory
{
    &DoSearch($_[0] >= 0 ? 0 : 1);
}

sub F_HistorySearchBackward
{
    &DoSearchStart(($_[0] >= 0 ? 1 : 0),substr($line,0,$D));
}

sub F_HistorySearchForward
{
    &DoSearchStart(($_[0] >= 0 ? 0 : 1),substr($line,0,$D));
}

## returns a new $i or -1 if not found.
sub search {
  my ($i, $str) = @_;
  return -1 if $i < 0 || $i > $#rl_History;      ## for safety
  while (1) {
    return $i if rindex($rl_History[$i], $str) >= 0;
    if ($reverse) {
      return -1 if $i-- == 0;
    } else {
      return -1 if $i++ == $#rl_History;
    }
  }
}

sub DoSearch
{
    local $reverse = shift;     # Used in search()
    my $oldline = $line;
    my $oldD = $D;
    my $tmp;

    my $searchstr = '';  ## string we're searching for
    my $I = -1;              ## which history line

    $si = 0;

    while (1)
    {
        if ($I != -1) {
            $line = $rl_History[$I];
            $D += index($rl_History[$I], $searchstr);
        }
        &redisplay( '('.($reverse?'reverse-':'') ."i-search) `$searchstr': ");

        $c = &getc_with_pending;
        if (($KeyMap[ord($c)] || 0) eq 'F_ReverseSearchHistory') {
            if ($reverse && $I != -1) {
                if ($tmp = &search($I-1,$searchstr), $tmp >= 0) {
                    $I = $tmp;
                } else {
                    &F_Ding;
                }
            }
            $reverse = 1;
        } elsif (($KeyMap[ord($c)] || 0) eq 'F_ForwardSearchHistory') {
            if (!$reverse && $I != -1) {
                if ($tmp = &search($I+1,$searchstr), $tmp >= 0) {
                    $I = $tmp;
                } else {
                    &F_Ding;
                }
            }
            $reverse = 0;
        } elsif ($c eq "\007") {  ## abort search... restore line and return
            $line = $oldline;
            $D = $oldD;
            return;
        } elsif (ord($c) < 32 || ord($c) > 126) {
            push(@Pending, $c) if $c ne "\e";
            if ($I < 0) {
                ## just restore
                $line = $oldline;
                $D = $oldD;
            } else {
                #chose this line
                $line = $rl_History[$I];
                $D = index($rl_History[$I], $searchstr);
            }
            &redisplay();
            last;
        } else {
            ## Add this character to the end of the search string and
            ## see if that'll match anything.
            $tmp = &search($I < 0 ? $rl_HistoryIndex-$reverse: $I, $searchstr.$c);
            if ($tmp == -1) {
                &F_Ding;
            } else {
                $searchstr .= $c;
                $I = $tmp;
            }
        }
    }
}

## returns a new $i or -1 if not found.
sub searchStart {
  my ($i, $reverse, $str) = @_;
  $i += $reverse ? - 1: +1;
  return -1 if $i < 0 || $i > $#rl_History;  ## for safety
  while (1) {
    return $i if index($rl_History[$i], $str) == 0;
    if ($reverse) {
      return -1 if $i-- == 0;
    } else {
      return -1 if $i++ == $#rl_History;
    }
  }
}

sub DoSearchStart
{
    my ($reverse,$what) = @_;
    my $i = searchStart($rl_HistoryIndex, $reverse, $what);
    return if $i == -1;
    $rl_HistoryIndex = $i;
    ($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
    F_BeginningOfLine();
    F_ForwardChar(length($what));

}

###########################################################################
###########################################################################

=head2 F_KillLine

delete characters from cursor to end of line.

=cut

sub F_KillLine
{
    my $count = shift;
    return F_BackwardKillLine(-$count) if $count < 0;
    kill_text($D, length($line), 1);
}

=head2 F_BackwardKillLine

Delete characters from cursor to beginning of line.

=cut

sub F_BackwardKillLine
{
    my $count = shift;
    return F_KillLine(-$count) if $count < 0;
    return F_Ding if $D == 0;
    kill_text(0, $D, 1);
}

=head2 TextInsert

C<TextInsert($count, $string)>

=cut

sub TextInsert {
  my $count = shift;
  my $text2add = shift(@_) x $count;
  if ($InsertMode) {
    substr($line,$D,0) .= $text2add;
  } else {
    substr($line,$D,length($text2add)) = $text2add;
  }
  $D += length($text2add);
}

sub F_Yank
{
    remove_selection();
    &TextInsert($_[0], $KillBuffer);
}

sub F_YankPop    {
   1;
   ## not implemented yet
}

sub F_YankNthArg {
   1;
   ## not implemented yet
}

=head2 F_KillWord

Delete characters to the end of the current word. If not on a word, delete to
## the end of the next word.

=cut

sub F_KillWord
{
    my $count = shift;
    return &F_BackwardKillWord(-$count) if $count < 0;
    my $oldD = $D;
    &F_ForwardWord($count);     ## moves forward $count words.
    kill_text($oldD, $D, 1);
}

=head2 F_BackwardKillWord

Delete characters backward to the start of the current word, or, if currently
## not on a word (or just at the start of a word), to the start of the
## previous word.

=cut
sub F_BackwardKillWord
{
    my $count = shift;
    return F_KillWord(-$count) if $count < 0;
    my $oldD = $D;
    &F_BackwardWord($count);    ## moves backward $count words.
    kill_text($D, $oldD, 1);
}

###########################################################################
###########################################################################


=head2 F_Abort

Abort the current input.

=cut
sub F_Abort
{
    &F_Ding;
}


=head2 F_DoLowercaseVersion

If the character that got us here is upper case,
do the lower-case equivalent command.

=cut

sub F_DoLowercaseVersion
{
    my $c = $_[1];
    if (isupper($c)) {
        &do_command(*KeyMap, $_[0], lc($c));
    } else {
        &F_Ding;
    }
}

=head2 F_DoControlVersion

do the equiv with control key...
If the character that got us here is upper case,
do the lower-case equivalent command.

=cut

sub F_DoControlVersion
{
    local *KeyMap = $var_EditingMode;
    my $key = $_[1];

    if ($key == ord('?')) {
        $key = 0x7F;
    } else {
        $key &= ~(0x80 | 0x60);
    }
    &do_command(*KeyMap, $_[0], $key);
}

=head2 F_DoMetaVersion

do the equiv with meta key...

=cut

sub F_DoMetaVersion
{
    local *KeyMap = $var_EditingMode;
    unshift @Pending, chr $_[1];

    &do_command(*KeyMap, $_[0], ord "\e");
}

=head2 F_DoEscVersion

If the character that got us here is Alt-Char,
do the Esc Char equiv...

=cut

sub F_DoEscVersion
{
    my ($ord, $t) = $_[1];
    &F_Ding unless $KeyMap{'Esc'};
    for $t (([ord 'w', '`1234567890-='],
             [ord ',', 'zxcvbnm,./\\'],
             [16,      'qwertyuiop[]'],
             [ord(' ') - 2, 'asdfghjkl;\''])) {
      next unless $ord >= $t->[0] and $ord < $t->[0] + length($t->[1]);
      $ord = ord substr $t->[1], $ord - $t->[0], 1;
      return &do_command($KeyMap{'Esc'}, $_[0], $ord);
    }
    &F_Ding;
}

=head2 F_Undo

Undo one level.


=cut

sub F_Undo
{
    pop(@undo); # unless $undo[-1]->[5]; ## get rid of the state we just put on, so we can go back one.
    if (@undo) {
        &getstate(pop(@undo));
    } else {
        &F_Ding;
    }
}

=head2 F_RevertLine

Replace the current line to some "before" state.

=cut

sub F_RevertLine
{
    if ($rl_HistoryIndex >= $#rl_History+1) {
        $line = $line_for_revert;
    } else {
        $line = $rl_History[$rl_HistoryIndex];
    }
    $D = length($line);
}

sub F_EmacsEditingMode
{
    $var_EditingMode = $var_EditingMode{'emacs'};
    $Vi_mode = 0;
}

###########################################################################
###########################################################################


##
## (Attempt to) interrupt the current program.
##
sub F_Interrupt
{
    local $\ = '';
    print $term_OUT "\r\n";
    &ResetTTY;
    kill ("INT", 0);

    ## We're back.... must not have died.
    $force_redraw = 1;
}

##
## Execute the next character input as a command in a meta keymap.
##
sub F_PrefixMeta
{
    my($count, $keymap) = ($_[0], "$KeyMap{'name'}_$_[1]");
    ##print "F_PrefixMeta [$keymap]\n\r";
    die "<internal error, $_[1]>" unless %$keymap;
    do_command(*$keymap, $count, ord(&getc_with_pending));
}

sub F_UniversalArgument
{
    &F_DigitArgument;
}

##
## For typing a numeric prefix to a command....
##
sub F_DigitArgument
{
    my $in = chr $_[1];
    my ($NumericArg, $sawDigit) = (1, 0);
    my ($increment, $ord);
    ($NumericArg, $sawDigit) = ($_[0], $_[0] !~ /e0$/i)
        if $doingNumArg;        # XXX What if Esc-- 1 ?

    do
    {
        $ord = ord $in;
        if (defined($KeyMap[$ord]) && $KeyMap[$ord] eq 'F_UniversalArgument') {
            $NumericArg *= 4;
        } elsif ($ord == ord('-') && !$sawDigit) {
            $NumericArg = -$NumericArg;
        } elsif ($ord >= ord('0') && $ord <= ord('9')) {
            $increment = ($ord - ord('0')) * ($NumericArg < 0 ? -1 : 1);
            if ($sawDigit) {
                $NumericArg = $NumericArg * 10 + $increment;
            } else {
                $NumericArg = $increment;
                $sawDigit = 1;
            }
        } else {
            local(*KeyMap) = $var_EditingMode;
            &redisplay();
            $doingNumArg = 1;           # Allow NumArg inside NumArg
            &do_command(*KeyMap, $NumericArg . ($sawDigit ? '': 'e0'), $ord);
            return;
        }
        ## make sure it's not toooo big.
        if ($NumericArg > $rl_max_numeric_arg) {
            $NumericArg = $rl_max_numeric_arg;
        } elsif ($NumericArg < -$rl_max_numeric_arg) {
            $NumericArg = -$rl_max_numeric_arg;
        }
        &redisplay(sprintf("(arg %d) ", $NumericArg));
    } while defined($in = &getc_with_pending);
}

sub F_OverwriteMode
{
    $InsertMode = 0;
}

sub F_InsertMode
{
    $InsertMode = 1;
}

sub F_ToggleInsertMode
{
    $InsertMode = !$InsertMode;
}

##
## (Attempt to) suspend the program.
##
sub F_Suspend
{
    if ($inDOS && length($line)==0) { # EOF sent
        $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar';
        return;
    }
    local $\ = '';
    print $term_OUT "\r\n";
    &ResetTTY;
    eval { kill ("TSTP", 0) };
    ## We're back....
    &SetTTY;
    $force_redraw = 1;
}

##
## Ring the bell.
## Should do something with $var_PreferVisibleBell here, but what?
##
sub F_Ding {
    local $\ = '';
    print $term_OUT "\007";
    return;    # Undefined return value
}

##########################################################################
#### command/file completion  ############################################
##########################################################################

##
## List possible completions
##
sub F_PossibleCompletions
{
    &complete_internal('?');
}

##
## List possible completions
##
sub F_InsertPossibleCompletions
{
    &complete_internal('*');
}

##
## Do a completion operation.
## If the last thing we did was a completion operation, we'll
## now list the options available (under normal emacs mode).
##
## Under TcshCompleteMode, each contiguous subsequent completion operation
## lists another of the possible options.
##
## Returns true if a completion was done, false otherwise, so vi completion
##     routines can test it.
##
sub F_Complete
{
    if ($lastcommand eq 'F_Complete') {
        if ($var_TcshCompleteMode && @tcsh_complete_selections > 0) {
            substr($line, $tcsh_complete_start, $tcsh_complete_len)
                = $tcsh_complete_selections[0];
            $D -= $tcsh_complete_len;
            $tcsh_complete_len = length($tcsh_complete_selections[0]);
            $D += $tcsh_complete_len;
            push(@tcsh_complete_selections, shift(@tcsh_complete_selections));
        } else {
            &complete_internal('?') or return;
        }
    } else {
        @tcsh_complete_selections = ();
        &complete_internal("\t") or return;
    }

    1;
}

##
## The meat of command completion. Patterned closely after GNU's.
##
## The supposedly partial word at the cursor is "completed" as per the
## single argument:
##      "\t"    complete as much of the word as is unambiguous
##      "?"     list possibilities.
##      "*"     replace word with all possibilities. (who would use this?)
##
## A few notable variables used:
##   $rl_completer_word_break_characters
##      -- characters in this string break a word.
##   $rl_special_prefixes
##      -- but if in this string as well, remain part of that word.
##
## Returns true if a completion was done, false otherwise, so vi completion
##     routines can test it.
##
sub complete_internal
{
    my $what_to_do = shift;
    my ($point, $end) = ($D, $D);

    # In vi mode, complete if the cursor is at the *end* of a word, not
    #     after it.
    ($point++, $end++) if $Vi_mode;

    if ($point)
    {
        ## Not at the beginning of the line; Isolate the word to be completed.
        1 while (--$point && (-1 == index($rl_completer_word_break_characters,
                substr($line, $point, 1))));

        # Either at beginning of line or at a word break.
        # If at a word break (that we don't want to save), skip it.
        $point++ if (
                (index($rl_completer_word_break_characters,
                       substr($line, $point, 1)) != -1) &&
                (index($rl_special_prefixes, substr($line, $point, 1)) == -1)
        );
    }

    my $text = substr($line, $point, $end - $point);
    $rl_completer_terminator_character = ' ';
    @matches = &completion_matches($rl_completion_function,$text,$line,$point);

    if (@matches == 0) {
        return &F_Ding;
    } elsif ($what_to_do eq "\t") {
        my $replacement = shift(@matches);
        $replacement .= $rl_completer_terminator_character if @matches == 1;
        &F_Ding if @matches != 1;
        if ($var_TcshCompleteMode) {
            @tcsh_complete_selections = (@matches, $text);
            $tcsh_complete_start = $point;
            $tcsh_complete_len = length($replacement);
        }
        if ($replacement ne '') {
            substr($line, $point, $end-$point) = $replacement;
            $D = $D - ($end - $point) + length($replacement);
        }
    } elsif ($what_to_do eq '?') {
        shift(@matches); ## remove prepended common prefix
        local $\ = '';
        print $term_OUT "\n\r";
        # print "@matches\n\r";
        &pretty_print_list (@matches);
        $force_redraw = 1;
    } elsif ($what_to_do eq '*') {
        shift(@matches); ## remove common prefix.
        local $" = $rl_completer_terminator_character;
        my $replacement = "@matches$rl_completer_terminator_character";
        substr($line, $point, $end-$point) = $replacement; ## insert all.
        $D = $D - ($end - $point) + length($replacement);
    } else {
        warn "\r\n[Internal error]";
        return &F_Ding;
    }

    1;
}

##
## completion_matches(func, text, line, start)
##
## FUNC is a function to call as FUNC(TEXT, LINE, START)
##      where TEXT is the item to be completed
##            LINE is the whole command line, and
##            START is the starting index of TEXT in LINE.
## The FUNC should return a list of items that might match.
##
## completion_matches will return that list, with the longest common
## prefix prepended as the first item of the list.  Therefor, the list
## will either be of zero length (meaning no matches) or of 2 or more.....
##

## Works with &rl_basic_commands. Return items from @rl_basic_commands
## that start with the pattern in $text.
sub use_basic_commands {
  my ($text, $line, $start) = @_;
  return () if $start != 0;
  grep(/^$text/, @rl_basic_commands);
}

sub completion_matches
{
    my ($func, $text, $line, $start) = @_;

    ## get the raw list
    my @matches;

    #print qq/\r\neval("\@matches = &$func(\$text, \$line, \$start)\n\r/;#DEBUG
    #eval("\@matches = &$func(\$text, \$line, \$start);1") || warn "$@ ";

    @matches = &$func($text, $line, $start);

    ## if anything returned , find the common prefix among them
    if (@matches) {
        my $prefix = $matches[0];
        my $len = length($prefix);
        for (my $i = 1; $i < @matches; $i++) {
            next if substr($matches[$i], 0, $len) eq $prefix;
            $prefix = substr($prefix, 0, --$len);
            last if $len == 0;
            $i--; ## retry this one to see if the shorter one matches.
        }
        unshift(@matches, $prefix); ## make common prefix the first thing.
    }
    @matches;
}

##
## For use in passing to completion_matches(), returns a list of
## filenames that begin with the given pattern.  The user of this package
## can set $rl_completion_function to 'rl_filename_list' to restore the
## default of filename matching if they'd changed it earlier, either
## directly or via &rl_basic_commands.
##
sub rl_filename_list
{
    my $pattern = $_[0];
    my @files = (<$pattern*>);
    if ($var_CompleteAddsuffix) {
        foreach (@files) {
            if (-l $_) {
                $_ .= '@';
            } elsif (-d _) {
                $_ .= '/';
            } elsif (-x _) {
                $_ .= '*';
            } elsif (-S _ || -p _) {
                $_ .= '=';
            }
        }
    }
    return @files;
}

##
## For use by the user of the package. Called with a list of possible
## commands, will allow command completion on those commands, but only
## for the first word on a line.
## For example: &rl_basic_commands('set', 'quit', 'type', 'run');
##
## This is for people that want quick and simple command completion.
## A more thoughtful implementation would set $rl_completion_function
## to a routine that would look at the context of the word being completed
## and return the appropriate possibilities.
##
sub rl_basic_commands
{
     @rl_basic_commands = @_;
     $rl_completion_function = 'use_basic_commands';
}

##
## Print an array in columns like ls -C.  Originally based on stuff
## (lsC2.pl) by utashiro@sran230.sra.co.jp (Kazumasa Utashiro).
##
sub pretty_print_list
{
    my @list = @_;
    return unless @list;
    my ($lines, $columns, $mark, $index);

    ## find width of widest entry
    my $maxwidth = 0;
    grep(length > $maxwidth && ($maxwidth = length), @list);
    $maxwidth++;

    $columns = $maxwidth >= $rl_screen_width
               ? 1 : int($rl_screen_width / $maxwidth);

    ## if there's enough margin to interspurse among the columns, do so.
    $maxwidth += int(($rl_screen_width % $maxwidth) / $columns);

    $lines = int((@list + $columns - 1) / $columns);
    $columns-- while ((($lines * $columns) - @list + 1) > $lines);

    $mark = $#list - $lines;
    local $\ = '';
    for ($l = 0; $l < $lines; $l++) {
        for ($index = $l; $index <= $mark; $index += $lines) {
            printf("%-$ {maxwidth}s", $list[$index]);
        }
        print $term_OUT $list[$index] if $index <= $#list;
        print $term_OUT "\n\r";
    }
}

##----------------- Vi Routines --------------------------------

sub F_ViAcceptLine
{
    &F_AcceptLine();
    &F_ViInput();
}

# Repeat the most recent one of these vi commands:
#
#   a A c C d D i I p P r R s S x X ~
#
sub F_ViRepeatLastCommand {
    my($count) = @_;
    return &F_Ding if !$Last_vi_command;

    my @lastcmd = @$Last_vi_command;

    # Multiply @lastcmd's numeric arg by $count.
    unless ($count == 1) {

        my $n = '';
        while (@lastcmd and $lastcmd[0] =~ /^\d$/) {
            $n *= 10;
            $n += shift(@lastcmd);
        }
        $count *= $n unless $n eq '';
        unshift(@lastcmd, split(//, $count));
    }

    push(@Pending, @lastcmd);
}

sub F_ViMoveCursor
{
    my($count, $ord) = @_;

    my $new_cursor = &get_position($count, $ord, undef, $Vi_move_patterns);
    return &F_Ding if !defined $new_cursor;

    $D = $new_cursor;
}

sub F_ViFindMatchingParens {

    # Move to the first parens at or after $D
    my $old_d = $D;
    &forward_scan(1, q/[^[\](){}]*/);
    my $parens = substr($line, $D, 1);

    my $mate_direction = {
                    '('  =>  [ ')',  1 ],
                    '['  =>  [ ']',  1 ],
                    '{'  =>  [ '}',  1 ],
                    ')'  =>  [ '(', -1 ],
                    ']'  =>  [ '[', -1 ],
                    '}'  =>  [ '{', -1 ],

                }->{$parens};

    return &F_Ding() unless $mate_direction;

    my($mate, $direction) = @$mate_direction;

    my $lvl = 1;
    while ($lvl) {
        last if !$D && ($direction < 0);
        &F_ForwardChar($direction);
        last if &at_end_of_line;
        my $c = substr($line, $D, 1);
        if ($c eq $parens) {
            $lvl++;
        }
        elsif ($c eq $mate) {
            $lvl--;
        }
    }

    if ($lvl) {
        # We didn't find a match
        $D = $old_d;
        return &F_Ding();
    }
}

sub F_ViForwardFindChar {
    &do_findchar(1, 1, @_);
}

sub F_ViBackwardFindChar {
    &do_findchar(-1, 0, @_);
}

sub F_ViForwardToChar {
    &do_findchar(1, 0, @_);
}

sub F_ViBackwardToChar {
    &do_findchar(-1, 1, @_);
}

sub F_ViMoveCursorTo
{
    &do_findchar(1, -1, @_);
}

sub F_ViMoveCursorFind
{
    &do_findchar(1, 0, @_);
}


sub F_ViRepeatFindChar {
    my($n) = @_;
    return &F_Ding if !defined $Last_findchar;
    &findchar(@$Last_findchar, $n);
}

sub F_ViInverseRepeatFindChar {
    my($n) = @_;
    return &F_Ding if !defined $Last_findchar;
    my($c, $direction, $offset) = @$Last_findchar;
    &findchar($c, -$direction, $offset, $n);
}

sub do_findchar {
    my($direction, $offset, $n) = @_;
    my $c = &getc_with_pending;
    $c = &getc_with_pending if $c eq "\cV";
    return &F_ViCommandMode if $c eq "\e";
    $Last_findchar = [$c, $direction, $offset];
    &findchar($c, $direction, $offset, $n);
}

sub findchar {
    my($c, $direction, $offset, $n) = @_;
    my $old_d = $D;
    while ($n) {
        last if !$D && ($direction < 0);
        &F_ForwardChar($direction);
        last if &at_end_of_line;
        my $char = substr($line, $D, 1);
        $n-- if substr($line, $D, 1) eq $c;
    }
    if ($n) {
        # Not found
        $D = $old_d;
        return &F_Ding;
    }
    &F_ForwardChar($offset);
}

sub F_ViMoveToColumn {
    my($n) = @_;
    $D = 0;
    my $col = 1;
    while (!&at_end_of_line and $col < $n) {
        my $c = substr($line, $D, 1);
        if ($c eq "\t") {
            $col += 7;
            $col -= ($col % 8) - 1;
        }
        else {
            $col++;
        }
        $D += &CharSize($D);
    }
}

sub start_dot_buf {
    my($count, $ord) = @_;
    $Dot_buf = [pack('c', $ord)];
    unshift(@$Dot_buf, split(//, $count)) if $count > 1;
    $Dot_state = savestate();
}

sub end_dot_buf {
    # We've recognized an editing command

    # Save the command keystrokes for use by '.'
    $Last_vi_command = $Dot_buf;
    undef $Dot_buf;

    # Save the pre-command state for use by 'u' and 'U';
    $Vi_undo_state     = $Dot_state;
    $Vi_undo_all_state = $Dot_state if !$Vi_undo_all_state;

    # Make sure the current line is treated as new line for history purposes.
    $rl_HistoryIndex = $#rl_History + 1;
}

sub save_dot_buf {
    &start_dot_buf(@_);
    &end_dot_buf;
}

sub F_ViUndo {
    return &F_Ding unless defined $Vi_undo_state;
    my $state = savestate();
    &getstate($Vi_undo_state);
    $Vi_undo_state = $state;
}

sub F_ViUndoAll {
    $Vi_undo_state = $Vi_undo_all_state;
    &F_ViUndo;
}

sub F_ViChange
{
    my($count, $ord) = @_;
    &start_dot_buf(@_);
    &do_delete($count, $ord, $Vi_change_patterns) || return();
    &vi_input_mode;
}

sub F_ViDelete
{
    my($count, $ord) = @_;
    &start_dot_buf(@_);
    &do_delete($count, $ord, $Vi_delete_patterns);
    &end_dot_buf;
}

sub do_delete {

    my($count, $ord, $poshash) = @_;

    my $other_end = &get_position($count, undef, $ord, $poshash);
    return &F_Ding if !defined $other_end;

    if ($other_end < 0) {
        # dd - delete entire line
        &kill_text(0, length($line), 1);
    }
    else {
        &kill_text($D, $other_end, 1);
    }

    1;    # True return value
}

sub F_ViDeleteChar {
    my($count) = @_;
    &save_dot_buf(@_);
    my $other_end = $D + $count;
    $other_end = length($line) if $other_end > length($line);
    &kill_text($D, $other_end, 1);
}

sub F_ViBackwardDeleteChar {
    my($count) = @_;
    &save_dot_buf(@_);
    my $other_end = $D - $count;
    $other_end = 0 if $other_end < 0;
    &kill_text($other_end, $D, 1);
    $D = $other_end;
}

##
## Prepend line with '#', add to history, and clear the input buffer
##     (this feature was borrowed from ksh).
##
sub F_SaveLine
{
    local $\ = '';
    $line = '#'.$line;
    &redisplay();
    print $term_OUT "\r\n";
    &add_line_to_history($line, $minlength);
    $line_for_revert = '';
    &get_line_from_history(scalar @rl_History);
    &F_ViInput() if $Vi_mode;
}

#
# Come here if we see a non-positioning keystroke when a positioning
#     keystroke is expected.
#
sub F_ViNonPosition {
    # Not a positioning command - undefine the cursor to indicate the error
    #     to get_position().
    undef $D;
}

#
# Come here if we see <esc><char>, but *not* an arrow key or other
#     mapped sequence, when a positioning keystroke is expected.
#
sub F_ViPositionEsc {
    my($count, $ord) = @_;

    # We got <esc><char> in vipos mode.  Put <char> back onto the
    #     input stream and terminate the positioning command.
    unshift(@Pending, pack('c', $ord));
    &F_ViNonPosition;
}

# Interpret vi positioning commands
sub get_position {
    my ($count, $ord, $fullline_ord, $poshash) = @_;

    # Manipulate a copy of the cursor, not the real thing
    local $D = $D;

    # $ord (first character of positioning command) is an optional argument.
    $ord = ord(&getc_with_pending) if !defined $ord;

    # Detect double character (for full-line operation, e.g. dd)
    return -1 if defined $fullline_ord and $ord == $fullline_ord;

    my $re = $poshash->{$ord};

    if ($re) {
        my $c = pack('c', $ord);
        if (lc($c) eq 'b') {
            &backward_scan($count, $re);
        }
        else {
            &forward_scan($count, $re);
        }
    }
    else {
        # Move the local copy of the cursor
        &do_command($var_EditingMode{'vipos'}, $count, $ord);
    }

    # Return the new cursor (undef if illegal command)
    $D;
}

##
## Go to first non-space character of line.
##
sub F_ViFirstWord
{
    $D = 0;
    &forward_scan(1, q{\s+});
}

sub forward_scan {
    my($count, $re) = @_;
    while ($count--) {
        last unless substr($line, $D) =~ m{^($re)};
        $D += length($1);
    }
}

sub backward_scan {
    my($count, $re) = @_;
    while ($count--) {
        last unless substr($line, 0, $D) =~ m{($re)$};
        $D -= length($1);
    }
}

# Note: like the emacs case transforms, this doesn't work for
#       two-byte characters.
sub F_ViToggleCase {
    my($count) = @_;
    &save_dot_buf(@_);
    while ($count-- > 0) {
        substr($line, $D, 1) =~ tr/A-Za-z/a-zA-Z/;
        &F_ForwardChar(1);
        if (&at_end_of_line) {
            &F_BackwardChar(1);
            last;
        }
    }
}

# Go to the numbered history line, as listed by the 'H' command, i.e. the
#     current $line is line 1, the youngest line in @rl_History is 2, etc.
sub F_ViHistoryLine {
    my($n) = @_;
    &get_line_from_history(@rl_History - $n + 1);
}

sub get_line_from_history {
    my($n) = @_;
    return &F_Ding if $n < 0 or $n > @rl_History;
    return if $n == $rl_HistoryIndex;

    # If we're moving from the currently-edited line, save it for later.
    $line_for_revert = $line if $rl_HistoryIndex == @rl_History;

    # Get line from history buffer (or from saved edit line).
    $line = ($n == @rl_History) ? $line_for_revert : $rl_History[$n];
    $D = $Vi_mode ? 0 : length $line;

    # Subsequent 'U' will bring us back to this point.
    $Vi_undo_all_state = savestate() if $Vi_mode;

    $rl_HistoryIndex = $n;
}

sub F_PrintHistory {
    my($count) = @_;

    $count = 20 if $count == 1;             # Default - assume 'H', not '1H'
    my $end = $rl_HistoryIndex + $count/2;
    $end = @rl_History if $end > @rl_History;
    my $start = $end - $count + 1;
    $start = 0 if $start < 0;

    my $lmh = length $rl_MaxHistorySize;

    my $lspace = ' ' x ($lmh+3);
    my $hdr = "$lspace-----";
    $hdr .= " (Use ESC <num> UP to retrieve command <num>) -----" unless $Vi_mode;
    $hdr .= " (Use '<num>G' to retrieve command <num>) -----" if $Vi_mode;

    local ($\, $,) = ('','');
    print "\n$hdr\n";
    print $lspace, ". . .\n" if $start > 0;
    my $i;
    my $shift = ($Vi_mode != 0);
    for $i ($start .. $end) {
        print + ($i == $rl_HistoryIndex) ? '>' : ' ',

                sprintf("%${lmh}d: ", @rl_History - $i + $shift),

                ($i < @rl_History)       ? $rl_History[$i] :
                ($i == $rl_HistoryIndex) ? $line           :
                                           $line_for_revert,

                "\n";
    }
    print $lspace, ". . .\n" if $end < @rl_History;
    print "$hdr\n";

    &force_redisplay();

    &F_ViInput() if $line eq '' && $Vi_mode;
}

# Redisplay the line, without attempting any optimization
sub force_redisplay {
    local $force_redraw = 1;
    &redisplay(@_);
}

# Search history for matching string.  As with vi in nomagic mode, the
#     ^, $, \<, and \> positional assertions, the \* quantifier, the \.
#     character class, and the \[ character class delimiter all have special
#     meaning here.
sub F_ViSearch {
    my($n, $ord) = @_;

    my $c = pack('c', $ord);

    my $str = &get_vi_search_str($c);
    if (!defined $str) {
        # Search aborted by deleting the '/' at the beginning of the line
        return &F_ViInput() if $line eq '';
        return();
    }

    # Null string repeats last search
    if ($str eq '') {
        return &F_Ding unless defined $Vi_search_re;
    }
    else {
        # Convert to a regular expression.  Interpret $str Like vi in nomagic
        #     mode: '^', '$', '\<', and '\>' positional assertions, '\*'
        #     quantifier, '\.' and '\[]' character classes.

        my @chars = ($str =~ m{(\\?.)}g);
        my(@re, @tail);
        unshift(@re,   shift(@chars)) if @chars and $chars[0]  eq '^';
        push   (@tail, pop(@chars))   if @chars and $chars[-1] eq '$';
        my $in_chclass;
        my %chmap = (
            '\<' => '\b(?=\w)',
            '\>' => '(?<=\w)\b',
            '\*' => '*',
            '\[' => '[',
            '\.' => '.',
        );
        my $ch;
        foreach $ch (@chars) {
            if ($in_chclass) {
                # Any backslashes in vi char classes are literal
                push(@re, "\\") if length($ch) > 1;
                push(@re, $ch);
                $in_chclass = 0 if $ch =~ /\]$/;
            }
            else {
                push(@re, (length $ch == 2) ? ($chmap{$ch} || $ch) :
                          ($ch =~ /^\w$/)   ? $ch                  :
                                              ("\\", $ch));
                $in_chclass = 1 if $ch eq '\[';
            }
        }
        my $re = join('', @re, @tail);
        $Vi_search_re = q{$re};
    }

    local $reverse = $Vi_search_reverse = ($c eq '/') ? 1 : 0;
    &do_vi_search();
}

sub F_ViRepeatSearch {
    my($n, $ord) = @_;
    my $c = pack('c', $ord);
    return &F_Ding unless defined $Vi_search_re;
    local $reverse = $Vi_search_reverse;
    $reverse ^= 1 if $c eq 'N';
    &do_vi_search();
}

## returns a new $i or -1 if not found.
sub vi_search {
    my ($i) = @_;
    return -1 if $i < 0 || $i > $#rl_History;    ## for safety
    while (1) {
        return $i if $rl_History[$i] =~ /$Vi_search_re/;
        if ($reverse) {
            return -1 if $i-- == 0;
        } else {
            return -1 if $i++ == $#rl_History;
        }
    }
}

sub do_vi_search {
    my $incr = $reverse ? -1 : 1;

    my $i = &vi_search($rl_HistoryIndex + $incr);
    return &F_Ding if $i < 0;                  # Not found.

    $rl_HistoryIndex = $i;
    ($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
}

# Using local $line, $D, and $prompt, get and return the string to search for.
sub get_vi_search_str {
    my($c) = @_;

    local $prompt = $prompt . $c;
    local ($line, $D) = ('', 0);
    &redisplay();

    # Gather a search string in our local $line.
    while ($lastcommand ne 'F_ViEndSearch') {
        &do_command($var_EditingMode{'visearch'}, 1, ord(&getc_with_pending));
        &redisplay();

        # We've backspaced past beginning of line
        return undef if !defined $line;
    }
    $line;
}

sub F_ViEndSearch {}

sub F_ViSearchBackwardDeleteChar {
    if ($line eq '') {
        # Backspaced past beginning of line - terminate search mode
        undef $line;
    }
    else {
        &F_BackwardDeleteChar(@_);
    }
}

##
## Kill entire line and enter input mode
##
sub F_ViChangeEntireLine
{
    &start_dot_buf(@_);
    kill_text(0, length($line), 1);
    &vi_input_mode;
}

##
## Kill characters and enter input mode
##
sub F_ViChangeChar
{
    &start_dot_buf(@_);
    &F_DeleteChar(@_);
    &vi_input_mode;
}

sub F_ViReplaceChar
{
    &start_dot_buf(@_);
    my $c = &getc_with_pending;
    $c = &getc_with_pending if $c eq "\cV";   # ctrl-V
    return &F_ViCommandMode if $c eq "\e";
    &end_dot_buf;

    local $InsertMode = 0;
    local $D = $D;                  # Preserve cursor position
    &F_SelfInsert(1, ord($c));
}

=head2 F_ViChangeLine

Delete characteres from cursor to end of line and enter VI input mode.

=cut

sub F_ViChangeLine
{
    &start_dot_buf(@_);
    &F_KillLine(@_);
    &vi_input_mode;
}

sub F_ViDeleteLine
{
    &save_dot_buf(@_);
    &F_KillLine(@_);
}

sub F_ViPut
{
    my($count) = @_;
    &save_dot_buf(@_);
    my $text2add = $KillBuffer x $count;
    my $ll = length($line);
    $D++;
    $D = $ll if $D > $ll;
    substr($line, $D, 0) = $KillBuffer x $count;
    $D += length($text2add) - 1;
}

sub F_ViPutBefore
{
    &save_dot_buf(@_);
    &TextInsert($_[0], $KillBuffer);
}

sub F_ViYank
{
    my($count, $ord) = @_;
    my $pos = &get_position($count, undef, $ord, $Vi_yank_patterns);
    &F_Ding if !defined $pos;
    if ($pos < 0) {
        # yy
        &F_ViYankLine;
    }
    else {
        my($from, $to) = ($pos > $D) ? ($D, $pos) : ($pos, $D);
        $KillBuffer = substr($line, $from, $to-$from);
    }
}

sub F_ViYankLine
{
    $KillBuffer = $line;
}

sub F_ViInput
{
    @_ = (1, ord('i')) if !@_;
    &start_dot_buf(@_);
    &vi_input_mode;
}

sub F_ViBeginInput
{
    &start_dot_buf(@_);
    &F_BeginningOfLine;
    &vi_input_mode;
}

sub F_ViReplaceMode
{
    &start_dot_buf(@_);
    $InsertMode = 0;
    $var_EditingMode = $var_EditingMode{'vi'};
    $Vi_mode = 1;
}

sub vi_input_mode
{
    $InsertMode = 1;
    $var_EditingMode = $var_EditingMode{'vi'};
    $Vi_mode = 1;
}

# The previous keystroke was an escape, but the sequence was not recognized
#     as a mapped sequence (like an arrow key).  Enter vi comand mode and
#     process this keystroke.
sub F_ViAfterEsc {
    my($n, $ord) = @_;
    &F_ViCommandMode;
    &do_command($var_EditingMode, 1, $ord);
}

sub F_ViAppend
{
    &start_dot_buf(@_);
    &vi_input_mode;
    &F_ForwardChar;
}

sub F_ViAppendLine
{
    &start_dot_buf(@_);
    &vi_input_mode;
    &F_EndOfLine;
}

sub F_ViCommandMode
{
    $var_EditingMode = $var_EditingMode{'vicmd'};
    $Vi_mode = 1;
}

sub F_ViAcceptInsert {
    local $in_accept_line = 1;
    &F_ViEndInsert;
    &F_ViAcceptLine;
}

sub F_ViEndInsert
{
    if ($Dot_buf) {
        if ($line eq '' and $Dot_buf->[0] eq 'i') {
            # We inserted nothing into an empty $line - assume it was a
            #     &F_ViInput() call with no arguments, and don't save command.
            undef $Dot_buf;
        }
        else {
            # Regardless of which keystroke actually terminated this insert
            #     command, replace it with an <esc> in the dot buffer.
            @{$Dot_buf}[-1] = "\e";
            &end_dot_buf;
        }
    }
    &F_ViCommandMode;
    # Move cursor back to the last inserted character, but not when
    # we're about to accept a line of input
    &F_BackwardChar(1) unless $in_accept_line;
}

sub F_ViDigit {
    my($count, $ord) = @_;

    my $n = 0;
    my $ord0 = ord('0');
    while (1) {

        $n *= 10;
        $n += $ord - $ord0;

        my $c = &getc_with_pending;
        return unless defined $c;
        $ord = ord($c);
        last unless $c =~ /^\d$/;
    }

    $n *= $count;                   # So  2d3w  deletes six words
    $n = $rl_max_numeric_arg if $n > $rl_max_numeric_arg;

    &do_command($var_EditingMode, $n, $ord);
}

sub F_ViComplete {
    my($n, $ord) = @_;

    $Dot_state = savestate();     # Completion is undo-able
    undef $Dot_buf;              #       but not redo-able

    my $ch;
    while (1) {

        &F_Complete() or return;

        # Vi likes the cursor one character right of where emacs like it.
        &F_ForwardChar(1);
        &force_redisplay();

        # Look ahead to the next input keystroke.
        $ch = &getc_with_pending();
        last unless ord($ch) == $ord;   # Not a '\' - quit.

        # Another '\' was typed - put the cursor back where &F_Complete left
        #     it, and try again.
        &F_BackwardChar(1);
        $lastcommand = 'F_Complete';   # Play along with &F_Complete's kludge
    }
    unshift(@Pending, $ch);      # Unget the lookahead keystroke

    # Successful completion - enter input mode with cursor beyond end of word.
    &vi_input_mode;
}

sub F_ViInsertPossibleCompletions {
    $Dot_state = savestate();     # Completion is undo-able
    undef $Dot_buf;              #       but not redo-able

    &complete_internal('*') or return;

    # Successful completion - enter input mode with cursor beyond end of word.
    &F_ForwardChar(1);
    &vi_input_mode;
}

sub F_ViPossibleCompletions {

    # List possible completions
    &complete_internal('?');

    # Enter input mode with cursor where we left off.
    &F_ForwardChar(1);
    &vi_input_mode;
}

sub F_SetMark {
    $rl_mark = $D;
    pos $line = $rl_mark;
    $line_rl_mark = $rl_HistoryIndex;
    $force_redraw = 1;
}

sub F_ExchangePointAndMark {
    return F_Ding unless $line_rl_mark == $rl_HistoryIndex;
    ($rl_mark, $D) = ($D, $rl_mark);
    pos $line = $rl_mark;
    $D = length $line if $D > length $line;
    $force_redraw = 1;
}

sub F_KillRegion {
    return F_Ding unless $line_rl_mark == $rl_HistoryIndex;
    $rl_mark = length $line if $rl_mark > length $line;
    kill_text($rl_mark, $D, 1);
    $line_rl_mark = -1;         # Disable mark
}

sub F_CopyRegionAsKill {
    return F_Ding unless $line_rl_mark == $rl_HistoryIndex;
    $rl_mark = length $line if $rl_mark > length $line;
    my ($s, $e) = ($rl_mark, $D);
    ($s, $e) = ($e, $s) if $s > $e;
    $ThisCommandKilledText = 1 + $s;
    $KillBuffer = '' if !$LastCommandKilledText;
    $KillBuffer .= substr($line, $s, $e - $s);
}

sub clipboard_set {
    my $in = shift;
    if ($^O eq 'os2') {
      eval {
        require OS2::Process;
        OS2::Process::ClipbrdText_set($in); # Do not disable \r\n-conversion
        1
      } and return;
    } elsif ($^O eq 'MSWin32') {
      eval {
        require Win32::Clipboard;
        Win32::Clipboard::Set($in);
        1
      } and return;
    }
    my $mess;
    if ($ENV{RL_CLCOPY_CMD}) {
      $mess = "Writing to pipe `$ENV{RL_CLCOPY_CMD}'";
      open COPY, "| $ENV{RL_CLCOPY_CMD}" or warn("$mess: $!"), return;
    } elsif (defined $HOME) {
	my $cutpastefile = File::Spec($HOME, '.rl_cutandpaste');
      $mess = "Writing to file `$cutpastefile'";
      open COPY, "> $cutpastefile" or warn("$mess: $!"), return;
    } else {
      return;
    }
    print COPY $in;
    close COPY or warn("$mess: closing $!");
}

sub F_CopyRegionAsKillClipboard {
    return clipboard_set($line) unless $line_rl_mark == $rl_HistoryIndex;
    &F_CopyRegionAsKill;
    clipboard_set($KillBuffer);
}

sub F_KillRegionClipboard {
    &F_KillRegion;
    clipboard_set($KillBuffer);
}

sub F_YankClipboard
{
    remove_selection();
    my $in;
    if ($^O eq 'os2') {
      eval {
        require OS2::Process;
        $in = OS2::Process::ClipbrdText();
        $in =~ s/\r\n/\n/g;             # With old versions, or what?
      }
    } elsif ($^O eq 'MSWin32') {
      eval {
        require Win32::Clipboard;
        $in = Win32::Clipboard::GetText();
        $in =~ s/\r\n/\n/g;  # is this needed?
      }
    } else {
      my $mess;
      if ($ENV{RL_PASTE_CMD}) {
        $mess = "Reading from pipe `$ENV{RL_PASTE_CMD}'";
        open PASTE, "$ENV{RL_PASTE_CMD} |" or warn("$mess: $!"), return;
      } elsif (defined $HOME) {
	my $cutpastefile = File::Spec($HOME, '.rl_cutandpaste');
        $mess = "Reading from file `$cutpastefile'";
        open PASTE, "< $cutpastefile" or warn("$mess: $!"), return;
      }
      if ($mess) {
        local $/;
        $in = <PASTE>;
        close PASTE or warn("$mess, closing: $!");
      }
    }
    if (defined $in) {
        $in =~ s/\n+$//;
        return &TextInsert($_[0], $in);
    }
    &TextInsert($_[0], $KillBuffer);
}

sub F_BeginUndoGroup {
    push @undoGroupS, $#undo;
}

sub F_EndUndoGroup {
    return F_Ding unless @undoGroupS;
    my $last = pop @undoGroupS;
    return unless $#undo > $last + 1;
    my $now = pop @undo;
    $#undo = $last;
    push @undo, $now;
}

sub F_DoNothing {               # E.g., reset digit-argument
    1;
}

sub F_ForceMemorizeDigitArgument {
    $memorizedArg = shift;
}

sub F_MemorizeDigitArgument {
    return if defined $memorizedArg;
    $memorizedArg = shift;
}

sub F_UnmemorizeDigitArgument {
    $memorizedArg = undef;
}

sub F_MemorizePos {
    $memorizedPos = $D;
}

# It is assumed that F_MemorizePos was called, then something was inserted,
# then F_MergeInserts is called with a prefix argument to multiply
# insertion by

sub F_MergeInserts {
    my $n = shift;
    return F_Ding unless defined $memorizedPos and $n > 0;
    my ($b, $e) = ($memorizedPos, $D);
    ($b, $e) = ($e, $b) if $e < $b;
    if ($n) {
        substr($line, $e, 0) = substr($line, $b, $e - $b) x ($n - 1);
    } else {
        substr($line, $b, $e - $b) = '';
    }
    $D = $b + ($e - $b) * $n;
}

sub F_ResetDigitArgument {
    return F_Ding unless defined $memorizedArg;
    my $in = &getc_with_pending;
    return unless defined $in;
    my $ord = ord $in;
    local(*KeyMap) = $var_EditingMode;
    &do_command(*KeyMap, $memorizedArg, $ord);
}

sub F_BeginPasteGroup {
    my $c = shift;
    $memorizedArg = $c unless defined $memorizedArg;
    F_BeginUndoGroup(1);
    $memorizedPos = $D;
}

sub F_EndPasteGroup {
    my $c = $memorizedArg;
    undef $memorizedArg;
    $c = 1 unless defined $c;
    F_MergeInserts($c);
    F_EndUndoGroup(1);
}

sub F_BeginEditGroup {
    $memorizedArg = shift;
    F_BeginUndoGroup(1);
}

sub F_EndEditGroup {
    undef $memorizedArg;
    F_EndUndoGroup(1);
}

1;
