r2284 - in packages/libterm-readline-perl-perl/trunk: . ReadLine
debian
Krzysztof Krzyzaniak
eloy at costa.debian.org
Tue Mar 7 18:09:52 UTC 2006
Author: eloy
Date: 2006-03-07 18:09:51 +0000 (Tue, 07 Mar 2006)
New Revision: 2284
Modified:
packages/libterm-readline-perl-perl/trunk/CHANGES
packages/libterm-readline-perl-perl/trunk/ReadLine/readline.pm
packages/libterm-readline-perl-perl/trunk/debian/changelog
packages/libterm-readline-perl-perl/trunk/debian/control
packages/libterm-readline-perl-perl/trunk/test.pl
Log:
eloy: new upstream version
Modified: packages/libterm-readline-perl-perl/trunk/CHANGES
===================================================================
--- packages/libterm-readline-perl-perl/trunk/CHANGES 2006-03-07 18:03:03 UTC (rev 2283)
+++ packages/libterm-readline-perl-perl/trunk/CHANGES 2006-03-07 18:09:51 UTC (rev 2284)
@@ -119,3 +119,47 @@
(thanks to Slaven Rezic).
1.0203: Unconditional titlecasing of .inputrc "values" broke settings with
values such as 'vi' etc (thanks to Russ Southern for a report).
+
+1.0204: Applied patches from Gurusamy and Slaven for vi mode:
+ Logic to move insertion point one char back was wrong;
+ Disable (YES!) choice of vi-mode based on $ENV{EDITOR}.
+ Just in case: generate proper warning if an old $ket-bug resurrects.
+ If readkey() returns undef, behave as on EOF.
+ New option --no-print to test.pl.
+ Try to move prompt to the next line if something is already on the
+ current line (controlled by $rl_scroll_nextline,
+ $rl_last_pos_can_backspace);
+ Wrong setting of $rl_last_pos_can_backspace will result:
+ a) 1 and wrong: empty line before the prompt;
+ b) 0 and wrong: if the line contains 1 char only,
+ (and no NL), the prompt will overwrite it;
+ test with `perl -Mblib test.pl --no-print',
+ type `print 1'.
+ [This is not the same as termcap/am!].
+ New variable $readline::rl_default_selected; if true, default string
+ is removed if the first keystroke is self-insert or BackSpace;
+ test.pl modified to test this too;
+ uses mr,me capabilities to highlight the default string.
+ New command: SaveLine (on M-#).
+ New command: PrintHistory (on M-h),
+ PreviousHistory and NextHistory take count.
+ The edited line is saved when one moves to history.
+1.0205: Do not touch $ENV{HOME} unless defined.
+ $ENV{AUTOMATED_TESTING} to skip interactive tests.
+1.0206: Shift-Ins, Control-Ins, Shift-Del operate on clipboard (if available)
+ (currently native on OS/2 only, otherwise uses commands
+ $ENV{RL_PASTE_CMD}, $ENV{RL_CLCOPY_CMD}, or file
+ $ENV{HOME}/.rl_cutandpaste).
+ In absense of mark, CopyRegionAsKillClipboard operates
+ on the whole line
+ Completely ignore unknown variables in .inputrc.
+ Moving cursor should remove the highlight of initial string too.
+ Change some local() to my().
+ Region between point and mark is highlighted.
+ Commands SelfInsert, Yank*, *DeleteChar remove this region
+ if $rl_delete_selection is TRUE (default).
+ (Set mark again to insert without removing.)
+1.0207: If mark was active, redraw could be performed after Enter.
+ Untested Win32 support for cut&paste.
+ Alias $var_DeleteSelection for $rl_delete_selection (thus accessible
+ via .inputrc).
Modified: packages/libterm-readline-perl-perl/trunk/ReadLine/readline.pm
===================================================================
--- packages/libterm-readline-perl-perl/trunk/ReadLine/readline.pm 2006-03-07 18:03:03 UTC (rev 2283)
+++ packages/libterm-readline-perl-perl/trunk/ReadLine/readline.pm 2006-03-07 18:09:51 UTC (rev 2284)
@@ -16,8 +16,7 @@
## Call rl_set to set mode variables yourself, as in
## &readline'rl_set('TcshCompleteMode', 'On');
##
-## If $ENV{EDITOR} is a string containing the substring 'vi', we start in vi
-## input mode; otherwise start in emacs mode. To override this behavior, do
+## To change the input mode (emacs or vi) use ~/.inputrc or call
## &readline::rl_set('EditingMode', 'vi');
## or &readline::rl_set('EditingMode', 'emacs');
##
@@ -50,8 +49,13 @@
## while writing this), and for Roland Schemers whose line_edit.pl I used
## as an early basis for this.
##
-$VERSION = $VERSION = '1.0203';
+$VERSION = $VERSION = '1.0207';
+## - Changes from Slaven Rezic (slaven at rezic.de):
+## * reverted the usage of $ENV{EDITOR} to set startup mode
+## only ~/.inputrc or an explicit call to rl_set should
+## be used to set startup mode
+##
# 1011109.011 - Changes from Russ Southern (russ at dvns.com):
## * Added $rl_vi_replace_default_on_insert
# 1000510.010 - Changes from Joe Petolino (petolino at eng.sun.com), requested
@@ -111,7 +115,7 @@
## of packing the fields into a string.
##
## * F_AcceptLine(): Code moved to new sub add_line_to_history(),
-## so that it may be called by F_ViSaveLine()
+## so that it may be called by F_SaveLine()
## as well as by F_AcceptLine().
##
## * F_QuotedInsert(): Calls getc_with_pending() instead of &$rl_getc().
@@ -451,6 +455,10 @@
$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;
@@ -557,7 +565,11 @@
$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;
@@ -583,7 +595,7 @@
$line='';
$D = 0;
$InputLocMsg = ' [initialization]';
-
+
&InitKeymap(*emacs_keymap, 'SelfInsert', 'emacs_keymap',
($inDOS ? () : ('C-@', 'SetPoint') ),
'C-a', 'BeginningOfLine',
@@ -638,6 +650,7 @@
'M-c', 'CapitalizeWord',
'M-d', 'KillWord',
'M-f', 'ForwardWord',
+ 'M-h', 'PrintHistory',
'M-l', 'DownCaseWord',
'M-r', 'RevertLine',
'M-t', 'TransposeWords',
@@ -646,6 +659,7 @@
'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',
@@ -705,8 +719,8 @@
(
qq/"\0\2"/, 'SetMark', # 2: <Control>+<Space>
qq/"\0\3"/, 'SetMark', # 3: <Control>+<@>
- qq/"\0\4"/, 'Yank', # 4: <Shift>+<Insert>
- qq/"\0\5"/, 'KillRegion', # 5: <Shift>+<Delete>
+ qq/"\0\4"/, 'YankClipboard', # 4: <Shift>+<Insert>
+ qq/"\0\5"/, 'KillRegionClipboard', # 5: <Shift>+<Delete>
qq/"\0\16"/, 'Undo', # 14: <Alt>+<Backspace>
qq/"\0\23"/, 'RevertLine', # 19: <Alt>+<R>
qq/"\0\24"/, 'TransposeWords', # 20: <Alt>+<T>
@@ -738,8 +752,9 @@
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"/, 'CopyRegionAsKill', # 146: <Ctrl>+<Insert>
+ qq/"\0\x92"/, 'CopyRegionAsKillClipboard', # 146: <Ctrl>+<Insert>
qq/"\0\223"/, 'KillWord', # 147: <Ctrl>+<Delete>
+ qq/"\0#"/, 'PrintHistory', # Alt-H
)
: ( 'C-@', 'Ding')
)
@@ -780,13 +795,13 @@
"\r", 'ViAcceptLine',
' ', 'ViMoveCursor',
- '#', 'ViSaveLine',
+ '#', 'SaveLine',
'$', 'ViMoveCursor',
'%', 'ViMoveCursor',
'*', 'ViInsertPossibleCompletions',
- '+', 'ViNextHistory',
+ '+', 'NextHistory',
',', 'ViMoveCursor',
- '-', 'ViPreviousHistory',
+ '-', 'PreviousHistory',
'.', 'ViRepeatLastCommand',
'/', 'ViSearch',
@@ -812,7 +827,7 @@
'E', 'ViMoveCursor',
'F', 'ViMoveCursor',
'G', 'ViHistoryLine',
- 'H', 'ViPrintHistory',
+ 'H', 'PrintHistory',
'I', 'ViBeginInput',
'N', 'ViRepeatSearch',
'P', 'ViPutBefore',
@@ -835,8 +850,8 @@
'f', 'ViMoveCursorFind',
'h', 'ViMoveCursor',
'i', 'ViInput',
- 'j', 'ViNextHistory',
- 'k', 'ViPreviousHistory',
+ 'j', 'NextHistory',
+ 'k', 'PreviousHistory',
'l', 'ViMoveCursor',
'n', 'ViRepeatSearch',
'p', 'ViPut',
@@ -854,8 +869,8 @@
(($inDOS
and (not $ENV{'TERM'} or $ENV{'TERM'} !~ /^(vt|xterm)/i)) ?
(
- qq/"\0\110"/, 'ViPreviousHistory', # 72: <Up arrow>
- qq/"\0\120"/, 'ViNextHistory', # 80: <Down arrow>
+ 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',
@@ -864,8 +879,8 @@
(('M-C-j','EmacsEditingMode'), # Conflicts with \e otherwise
(($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
(
- qq/"\eA"/, 'ViPreviousHistory', # up arrow
- qq/"\eB"/, 'ViNextHistory', # down arrow
+ qq/"\eA"/, 'PreviousHistory', # up arrow
+ qq/"\eB"/, 'NextHistory', # down arrow
qq/"\eC"/, 'ForwardChar', # right arrow
qq/"\eD"/, 'BackwardChar', # left arrow
qq/"\e\\*"/, 'ViAfterEsc',
@@ -873,8 +888,8 @@
# Default
(
- qq/"\e[A"/, 'ViPreviousHistory', # up arrow
- qq/"\e[B"/, 'ViNextHistory', # down arrow
+ 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',
@@ -1010,11 +1025,16 @@
ord('E') => q{.\s*\S*(?=\S)|.?\s*(?=\s$)},
};
- my $default_mode =
- (defined $ENV{EDITOR} and $ENV{EDITOR} =~ /vi/) ? 'vi' : 'emacs';
+ 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
}
@@ -1327,10 +1347,37 @@
sub F_ReReadInitFile
{
my ($file) = $ENV{'INPUTRC'};
- $file = "$ENV{'HOME'}/.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 {
+ # 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::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;
@@ -1343,7 +1390,6 @@
return $line;
}
-
##
## This is it. Called as &readline'readline($prompt, $default),
## (DEFAULT can be omitted) the next input line is returned (undef on EOF).
@@ -1368,6 +1414,20 @@
## 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;
}
@@ -1465,20 +1525,39 @@
}
}
- &redisplay(); ## Show the line (just prompt at this point).
+ 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;
+ }
push(@undo, &savestate) unless $Vi_mode; ## save state so we can undo.
$ThisCommandKilledText = 0;
##print "\n\rline is @$D:[$line]\n\r"; ##DEBUG
- &do_command($var_EditingMode, 1, ord($input)); ## actually execute input
+ 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';
+ }
+ &$cmd(1, ord($input)); ## actually execute input
+ $rl_first_char = 0;
*KeyMap = $var_EditingMode; # JP: added
# In Vi command mode, don't position the cursor beyond the last
@@ -1577,11 +1656,16 @@
# face-change commands
sub substr_with_props {
- my ($p, $s, $from, $len, $ket) = @_;
+ 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 at ilyaz.org';
+ $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) {
@@ -1596,19 +1680,46 @@
$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 $rl_term_set->[2] . $s . $rl_term_set->[3];
+ return $s;
} elsif (!length $s) { # Should not happen
- return $bs . $rl_term_set->[0] . $p . $rl_term_set->[1] . $as;
+ return $p;
} else { # Do not underline spaces in the prompt
- return $bs . $rl_term_set->[0] . $p . $rl_term_set->[1] . $as
- . $rl_term_set->[2] . $s . $rl_term_set->[3]
- . (length $ket ? ($rl_term_set->[0] . $ket . $rl_term_set->[1]) : '');
+ 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;
+}
+
##
## redisplay()
##
@@ -1631,8 +1742,12 @@
## local $line has prompt also; take that into account with $D.
local($prompt) = defined($_[0]) ? $_[0] : $prompt;
my ($thislen, $have_bra);
- local($line) = $prompt . $line;
+ my($dline) = $prompt . $line;
local($D) = $D + length($prompt);
+ my ($bsel, $esel);
+ if (defined pos $line) {
+ $bsel = (pos $line) + length $prompt;
+ }
my ($have_ket) = '';
##
@@ -1640,13 +1755,13 @@
## for displaying (such as tabs, control characters, etc.), we will
## take care of that now....
##
- if ($line =~ m/[^\x20-\x7e]/)
+ if ($dline =~ m/[^\x20-\x7e]/)
{
local($new, $Dinc, $c) = ('', 0);
- ## Look at each character of $line in turn.....
- for ($i = 0; $i < length($line); $i++) {
- $c = substr($line, $i, 1);
+ ## Look at each character of $dline in turn.....
+ for ($i = 0; $i < length($dline); $i++) {
+ $c = substr($dline, $i, 1);
## A tab to expand...
if ($c eq "\t") {
@@ -1664,13 +1779,15 @@
## 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);
}
- $line = $new;
+ $dline = $new;
$D += $Dinc;
}
##
- ## Now $line is what we'd like to display.
+ ## Now $dline is what we'd like to display.
##
## If it's too long to fit on the line, we must decide what we can fit.
##
@@ -1680,6 +1797,8 @@
## 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.
@@ -1690,44 +1809,56 @@
$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
- $si = &min(length($line), ($D - $rl_screen_width) + $rl_margin);
+ $si = &min(length($dline), ($D - $rl_screen_width) + $rl_margin);
$si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
- } elsif (length($line) - $si < $rl_screen_width - $rl_margin and $si) {
+ } elsif (length($dline) - $si < $rl_screen_width - $rl_margin and $si) {
# Too little of the line shown
- $si = &max(0, length($line) - $rl_screen_width + 3);
+ $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($line) - $si, $rl_screen_width);
- if ($si + $thislen < length($line)) {
+ $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($line, $si+$thislen-1,1) = '>';
+ substr($dline, $si+$thislen-1,1) = '>';
$have_ket = 1;
}
##
## Now know what to display.
- ## Must get substr($line, $si, $thislen) on the screen,
+ ## Must get substr($dline, $si, $thislen) on the screen,
## with the cursor at $D-$si characters from the left edge.
##
- $line = substr($line, $si, $thislen);
+ $dline = substr($dline, $si, $thislen);
$delta = $D - $si; ## delta is cursor distance from left margin.
- if ($si >= length($prompt)) { # Keep $line for $lastredisplay...
+ 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)) { # Keep $dline for $lastredisplay...
$prompt = ($have_bra ? "<" : "");
- $line = substr $line, 1; # After prompt
+ $dline = substr $dline, 1; # After prompt
+ $bsel = 1 if defined $bsel and $bsel == 0;
} else {
- $line = substr($line, (length $prompt) - $si);
+ $dline = substr($dline, (length $prompt) - $si);
$prompt = substr($prompt,$si);
substr($prompt, 0, 1) = '<' if $si > 0;
}
- # Now $line is the part after the prompt...
+ # Now $dline is the part after the prompt...
##
- ## Now must output $line, with cursor $delta spaces from left margin.
+ ## Now must output $dline, with cursor $delta spaces from left margin.
##
local ($\, $,) = ('','');
@@ -1737,16 +1868,16 @@
## 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 (!$force_redraw)
+ 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 $line and $lastpromptlen == length $prompt) {
+ 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, $line,
+ substr_with_props($prompt, $dline,
$lastdelta, $delta-$lastdelta, $have_ket);
## Need to move back.
} elsif($lastdelta > $delta) {
@@ -1757,11 +1888,11 @@
print $term_OUT "\b" x ($lastdelta - $delta);
} else {
print $term_OUT "\r",
- substr_with_props($prompt, $line, 0, $delta, $have_ket);
+ substr_with_props($prompt, $dline, 0, $delta, $have_ket);
}
}
($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
- = ($thislen, $line, $delta, length $prompt);
+ = ($thislen, $dline, $delta, length $prompt);
# print $term_OUT "\a"; # Debugging
return;
}
@@ -1771,13 +1902,13 @@
$lastdelta == $lastlen &&
$delta == $thislen &&
$lastpromptlen == length($prompt) &&
- substr($line, 0, $lastlen - $lastpromptlen) eq $lastredisplay)
+ substr($dline, 0, $lastlen - $lastpromptlen) eq $lastredisplay)
{
- print $term_OUT substr_with_props($prompt, $line,
+ print $term_OUT substr_with_props($prompt, $dline,
$lastdelta, undef, $have_ket);
# print $term_OUT "\a"; # Debugging
($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
- = ($thislen, $line, $delta, length $prompt);
+ = ($thislen, $dline, $delta, length $prompt);
return;
}
@@ -1789,14 +1920,14 @@
## Brute force method of redisplaying... redraw the whole thing.
##
- print $term_OUT "\r", substr_with_props($prompt, $line, 0, undef, $have_ket);
+ print $term_OUT "\r", substr_with_props($prompt, $dline, 0, undef, $have_ket, $bsel, $esel);
print $term_OUT ' ' x ($lastlen - $thislen) if $lastlen > $thislen;
- print $term_OUT "\r",substr_with_props($prompt, $line, 0, $delta, $have_ket)
- if $delta != length ($line) || $lastlen > $thislen;
+ print $term_OUT "\r",substr_with_props($prompt, $dline, 0, $delta, $have_ket, $bsel, $esel)
+ if $delta != length ($dline) || $lastlen > $thislen;
($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
- = ($thislen, $line, $delta, length $prompt);
+ = ($thislen, $dline, $delta, length $prompt);
$force_redraw = 0;
}
@@ -1825,23 +1956,37 @@
}
##
-## do_command(keymap, numericarg, command)
+## get_command(keymap, numericarg, command)
##
-## If the KEYMAP has an entry for COMMAND, it is executed.
-## Otherwise, the default command for the keymap is executed.
+## If the KEYMAP has an entry for COMMAND, it is returned.
+## Otherwise, the default command is returned.
##
-sub do_command
+sub get_command
{
local *KeyMap = shift;
- my ($count, $key) = @_;
+ my ($key) = @_;
my $cmd = defined($KeyMap[$key]) ? $KeyMap[$key]
: ($KeyMap{'default'} || 'F_Ding');
if (!defined($cmd) || $cmd eq ''){
warn "internal error (key=$key)";
- } else {
- ## print "COMMAND [$cmd($count, $key)]\r\n"; ##DEBUG
- &$cmd($count, $key);
+ $cmd = 'F_Ding';
}
+ $cmd
+}
+
+##
+## do_command(keymap, numericarg, command)
+##
+## If the KEYMAP has an entry for COMMAND, it is executed.
+## Otherwise, the default command for the keymap is executed.
+##
+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;
}
@@ -1860,8 +2005,9 @@
##
sub F_SelfInsert
{
+ remove_selection();
my ($count, $ord) = @_;
- my $text2add = pack('c', $ord) x $count;
+ my $text2add = pack('C', $ord) x $count;
if ($InsertMode) {
substr($line,$D,0) .= $text2add;
} else {
@@ -1880,6 +2026,8 @@
$AcceptLine = $line;
local $\ = '';
print $term_OUT "\r\n";
+ $force_redraw = 0;
+ (pos $line) = undef; # Another way to force redraw...
}
sub add_line_to_history
@@ -1901,6 +2049,20 @@
}
}
+
+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_ReReadInitFile;
#sub rl_getc;
sub F_ForwardChar;
@@ -1956,6 +2118,10 @@
sub F_Ding;
sub F_PossibleCompletions;
sub F_Complete;
+sub F_YankClipboard;
+sub F_CopyRegionAsKillClipboard;
+sub F_KillRegionClipboard;
+sub clipboard_set;
# Comment next line and __DATA__ line below to disable the selfloader.
@@ -2018,8 +2184,10 @@
local($return) = undef;
s/-(.)/\u$1/g;
+ # Skip unknown variables:
+ return unless defined $ {'readline::'}{"var_$_"};
local(*V) = $ {'readline::'}{"var_$_"};
- if (!defined($V)) {
+ if (!defined($V)) { # XXX Duplicate check?
warn("Warning$InputLocMsg:\n".
" Invalid variable `$var'\n") if $^W;
} elsif (!defined($V{$val})) {
@@ -2349,6 +2517,8 @@
##
sub F_BackwardDeleteChar
{
+ return if remove_selection();
+
my $count = shift;
return F_DeleteChar(-$count) if $count < 0;
my $oldD = $D;
@@ -2367,6 +2537,8 @@
##
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)
@@ -2469,51 +2641,24 @@
}
}
-##
-## Use the previous entry in the history buffer (if there is one)
-##
-sub F_PreviousHistory
-{
- return if $rl_HistoryIndex == 0;
+sub F_PreviousHistory {
+ &get_line_from_history($rl_HistoryIndex - shift);
+}
- $rl_HistoryIndex--;
- ($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
- &F_EndOfLine;
+sub F_NextHistory {
+ &get_line_from_history($rl_HistoryIndex + shift);
}
-##
-## Use the next entry in the history buffer (if there is one)
-##
-sub F_NextHistory
-{
- return if $rl_HistoryIndex > $#rl_History;
- $rl_HistoryIndex++;
- if ($rl_HistoryIndex > $#rl_History) {
- $D = 0;
- $line = '';
- } else {
- ($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
- &F_EndOfLine;
- }
-}
sub F_BeginningOfHistory
{
- if ($rl_HistoryIndex != 0) {
- $rl_HistoryIndex = 0;
- ($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
- &F_EndOfLine;
- }
+ &get_line_from_history(0);
}
sub F_EndOfHistory
{
- if (@rl_History != 0 && $rl_HistoryIndex != $#rl_History) {
- $rl_HistoryIndex = $#rl_History;
- ($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
- &F_EndOfLine;
- }
+ &get_line_from_history(@rl_History);
}
sub F_ReverseSearchHistory
@@ -2686,6 +2831,7 @@
sub F_Yank
{
+ remove_selection();
&TextInsert($_[0], $KillBuffer);
}
@@ -2816,12 +2962,13 @@
##
sub F_DigitArgument
{
- my $ord = $_[1];
+ my $in = chr $_[1];
my ($NumericArg, $sign, $explicit) = (1, 1, 0);
- my $increment;
+ my ($increment, $ord);
do
{
+ $ord = ord $in;
if (defined($KeyMap[$ord]) && $KeyMap[$ord] eq 'F_UniversalArgument') {
$NumericArg *= 4;
} elsif ($ord == ord('-') && !$explicit) {
@@ -2848,7 +2995,7 @@
$NumericArg = -$rl_max_numeric_arg;
}
&redisplay(sprintf("(arg %d) ", $NumericArg));
- } while $ord = ord(&getc_with_pending);
+ } while defined($in = &getc_with_pending);
}
sub F_OverwriteMode
@@ -3472,7 +3619,7 @@
## Prepend line with '#', add to history, and clear the input buffer
## (this feature was borrowed from ksh).
##
-sub F_ViSaveLine
+sub F_SaveLine
{
local $\ = '';
$line = '#'.$line;
@@ -3481,7 +3628,7 @@
&add_line_to_history;
$line_for_revert = '';
&get_line_from_history(scalar @rl_History);
- &F_ViInput();
+ &F_ViInput() if $Vi_mode;
}
#
@@ -3580,14 +3727,6 @@
}
}
-sub F_ViPreviousHistory {
- &get_line_from_history($rl_HistoryIndex - 1);
-}
-
-sub F_ViNextHistory {
- &get_line_from_history($rl_HistoryIndex + 1);
-}
-
# 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 {
@@ -3605,15 +3744,15 @@
# Get line from history buffer (or from saved edit line).
$line = ($n == @rl_History) ? $line_for_revert : $rl_History[$n];
- $D = 0;
+ $D = $Vi_mode ? 0 : length $line;
# Subsequent 'U' will bring us back to this point.
- $Vi_undo_all_state = &savestate;
+ $Vi_undo_all_state = &savestate if $Vi_mode;
$rl_HistoryIndex = $n;
}
-sub F_ViPrintHistory {
+sub F_PrintHistory {
my($count) = @_;
$count = 20 if $count == 1; # Default - assume 'H', not '1H'
@@ -3625,16 +3764,19 @@
my $lmh = length $rl_MaxHistorySize;
my $lspace = ' ' x ($lmh+3);
- my $hdr = "$lspace----- (Use '<num>G' to retrieve command <num>) -----\n";
+ 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;
+ 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 + 1),
+ sprintf("%${lmh}d: ", @rl_History - $i + $shift),
($i < @rl_History) ? $rl_History[$i] :
($i == $rl_HistoryIndex) ? $line :
@@ -3643,11 +3785,11 @@
"\n";
}
print $lspace, ". . .\n" if $end < @rl_History;
- print $hdr;
+ print "$hdr\n";
&force_redisplay();
- &F_ViInput() if $line eq '';
+ &F_ViInput() if $line eq '' && $Vi_mode;
}
# Redisplay the line, without attempting any optimization
@@ -3926,6 +4068,7 @@
}
sub F_ViAcceptInsert {
+ local $in_accept_line = 1;
&F_ViEndInsert;
&F_ViAcceptLine;
}
@@ -3946,7 +4089,9 @@
}
}
&F_ViCommandMode;
- &F_BackwardChar;
+ # 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 {
@@ -4024,13 +4169,17 @@
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 {
@@ -4050,5 +4199,83 @@
$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 $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; # 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 $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);
+}
+
1;
__END__
Modified: packages/libterm-readline-perl-perl/trunk/debian/changelog
===================================================================
--- packages/libterm-readline-perl-perl/trunk/debian/changelog 2006-03-07 18:03:03 UTC (rev 2283)
+++ packages/libterm-readline-perl-perl/trunk/debian/changelog 2006-03-07 18:09:51 UTC (rev 2284)
@@ -1,3 +1,12 @@
+libterm-readline-perl-perl (1.0207-1) unstable; urgency=low
+
+ * New upstream release (closes: #209263) (closes: #145383)
+ * debian/control:
+ - Uploaders: added me
+ - Build-Depends: debhelper (>= 5.0.0) moved here
+
+ -- Krzysztof Krzyzaniak (eloy) <eloy at debian.org> Tue, 7 Mar 2006 19:03:10 +0100
+
libterm-readline-perl-perl (1.0203-4) unstable; urgency=low
* Fixed a broken debian/watch file
Modified: packages/libterm-readline-perl-perl/trunk/debian/control
===================================================================
--- packages/libterm-readline-perl-perl/trunk/debian/control 2006-03-07 18:03:03 UTC (rev 2283)
+++ packages/libterm-readline-perl-perl/trunk/debian/control 2006-03-07 18:09:51 UTC (rev 2284)
@@ -1,9 +1,10 @@
Source: libterm-readline-perl-perl
Section: perl
Priority: optional
-Build-Depends-Indep: debhelper (>= 4.0.2), perl (>= 5.6.0-17)
+Build-Depends: debhelper (>= 5.0.0)
+Build-Depends-Indep: perl (>= 5.6.0-17)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Gunnar Wolf <gwolf at debian.org>, Niko Tyni <ntyni at iki.fi>
+Uploaders: Gunnar Wolf <gwolf at debian.org>, Niko Tyni <ntyni at iki.fi>, Krzysztof Krzyzaniak (eloy) <eloy at debian.org>
Standards-Version: 3.6.2
Package: libterm-readline-perl-perl
Modified: packages/libterm-readline-perl-perl/trunk/test.pl
===================================================================
--- packages/libterm-readline-perl-perl/trunk/test.pl 2006-03-07 18:03:03 UTC (rev 2283)
+++ packages/libterm-readline-perl-perl/trunk/test.pl 2006-03-07 18:09:51 UTC (rev 2284)
@@ -1,11 +1,18 @@
+#! /usr/bin/perl -w
# Give an argument to use stdin, stdout instead of console
# If argument starts with /dev, use it as console
+# If argument is '--no-print', do not print the result.
+
BEGIN{ $ENV{PERL_RL} = 'Perl' }; # Do not test TR::Gnu !
use Term::ReadLine;
use Carp;
$SIG{__WARN__} = sub { warn Carp::longmess(@_) };
+if ($ENV{AUTOMATED_TESTING}) {
+ print "1..0 # skip: \$ENV{AUTOMATED_TESTING} is TRUE\n";
+ exit;
+}
if (!@ARGV) {
$term = new Term::ReadLine 'Simple Perl calc';
@@ -15,6 +22,7 @@
$term = new Term::ReadLine 'Simple Perl calc', \*IN, \*OUT;
} else {
$term = new Term::ReadLine 'Simple Perl calc', \*STDIN, \*STDOUT;
+ $no_print = $ARGV[0] eq '--no-print';
}
$prompt = "Enter arithmetic or Perl expression: ";
$OUT = $term->OUT || STDOUT;
@@ -26,10 +34,11 @@
} else {
print $OUT "No additional features present.\n";
}
+print $OUT "Flipping rl_default_selected each line.\n";
while ( defined ($_ = $term->readline($prompt, "exit")) ) {
$res = eval($_);
warn $@ if $@;
- print $OUT $res, "\n" unless $@;
+ print $OUT $res, "\n" unless $@ or $no_print;
$term->addhistory($_) if /\S/ and !$features{autohistory};
+ $readline::rl_default_selected = !$readline::rl_default_selected;
}
-
More information about the Pkg-perl-cvs-commits
mailing list