package readline;
my $autoload_broken = 1; my $useioctl = 1;
my $usestty = 1;
my $max_include_depth = 10;
BEGIN { *ioctl = sub ($$$) { eval { ioctl $_[0], $_[1], $_[2] } };
}
$VERSION = $VERSION = '1.0302';
$rl_getc = \&rl_getc;
&preinit;
&init;
sub get_window_size
{
my $sig = shift;
my ($num_cols,$num_rows);
if (defined $term_readkey) {
($num_cols,$num_rows) = Term::ReadKey::GetTerminalSize($term_OUT);
$rl_screen_width = $num_cols - $rl_correct_sw
if defined($num_cols) && $num_cols;
} elsif (defined $TIOCGWINSZ and &ioctl($term_IN,$TIOCGWINSZ,$winsz)) {
($num_rows,$num_cols) = unpack($winsz_t,$winsz);
$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 $hook (@winchhooks) {
eval {&$hook()}; warn $@ if $@ and $^W;
}
local $^W = 0; $SIG{'WINCH'} = "readline::get_window_size";
}
sub preinit
{
$term_IN = \*STDIN unless defined $term_IN;
$term_OUT = \*STDOUT unless defined $term_OUT;
$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;
$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;
for ('InputMeta', 'OutputMeta') {
${"var_$_"} = 1;
${"var_$_"}{'Off'} = 0;
${"var_$_"}{'On'} = 1;
}
for ('ConvertMeta', 'MetaFlag', 'MarkModifiedLines', 'PreferVisibleBell',
'BlinkMatchingParen', 'VisibleStats', 'ShowAllIfAmbiguous',
'PrintCompletionsHorizontally', 'MarkDirectories', 'ExpandTilde',
'EnableKeypad', 'DisableCompletion', 'CompletionIgnoreCase') {
${"var_$_"} = 0;
${"var_$_"}{'Off'} = 0;
${"var_$_"}{'On'} = 1;
}
$minlength = 1 unless defined $minlength;
@winchhooks = ();
$inDOS = $^O eq 'os2' || defined $ENV{OS2_SHELL} unless defined $inDOS;
eval {
require Term::ReadKey; $term_readkey++;
} unless defined $ENV{PERL_RL_USE_TRK}
and not $ENV{PERL_RL_USE_TRK};
unless ($term_readkey) {
eval {require "ioctl.pl"}; eval {require "sys/ioctl.ph"}; eval {require "sgtty.ph"}; 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);
$ECHO = &ECHO if defined(&ECHO);
$RAW = &RAW if defined(&RAW);
$RAW = 040 if !defined($RAW);
$ECHO = 010 if !defined($ECHO);
$mode = $RAW;
$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);
$winsz = pack($winsz_t,0,0,0,0);
$fionread_t = "L";
$fion = pack($fionread_t, 0);
$NCCS = 17;
$termios_t = "LLLLc" . ("c" x $NCCS); $termios = ''; $termios = pack($termios, 0); $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) unless defined $rl_last_pos_can_backspace;
$rl_start_default_at_beginning = 0;
$rl_vi_replace_default_on_insert = 0;
$rl_screen_width = 79;
$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
@rl_History=() if !(@rl_History);
$rl_MaxHistorySize = 100 if !defined($rl_MaxHistorySize);
$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', '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' : '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', qq/"\eOs"/, 'HistorySearchForward', qq/"\e[[A"/, 'previous-history',
qq/"\e[[B"/, 'next-history',
qq/"\e[[C"/, 'forward-char',
qq/"\e[[D"/, 'backward-char',
qq/"\e[2~"/, 'ToggleInsertMode', qq/"\e[2;2~"/, 'YankClipboard', qq/"\e[3;2~"/, 'KillRegionClipboard', qq/"\eO5D"/, 'BackwardWord', qq/"\eO5C"/, 'ForwardWord', qq/"\e[5D"/, 'BackwardWord', qq/"\e[5C"/, 'ForwardWord', qq/"\eO5F"/, 'KillLine', qq/"\e[5F"/, 'KillLine', qq/"\e[4;5~"/, 'KillLine', qq/"\eO5s"/, 'EndOfHistory', qq/"\e[6;5~"/, 'EndOfHistory', qq/"\e[5H"/, 'BackwardKillLine', qq/"\eO5H"/, 'BackwardKillLine', qq/"\e[1;5~"/, 'BackwardKillLine', qq/"\eO5y"/, 'BeginningOfHistory', qq/"\e[5;5y"/, 'BeginningOfHistory', qq/"\e[2;5~"/, 'CopyRegionAsKillClipboard', qq/"\e[3;5~"/, 'KillWord',
qq/"\e[200~"/, 'BeginPasteGroup', qq/"\e[201~"/, 'EndPasteGroup', qq/"\e[202~"/, 'BeginEditGroup', qq/"\e[203~"/, 'EndEditGroup',
qq/"\eOH"/, 'BeginningOfLine', qq/"\eOF"/, 'EndOfLine',
qq/"\e[H"/, 'BeginningOfLine', qq/"\e[5~"/, 'HistorySearchBackward', qq/"\e[6~"/, 'HistorySearchForward', qq/"\e[\0"/, 'BeginningOfLine',
($^O =~ /^hp\W?ux/i ? (
qq/"\e[1~"/, 'HistorySearchForward', qq/"\e[3~"/, 'ToggleInsertMode', qq/"\e[4~"/, 'ToggleInsertMode', ) : ( qq/"\e[1~"/, 'BeginningOfLine', qq/"\e[3~"/, 'DeleteChar', qq/"\e[4~"/, 'EndOfLine', )),
(($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
(
qq/"\eA"/, 'PreviousHistory', qq/"\eB"/, 'NextHistory', qq/"\eC"/, 'ForwardChar', qq/"\eD"/, 'BackwardChar', qq/"\eS"/, 'BeginningOfHistory', qq/"\eT"/, 'EndOfHistory', qq/"\e&r1R"/, 'EndOfLine', qq/"\e&r1L"/, 'BeginningOfLine', qq/"\eJ"/, 'ClearScreen', qq/"\eM"/, 'UnixLineDiscard', qq/"\eK"/, 'KillLine', qq/"\eG\eK"/, 'BackwardKillLine', qq/"\eP"/, 'DeleteChar', qq/"\eL"/, 'Yank', qq/"\eQ"/, 'ToggleInsertMode', qq/"\eV"/, 'HistorySearchBackward', qq/"\eU"/, 'HistorySearchForward', qq/"\eh"/, 'BeginningOfLine', qq/"\eF"/, 'EndOfLine', qq/"\ei"/, 'Suspend', ) :
()
),
($inDOS ?
(
qq/"\0\2"/, 'SetMark', qq/"\0\3"/, 'SetMark', qq/"\0\4"/, 'YankClipboard', qq/"\0\5"/, 'KillRegionClipboard', qq/"\0\16"/, 'Undo', qq/"\0\65"/, 'PossibleCompletions', qq/"\0\107"/, 'BeginningOfLine', qq/"\0\110"/, 'previous-history', qq/"\0\111"/, 'HistorySearchBackward', qq/"\0\113"/, 'backward-char', qq/"\0\115"/, 'forward-char', qq/"\0\117"/, 'EndOfLine', qq/"\0\120"/, 'next-history', qq/"\0\121"/, 'HistorySearchForward', qq/"\0\122"/, 'ToggleInsertMode', qq/"\0\123"/, 'DeleteChar', qq/"\0\163"/, 'BackwardWord', qq/"\0\164"/, 'ForwardWord', qq/"\0\165"/, 'KillLine', qq/"\0\166"/, 'EndOfHistory', qq/"\0\167"/, 'BackwardKillLine', qq/"\0\204"/, 'BeginningOfHistory', qq/"\0\x92"/, 'CopyRegionAsKillClipboard', qq/"\0\223"/, 'KillWord', qq/"\0#"/, 'PrintHistory', )
: ( 'C-@', 'Ding')
)
);
*KeyMap = *emacs_keymap;
my @add_bindings = ();
foreach ('-', '0' .. '9') { push(@add_bindings, "M-$_", 'DigitArgument'); }
foreach ("A" .. "Z") {
next if defined $ {"$KeyMap{name}_27"}[ord $_];
push(@add_bindings, "M-$_", 'DoLowercaseVersion');
}
if ($inDOS) {
$ {"$KeyMap{name}_0"}{'Esc'} = *{"$KeyMap{name}_27"};
$ {"$KeyMap{name}_0"}{'default'} = 'F_DoEscVersion';
}
&rl_bind(@add_bindings);
&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',
);
&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', qq/"\0\120"/, 'NextHistory', qq/"\0\113"/, 'BackwardChar', qq/"\0\115"/, 'ForwardChar', "\e", 'ViCommandMode',
) :
(('M-C-j','EmacsEditingMode'), (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
(
qq/"\eA"/, 'PreviousHistory', qq/"\eB"/, 'NextHistory', qq/"\eC"/, 'ForwardChar', qq/"\eD"/, 'BackwardChar', qq/"\e\\*"/, 'ViAfterEsc',
) :
(
qq/"\e[A"/, 'PreviousHistory', qq/"\e[B"/, 'NextHistory', qq/"\e[C"/, 'ForwardChar', qq/"\e[D"/, 'BackwardChar', qq/"\e\\*"/, 'ViAfterEsc',
qq/"\e[\\*"/, 'ViAfterEsc',
)
))),
);
&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',
($inDOS ?
(
qq/"\0\115"/, 'ForwardChar', qq/"\0\113"/, 'BackwardChar', "\e", 'ViPositionEsc',
) :
($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
(
qq/"\eC"/, 'ForwardChar', qq/"\eD"/, 'BackwardChar', qq/"\e\\*"/, 'ViPositionEsc',
) :
(
qq/"\e[C"/, 'ForwardChar', qq/"\e[D"/, 'BackwardChar', qq/"\e\\*"/, 'ViPositionEsc',
qq/"\e[\\*"/, 'ViPositionEsc',
)
),
);
&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',
);
$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};
1; }
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) { $stdin_not_tty = 1;
} else {
&get_window_size;
&F_ReReadInitFile if !defined($rl_NoInitFromFile);
$InputLocMsg = '';
*KeyMap = $var_EditingMode;
}
$initialized = 1;
}
sub InitKeymap
{
local(*KeyMap) = shift(@_);
my $default = shift(@_);
my $name = $KeyMap{'name'} = shift(@_);
if ($default ne '') {
my $func = $KeyMap{'default'} = "F_$default";
die qq/Bad default function [$func] for keymap "$name"/
if !$autoload_broken and !defined(&$func);
}
&rl_bind if @_ > 0; }
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);
local(*KeyMap) = $var_EditingMode;
$doingNumArg = 1; &do_command(*KeyMap, $c, ord $in);
return;
}
}
sub _unescape ($) {
my($key, @keys) = shift;
while (length($key) > 0) {
if ($key =~ s push(@keys, ord("\e"), &ctrl(ord($1)));
} elsif ($key =~ s push(@keys, ord("\e"));
} elsif ($key =~ s push(@keys, &ctrl(ord($1)));
} elsif ($key =~ s push(@keys, eval('0x'.$1));
} elsif ($key =~ s push(@keys, eval('0'.$1));
} elsif ($key =~ s push(@keys, 'default');
} elsif ($key =~ s push(@keys, ord(eval(qq("\\$1"))));
} elsif ($key =~ s push(@keys, 4); } elsif ($key =~ s push(@keys, 0x7f); } elsif ($key =~ s push(@keys, ord($1));
} else {
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";
}
}
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;
}
my $name = $KeyMap{'name'};
if ($key eq 'default') { 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;
}
}
}
sub rl_bind
{
my (@keys, $key, $func, $ord, @arr);
while (defined($key = shift(@_)) && defined($func = shift(@_)))
{
unless ($func =~ /^[\"\']/) {
$func = "\u$func";
$func =~ s/-(.)/\u$1/g;
if (!$autoload_broken and !defined($ {'readline::'}{"F_$func"})) {
warn "Warning$InputLocMsg: bad bind function [$func]\n" if $^W;
next;
}
}
@keys = ();
if ($key =~ m/"((?:\\.|[^\\])*)"/s) {
@keys = _unescape "$1";
} else {
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?
$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);
}
push @arr, $func, [@keys];
}
&actually_do_binding(@arr);
}
sub read_an_init_file {
my $file = shift;
my $include_depth = shift;
local *RC;
$file =~ s/^~([\\\/])/$ENV{HOME}$1/ if not -f $file and exists $ENV{HOME};
return unless open RC, "< $file";
my (@action) = ('exec'); my (@level) = ();
local $/ = "\n";
while (<RC>) {
s/^\s+//;
next if m/^\s*( $InputLocMsg = " [$file line $.]";
if (/^\$if\s+(.*)/) {
my($test) = $1;
push(@level, 'if');
if ($action[$ push(@action, 'ignore');
} else {
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[$ if ($action[$ $action[$ } else {
$action[$ }
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[$ } elsif (m/\s*set\s+(\S+)\s+(\S*)/) { &rl_set($1, $2, $file);
} elsif (m/^\s*(\S+):\s+("(?:\\.|[^\\\"])*"|'(\\.|[^\\\'])*')/) { &rl_bind($1, $2);
} elsif (m/^\s*(\S+):\s+(\S+)/) { &rl_bind($1, $2);
} else {
chomp;
warn "\rWarning$InputLocMsg: Bad line [$_]\n" if $^W;
}
}
close(RC);
}
sub F_ReReadInitFile
{
my ($file) = $ENV{'TRP_INPUTRC'};
$file = $ENV{'INPUTRC'} unless defined $file;
unless (defined $file) {
return unless defined $ENV{'HOME'};
$file = "$ENV{'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::Perl::term->ornaments();
eval {
require Term::Cap;
my $terminal = Tgetent Term::Cap ({OSPEED=>9600});
$terminal->Trequire('mr');
};
if (!$@ and $Orig ne ',,,'){
my @set = @$rl_term_set;
$Term::ReadLine::Perl::term->ornaments
(join(',', (split(/,/, $Orig))[0,1]) . ',mr,me') ;
@set[4,5] = @$rl_term_set[2,3];
$Term::ReadLine::Perl::term->ornaments($Orig);
@$rl_term_set = @set;
} else {
@$rl_term_set[4,5] = @$rl_term_set[2,3];
}
}
sub readline_dumb {
local $\ = '';
print $term_OUT $prompt;
local $/ = "\n";
return undef
if !defined($line = $Term::ReadLine::Perl::term->get_line);
chomp($line);
$| = $oldbar;
select $old;
return $line;
}
sub readline
{
$Term::ReadLine::Perl::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 = defined($_[0]) ? $_[0] : 'INPUT> ';
print $term_OUT ' ' x ($rl_screen_width - !$rl_last_pos_can_backspace) . "\b \r"
if $rl_scroll_nextline;
if ($dumb_term) {
return readline_dumb;
}
if ($rl_OperateCount > 0 && (!defined $_[1] || $_[1] eq '')) {
$line = $rl_History[$rl_HistoryIndex];
} else {
$rl_HistoryIndex = $ $rl_OperateCount = 0;
$line = defined $_[1] ? $_[1] : '';
}
$rl_OperateCount-- if $rl_OperateCount > 0;
$line_for_revert = $line;
$D = $rl_start_default_at_beginning ? 0 : length($line); $LastCommandKilledText = 0; $lastcommand = ''; $line_rl_mark = -1;
$lastredisplay = ''; $lastlen = length($lastredisplay);
$lastpromptlen = 0;
$lastdelta = 0; $si = 0; $force_redraw = 1; if (!eval {SetTTY()}) { warn $@ if $@;
$dumb_term = 1;
return readline_dumb;
}
*KeyMap = $var_EditingMode;
undef($AcceptLine); undef($ReturnEOF); @Pending = (); @undo = (); @undoGroupS = (); undef $memorizedArg; undef $memorizedPos;
undef $Vi_undo_state;
undef $Vi_undo_all_state;
if ($KeyMap{'name'} eq 'vi_keymap'){
&F_ViInput();
if ($rl_vi_replace_default_on_insert){
local $^W=0;
my $Orig = $Term::ReadLine::Perl::term->ornaments();
eval {
require Term::Cap;
my $terminal = Tgetent Term::Cap ({OSPEED=>9600});
$terminal->Trequire('mr');
};
if (!$@ and $Orig ne ',,,'){
$Term::ReadLine::Perl::term->ornaments
(join(',', (split(/,/, $Orig))[0,1]) . ',mr,me')
}
my $F_SelfInsert_Real = \&F_SelfInsert;
*F_SelfInsert = sub {
$Term::ReadLine::Perl::term->ornaments($Orig);
&F_ViChangeEntireLine;
local $^W=0;
*F_SelfInsert = $F_SelfInsert_Real;
&F_SelfInsert;
};
my $F_ViEndInsert_Real = \&F_ViEndInsert;
*F_ViEndInsert = sub {
$Term::ReadLine::Perl::term->ornaments($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(); }
&F_OperateAndGetNext($rl_OperateCount) if $rl_OperateCount > 0;
$rl_first_char = 1;
while (!defined($AcceptLine)) {
$input = &getc_with_pending();
unless (defined $input) {
$AcceptLine = $ReturnEOF = 1;
last;
}
preserve_state();
$ThisCommandKilledText = 0;
my $cmd = get_command($var_EditingMode, ord($input));
if ( $rl_first_char && $cmd =~ /^F_(SelfInsert$|Yank)/
&& length $line && $rl_default_selected ) {
$line = '';
$D = 0;
$cmd = 'F_BackwardDeleteChar' if $cmd eq 'F_DeleteChar';
}
undef $doingNumArg;
&$cmd(1, ord($input)); $rl_first_char = 0;
$lastcommand = $cmd;
*KeyMap = $var_EditingMode;
&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; undef @undoGroupS; &ResetTTY; $| = $oldbar;
select $old;
return undef if defined($ReturnEOF);
$AcceptLine; }
sub ctrl {
$_[0] ^ (($_[0]>=ord('a') && $_[0]<=ord('z')) ? 0x60 : 0x40);
}
sub SetTTY {
return if $dumb_term || $stdin_not_tty;
if (defined $term_readkey) {
Term::ReadKey::ReadMode(4, $term_IN);
if ($^O eq 'MSWin32') {
binmode $term_IN;
}
return 1;
}
$sgttyb = ''; if ($useioctl && $^O ne 'solaris' && defined $TIOCGETP
&& &ioctl($term_IN,$TIOCGETP,$sgttyb)) {
@tty_buf = unpack($sgttyb_t,$sgttyb);
if (defined $ENV{OS2_SHELL}) {
$tty_buf[3] &= ~$mode;
$tty_buf[3] &= ~$ECHO;
} else {
$tty_buf[4] |= $mode;
$tty_buf[4] &= ~$ECHO;
}
$sgttyb = pack($sgttyb_t,@tty_buf);
&ioctl($term_IN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!";
} elsif (!$usestty) {
return 0;
} else {
warn <<EOW if $useioctl and not defined $ENV{PERL_READLINE_NOWARN};
Can't ioctl TIOCGETP: $!
Consider installing Term::ReadKey from CPAN site nearby
at http://www.perl.com/CPAN
Or use
perl -MCPAN -e shell
to reach CPAN. Falling back to 'stty'.
If you do not want to see this warning, set PERL_READLINE_NOWARN
in your environment.
EOW
# '; $useioctl = 0;
system 'stty raw -echo' and ($usestty = 0, die "Cannot call `stty': $!");
if ($^O eq 'MSWin32') {
binmode $term_IN;
}
}
return 1;
}
sub ResetTTY {
return if $dumb_term || $stdin_not_tty;
if (defined $term_readkey) {
return Term::ReadKey::ReadMode(0, $term_IN);
}
if ($useioctl) {
&ioctl($term_IN,$TIOCGETP,$sgttyb) || die "Can't ioctl TIOCGETP: $!";
@tty_buf = unpack($sgttyb_t,$sgttyb);
if (defined $ENV{OS2_SHELL}) {
$tty_buf[3] |= $mode;
$tty_buf[3] |= $ECHO;
} else {
$tty_buf[4] &= ~$mode;
$tty_buf[4] |= $ECHO;
}
$sgttyb = pack($sgttyb_t,@tty_buf);
&ioctl($term_IN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!";
} elsif ($usestty) {
system 'stty -raw echo' and die "Cannot call `stty': $!";
}
}
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::Perl, please report to its author cpan@ilyaz.org';
$ket = '';
}
$ket = '' if $len < length($p) + length($s) - $from;
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) { return $s;
} elsif (!length $s) { return $p;
} else { 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(); @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3];
$force_redraw = 1;
}
sub redisplay
{
local($prompt) = defined($_[0]) ? $_[0] : $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 ($dline =~ m/[^\x20-\x7e]/)
{
local($new, $Dinc, $c) = ('', 0);
for ($i = 0; $i < length($dline); $i++) {
$c = substr($dline, $i, 1);
if ($c eq "\t") {
$c = ' ' x (8 - (($i-length($prompt)) % 8));
} elsif ($c =~ tr/\000-\037//) {
$c = sprintf("^%c", ord($c)+ord('@'));
} elsif (ord($c) == 127) {
$c = '^?';
}
$new .= $c;
$Dinc += length($c) - 1 if (length($c) > 1 && $i < $D);
$bsel += length($c) - 1 if (defined $bsel && length($c) > 1 && $i < $bsel);
}
$dline = $new;
$D += $Dinc;
}
if ($D == length($prompt)) {
$si = 0; } elsif ($si >= $D) { $si = &max(0, $D - $rl_margin);
$si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
} elsif ($si + $rl_screen_width <= $D) { $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) {
$si = &max(0, length($dline) - $rl_screen_width + 3);
$si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
} else {
}
$have_bra = 1 if $si != 0;
$thislen = &min(length($dline) - $si, $rl_screen_width);
if ($si + $thislen < length($dline)) {
$thislen-- if &OnSecondByte($si+$thislen-1);
substr($dline, $si+$thislen-1,1) = '>';
$have_ket = 1;
}
$dline = substr($dline, $si, $thislen);
$delta = $D - $si; if (defined $bsel) {
$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)) { $prompt = ($have_bra ? "<" : "");
$dline = substr $dline, 1; $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;
}
local ($\, $,) = ('','');
if (not $force_redraw and not defined $bsel)
{
if ($lastredisplay eq $dline and $lastpromptlen == length $prompt) {
if ($lastdelta < $delta) {
print $term_OUT
substr_with_props($prompt, $dline,
$lastdelta, $delta-$lastdelta, $have_ket);
} elsif($lastdelta > $delta) {
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);
return;
}
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);
($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
= ($thislen, $dline, $delta, length $prompt);
return;
}
}
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 > $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;
push(@$Dot_buf, $key) if $Dot_buf;
$key;
}
sub rl_getc {
my $key; if (defined $term_readkey) { $Term::ReadLine::Perl::term->Tk_loop
if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
$key = Term::ReadKey::ReadKey(0, $term_IN);
} else {
$key = $Term::ReadLine::Perl::term->get_c;
}
}
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
}
sub do_command
{
my ($keymap, $count, $key) = @_;
my $cmd = get_command($keymap, $key);
local *KeyMap = $keymap; &$cmd($count, $key);
$lastcommand = $cmd;
}
sub savestate
{
[$D, $si, $LastCommandKilledText, $KillBuffer, $line, @_];
}
sub preserve_state {
return if $Vi_mode;
push(@undo, savestate()), return unless @undo;
my $last = $undo[-1];
my @only_movement;
if ( $last->[4] eq $line ) {
pop @undo if $undo[-1]->[5];
@only_movement = 1;
}
push(@undo, savestate(@only_movement));
}
sub F_SelfInsert
{
remove_selection();
my ($count, $ord) = @_;
my $text2add = pack('C', $ord) x $count;
if ($InsertMode) {
substr($line,$D,0) .= $text2add;
} else {
substr($line,$D,length($text2add)) = $text2add;
}
$D += length($text2add);
}
sub F_AcceptLine
{
&add_line_to_history;
$AcceptLine = $line;
local $\ = '';
print $term_OUT "\r\n";
$force_redraw = 0;
(pos $line) = undef; }
sub add_line_to_history
{
if (length($line) >= $minlength
&& (!@rl_History || $rl_History[$ ) {
while (@rl_History >= $rl_MaxHistorySize) {
shift(@rl_History);
$rl_HistoryIndex--;
}
push(@rl_History, $line); }
}
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 F_ForwardChar;
sub F_BackwardChar;
sub F_BeginningOfLine;
sub F_EndOfLine;
sub F_ForwardWord;
sub F_BackwardWord;
sub F_RedrawCurrentLine;
sub F_ClearScreen;
sub F_QuotedInsert;
sub F_TabInsert;
sub F_OperateAndGetNext;
sub F_BackwardDeleteChar;
sub F_DeleteChar;
sub F_UnixWordRubout;
sub F_UnixLineDiscard;
sub F_UpcaseWord;
sub F_DownCaseWord;
sub F_CapitalizeWord;
sub F_TransposeWords;
sub F_TransposeChars;
sub F_PreviousHistory;
sub F_NextHistory;
sub F_BeginningOfHistory;
sub F_EndOfHistory;
sub F_ReverseSearchHistory;
sub F_ForwardSearchHistory;
sub F_HistorySearchBackward;
sub F_HistorySearchForward;
sub F_KillLine;
sub F_BackwardKillLine;
sub F_Yank;
sub F_YankPop;
sub F_YankNthArg;
sub F_KillWord;
sub F_BackwardKillWord;
sub F_Abort;
sub F_DoLowercaseVersion;
sub F_DoMetaVersion;
sub F_DoControlVersion;
sub F_Undo;
sub F_RevertLine;
sub F_EmacsEditingMode;
sub F_Interrupt;
sub F_PrefixMeta;
sub F_UniversalArgument;
sub F_DigitArgument;
sub F_OverwriteMode;
sub F_InsertMode;
sub F_ToggleInsertMode;
sub F_Suspend;
sub F_Ding;
sub F_PossibleCompletions;
sub F_Complete;
sub F_YankClipboard;
sub F_CopyRegionAsKillClipboard;
sub F_KillRegionClipboard;
sub clipboard_set;
sub F_BeginUndoGroup;
sub F_EndUndoGroup;
sub F_DoNothing;
sub F_ForceMemorizeDigitArgument;
sub F_MemorizeDigitArgument;
sub F_UnmemorizeDigitArgument;
sub F_ResetDigitArgument;
sub F_MergeInserts;
sub F_MemorizePos;
sub F_BeginPasteGroup;
sub F_EndPasteGroup;
sub F_BeginEditGroup;
sub F_EndEditGroup;
use SelfLoader;
1;
__DATA__
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'); }
sub toupper { &islower ? pack('c', ord($_[0])-ord('a')+ord('A')) : $_[0];}
sub tolower { &isupper ? pack('c', ord($_[0])-ord('A')+ord('a')) : $_[0];}
sub rl_set
{
local($var, $val) = @_;
$val = ucfirst lc $val if $val =~ /^(on|off)$/i;
$var = 'CompleteAddsuffix' if $var eq 'visible-stats';
local($_) = "\u$var";
local($return) = undef;
s/-(.)/\u$1/g;
return unless defined $ {'readline::'}{"var_$_"};
local(*V) = $ {'readline::'}{"var_$_"};
if (!defined($V)) { 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}; }
$return;
}
sub OnSecondByte
{
return 0 if !$_rl_japanese_mb || $_[0] == 0 || $_[0] == length($line);
die 'internal error' if $_[0] > length($line);
local($i);
for ($i = 0; $i < $_[0]; $i++) {
next if ord(substr($line, $i, 1)) < 0x80;
return 1 if ++$i == $_[0];
}
0; }
sub CharSize
{
return 2 if $_rl_japanese_mb &&
ord(substr($line, $_[0], 1)) >= 0x80 &&
ord(substr($line, $_[0]+1, 1)) >= 0x80;
1;
}
sub GetTTY
{
$base_termios = $termios; &ioctl($term_IN,$TCGETS,$base_termios) || die "Can't ioctl TCGETS: $!";
}
sub XonTTY
{
&ioctl($term_IN,$TCXONC,$TCOON); &ioctl($term_OUT,$TCXONC,$TCOON); }
sub ___SetTTY
{
&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: $!";
}
sub normal_tty_mode
{
return if $stdin_not_tty || $dumb_term || !$initialized;
&XonTTY;
&GetTTY if !defined($base_termios);
&ResetTTY;
}
sub ___ResetTTY
{
@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: $!";
}
sub WordBreak
{
index($rl_basic_word_break_characters, substr($line,$_[0],1)) != -1;
}
sub getstate
{
($D, $si, $LastCommandKilledText, $KillBuffer, $line) = @{$_[0]};
$ThisCommandKilledText = $LastCommandKilledText;
}
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) = '';
if ($D > $from) {
$D -= $len;
$D = $from if $D < $from;
}
}
sub at_end_of_line
{
($D + &CharSize($D)) == (length($line) + 1);
}
sub F_ForwardChar
{
my $count = shift;
return &F_BackwardChar(-$count) if $count < 0;
while (!&at_end_of_line && $count-- > 0) {
$D += &CharSize($D);
}
}
sub F_BackwardChar
{
my $count = shift;
return &F_ForwardChar(-$count) if $count < 0;
while (($D > 0) && ($count-- > 0)) {
$D--; $D-- if &OnSecondByte($D); }
}
sub F_BeginningOfLine
{
$D = 0;
}
sub F_EndOfLine
{
&F_ForwardChar(100) while !&at_end_of_line;
}
sub F_ForwardWord
{
my $count = shift;
return &F_BackwardWord(-$count) if $count < 0;
while (!&at_end_of_line && $count-- > 0)
{
&F_ForwardChar(1) while !&at_end_of_line && &WordBreak($D);
&F_ForwardChar(1) while !&at_end_of_line && !&WordBreak($D);
}
}
sub F_BackwardWord
{
my $count = shift;
return &F_ForwardWord(-$count) if $count < 0;
while ($D > 0 && $count-- > 0) {
&F_BackwardChar(1) while (($D > 0) && &WordBreak($D-1));
&F_BackwardChar(1) while (($D > 0) && !&WordBreak($D-1));
}
}
sub F_RedrawCurrentLine
{
$force_redraw = 1;
}
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;
}
sub F_QuotedInsert
{
my $count = shift;
&F_SelfInsert($count, ord(&getc_with_pending));
}
sub F_TabInsert
{
my $count = shift;
&F_SelfInsert($count, ord("\t"));
}
sub F_OperateAndGetNext
{
my $count = shift;
&F_AcceptLine;
my $remainingEntries = $ if ($count > 0 && $remainingEntries >= 0) { if ($remainingEntries > 0) { $rl_HistoryIndex++; $count = $remainingEntries if $count > $remainingEntries;
}
$rl_OperateCount = $count;
}
}
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);
}
sub F_DeleteChar
{
return if remove_selection();
my $count = shift;
return F_DeleteBackwardChar(-$count) if $count < 0;
if (length($line) == 0) { $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);
}
sub F_UnixWordRubout
{
return &F_Ding if $D == 0;
(my $oldD, local $rl_basic_word_break_characters) = ($D, "\t ");
F_BackwardWord(1);
kill_text($D, $oldD, 1);
}
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'); }
sub changecase
{
my $op = $_[1];
my ($start, $state, $c, $olddot) = ($D, 0);
if ($_[0] < 0)
{
$olddot = $D;
$_[0] = -$_[0];
}
&F_ForwardWord;
while ($start < $D) {
$c = substr($line, $start, 1);
if ($op eq 'up') {
$c = &toupper($c);
} elsif ($op eq 'down') {
$c = &tolower($c);
} else { if ($state == 1) {
$c = &tolower($c);
} else {
$c = &toupper($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;
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; return 1;
}
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));
}
sub search {
my ($i, $str) = @_;
return -1 if $i < 0 || $i > $ while (1) {
return $i if rindex($rl_History[$i], $str) >= 0;
if ($reverse) {
return -1 if $i-- == 0;
} else {
return -1 if $i++ == $ }
}
}
sub DoSearch
{
local $reverse = shift; my $oldline = $line;
my $oldD = $D;
my $searchstr = ''; my $I = -1;
$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)] 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)] 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") { $line = $oldline;
$D = $oldD;
return;
} elsif (ord($c) < 32 || ord($c) > 126) {
push(@Pending, $c) if $c ne "\e";
if ($I < 0) {
$line = $oldline;
$D = $oldD;
} else {
$line = $rl_History[$I];
$D = index($rl_History[$I], $searchstr);
}
&redisplay();
last;
} else {
$tmp = &search($I < 0 ? $rl_HistoryIndex-$reverse: $I, $searchstr.$c);
if ($tmp == -1) {
&F_Ding;
} else {
$searchstr .= $c;
$I = $tmp;
}
}
}
}
sub searchStart {
my ($i, $reverse, $str) = @_;
$i += $reverse ? - 1: +1;
return -1 if $i < 0 || $i > $ while (1) {
return $i if index($rl_History[$i], $str) == 0;
if ($reverse) {
return -1 if $i-- == 0;
} else {
return -1 if $i++ == $ }
}
}
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));
}
sub F_KillLine
{
my $count = shift;
return F_BackwardKillLine(-$count) if $count < 0;
kill_text($D, length($line), 1);
}
sub F_BackwardKillLine
{
my $count = shift;
return F_KillLine(-$count) if $count < 0;
return F_Ding if $D == 0;
kill_text(0, $D, 1);
}
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;
}
sub F_YankNthArg {
1;
}
sub F_KillWord
{
my $count = shift;
return &F_BackwardKillWord(-$count) if $count < 0;
my $oldD = $D;
&F_ForwardWord($count); kill_text($oldD, $D, 1);
}
sub F_BackwardKillWord
{
my $count = shift;
return F_KillWord(-$count) if $count < 0;
my $oldD = $D;
&F_BackwardWord($count); kill_text($D, $oldD, 1);
}
sub F_Abort
{
&F_Ding;
}
sub F_DoLowercaseVersion
{
if ($_[1] >= ord('A') && $_[1] <= ord('Z')) {
&do_command(*KeyMap, $_[0], $_[1] - ord('A') + ord('a'));
} else {
&F_Ding;
}
}
sub F_DoControlVersion
{
local *KeyMap = $var_EditingMode;
my $key = $_[1];
if ($key == ord('?')) {
$key = 0x7F;
} else {
$key &= ~(0x80 | 0x60);
}
&do_command(*KeyMap, $_[0], $key);
}
sub F_DoMetaVersion
{
local *KeyMap = $var_EditingMode;
unshift @Pending, chr $_[1];
&do_command(*KeyMap, $_[0], ord "\e");
}
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;
}
sub F_Undo
{
pop(@undo); if (@undo) {
&getstate(pop(@undo));
} else {
&F_Ding;
}
}
sub F_RevertLine
{
if ($rl_HistoryIndex >= $ $line = $line_for_revert;
} else {
$line = $rl_History[$rl_HistoryIndex];
}
$D = length($line);
}
sub F_EmacsEditingMode
{
$var_EditingMode = $var_EditingMode{'emacs'};
$Vi_mode = 0;
}
sub F_Interrupt
{
local $\ = '';
print $term_OUT "\r\n";
&ResetTTY;
kill ("INT", 0);
$force_redraw = 1;
}
sub F_PrefixMeta
{
my($count, $keymap) = ($_[0], "$KeyMap{'name'}_$_[1]");
die "<internal error, $_[1]>" unless %$keymap;
do_command(*$keymap, $count, ord(&getc_with_pending));
}
sub F_UniversalArgument
{
&F_DigitArgument;
}
sub F_DigitArgument
{
my $in = chr $_[1];
my ($NumericArg, $sawDigit) = (1, 0);
my ($increment, $ord);
($NumericArg, $sawDigit) = ($_[0], $_[0] !~ /e0$/i)
if $doingNumArg;
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; &do_command(*KeyMap, $NumericArg . ($sawDigit ? '': 'e0'), $ord);
return;
}
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;
}
sub F_Suspend
{
if ($inDOS && length($line)==0) { $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar';
return;
}
local $\ = '';
print $term_OUT "\r\n";
&ResetTTY;
eval { kill ("TSTP", 0) };
&SetTTY;
$force_redraw = 1;
}
sub F_Ding {
local $\ = '';
print $term_OUT "\007";
return; }
sub F_PossibleCompletions
{
&complete_internal('?');
}
sub F_InsertPossibleCompletions
{
&complete_internal('*');
}
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;
}
sub complete_internal
{
my $what_to_do = shift;
my ($point, $end) = ($D, $D);
($point++, $end++) if $Vi_mode;
if ($point)
{
1 while (--$point && (-1 == index($rl_completer_word_break_characters,
substr($line, $point, 1))));
$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); local $\ = '';
print $term_OUT "\n\r";
&pretty_print_list (@matches);
$force_redraw = 1;
} elsif ($what_to_do eq '*') {
shift(@matches); 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/; @matches = &$func($text, $line, $start);
if (@matches) {
my $prefix = $matches[0];
my $len = length($prefix);
for ($i = 1; $i < @matches; $i++) {
next if substr($matches[$i], 0, $len) eq $prefix;
$prefix = substr($prefix, 0, --$len);
last if $len == 0;
$i--; }
unshift(@matches, $prefix); }
@matches;
}
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;
}
sub rl_basic_commands
{
@rl_basic_commands = @_;
$rl_completion_function = 'use_basic_commands';
}
sub pretty_print_list
{
my @list = @_;
return unless @list;
my ($lines, $columns, $mark, $index);
my $maxwidth = 0;
grep(length > $maxwidth && ($maxwidth = length), @list);
$maxwidth++;
$columns = $maxwidth >= $rl_screen_width
? 1 : int($rl_screen_width / $maxwidth);
$maxwidth += int(($rl_screen_width % $maxwidth) / $columns);
$lines = int((@list + $columns - 1) / $columns);
$columns-- while ((($lines * $columns) - @list + 1) > $lines);
$mark = $ 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 <= $ print $term_OUT "\n\r";
}
}
sub F_ViAcceptLine
{
&F_AcceptLine();
&F_ViInput();
}
sub F_ViRepeatLastCommand {
my($count) = @_;
return &F_Ding if !$Last_vi_command;
my @lastcmd = @$Last_vi_command;
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 {
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) {
$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) {
$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 {
$Last_vi_command = $Dot_buf;
undef $Dot_buf;
$Vi_undo_state = $Dot_state;
$Vi_undo_all_state = $Dot_state if !$Vi_undo_all_state;
$rl_HistoryIndex = $}
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) {
&kill_text(0, length($line), 1);
}
else {
&kill_text($D, $other_end, 1);
}
1; }
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;
}
sub F_SaveLine
{
local $\ = '';
$line = '#'.$line;
&redisplay();
print $term_OUT "\r\n";
&add_line_to_history;
$line_for_revert = '';
&get_line_from_history(scalar @rl_History);
&F_ViInput() if $Vi_mode;
}
sub F_ViNonPosition {
undef $D;
}
sub F_ViPositionEsc {
my($count, $ord) = @_;
unshift(@Pending, pack('c', $ord));
&F_ViNonPosition;
}
sub get_position {
my ($count, $ord, $fullline_ord, $poshash) = @_;
local $D = $D;
$ord = ord(&getc_with_pending) if !defined $ord;
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 {
&do_command($var_EditingMode{'vipos'}, $count, $ord);
}
$D;
}
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);
}
}
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;
}
}
}
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;
$line_for_revert = $line if $rl_HistoryIndex == @rl_History;
$line = ($n == @rl_History) ? $line_for_revert : $rl_History[$n];
$D = $Vi_mode ? 0 : length $line;
$Vi_undo_all_state = savestate() if $Vi_mode;
$rl_HistoryIndex = $n;
}
sub F_PrintHistory {
my($count) = @_;
$count = 20 if $count == 1; 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;
}
sub force_redisplay {
local $force_redraw = 1;
&redisplay(@_);
}
sub F_ViSearch {
my($n, $ord) = @_;
my $c = pack('c', $ord);
my $str = &get_vi_search_str($c);
if (!defined $str) {
return &F_ViInput() if $line eq '';
return();
}
if ($str eq '') {
return &F_Ding unless defined $Vi_search_re;
}
else {
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) {
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();
}
sub vi_search {
my ($i) = @_;
return -1 if $i < 0 || $i > $ while (1) {
return $i if $rl_History[$i] =~ /$Vi_search_re/;
if ($reverse) {
return -1 if $i-- == 0;
} else {
return -1 if $i++ == $ }
}
}
sub do_vi_search {
my $incr = $reverse ? -1 : 1;
my $i = &vi_search($rl_HistoryIndex + $incr);
return &F_Ding if $i < 0;
$rl_HistoryIndex = $i;
($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
}
sub get_vi_search_str {
my($c) = @_;
local $prompt = $prompt . $c;
local ($line, $D) = ('', 0);
&redisplay();
while ($lastcommand ne 'F_ViEndSearch') {
&do_command($var_EditingMode{'visearch'}, 1, ord(&getc_with_pending));
&redisplay();
return undef if !defined $line;
}
$line;
}
sub F_ViEndSearch {}
sub F_ViSearchBackwardDeleteChar {
if ($line eq '') {
undef $line;
}
else {
&F_BackwardDeleteChar(@_);
}
}
sub F_ViChangeEntireLine
{
&start_dot_buf(@_);
kill_text(0, length($line), 1);
&vi_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"; return &F_ViCommandMode if $c eq "\e";
&end_dot_buf;
local $InsertMode = 0;
local $D = $D; &F_SelfInsert(1, ord($c));
}
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) {
&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;
}
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') {
undef $Dot_buf;
}
else {
@{$Dot_buf}[-1] = "\e";
&end_dot_buf;
}
}
&F_ViCommandMode;
&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; $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(); undef $Dot_buf;
my $ch;
while (1) {
&F_Complete() or return;
&F_ForwardChar(1);
&force_redisplay();
$ch = &getc_with_pending();
last unless ord($ch) == $ord;
&F_BackwardChar(1);
$lastcommand = 'F_Complete'; }
unshift(@Pending, $ch);
&vi_input_mode;
}
sub F_ViInsertPossibleCompletions {
$Dot_state = savestate(); undef $Dot_buf;
&complete_internal('*') or return;
&F_ForwardChar(1);
&vi_input_mode;
}
sub F_ViPossibleCompletions {
&complete_internal('?');
&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; }
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); 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 $ENV{HOME}) {
$mess = "Writing to file `$ENV{HOME}/.rl_cutandpaste'";
open COPY, "> $ENV{HOME}/.rl_cutandpaste" 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; }
} elsif ($^O eq 'MSWin32') {
eval {
require Win32::Clipboard;
$in = Win32::Clipboard::GetText();
$in =~ s/\r\n/\n/g; }
} 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 $ENV{HOME}) {
$mess = "Reading from file `$ENV{HOME}/.rl_cutandpaste'";
open PASTE, "< $ENV{HOME}/.rl_cutandpaste" 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, $}
sub F_EndUndoGroup {
return F_Ding unless @undoGroupS;
my $last = pop @undoGroupS;
return unless $ my $now = pop @undo;
$ push @undo, $now;
}
sub F_DoNothing { 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;
}
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;
__END__