bitlair/revbank
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Better cursor position after input syntax error

Browse source
This commit is contained in:
Juerd Waalboer 2023-12-28 20:36:57 +01:00
parent e79d5ea2c0
commit 71d2179ea2
3 changed files with 29 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lib/RevBank/Prompt.pm
View file

@ -21,13 +21,16 @@ sub split_input($input) {
my @terms; my @terms;
my $pos = 0; my $pos = 0;
my $lastpos = 0;
my sub _P($nudge = 0) { $pos = pos($input) + $nudge; }
while ( while (
$input =~ m[ $input =~ m[
\G \s*+ \G \s*+
(?| (') ( (?: \\. | [^\\'] )*+ ) ' (?=\s|;|$) (?| (') (?{_P -1}) ( (?: \\. | [^\\'] )*+ ) ' (?{_P}) (?=\s|;|$)
| (") ( (?: \\. | [^\\"] )*+ ) " (?=\s|;|$) | (") (?{_P -1}) ( (?: \\. | [^\\"] )*+ ) " (?{_P}) (?=\s|;|$)
| () ( (?: \\. | [^\\;'"\s] )++ ) (?=\s|;|$) | () ( (?: \\. | [^\\;'"\s] )++ ) (?{_P}) (?=\s|;|$)
| () (;) | () (;)
) )
]xg ]xg
@ -38,11 +41,12 @@ sub split_input($input) {
: $1 && $2 eq "abort" ? "abort" : $1 && $2 eq "abort" ? "abort"
: $2 : $2
); );
$pos = pos($input) || 0; $lastpos = pos($input) || 0;
$pos ||= $lastpos;
} }
# End of string not reached # End of string not reached
return \$pos if $pos < length($input); return \$pos if $lastpos < length($input);
# End of string reached # End of string reached
s[\\(.)]{ $escapes{$1} // $1 }ge for @terms; s[\\(.)]{ $escapes{$1} // $1 }ge for @terms;

12
revbank
View file

@ -18,7 +18,7 @@ use RevBank::Messages;
use RevBank::Cart; use RevBank::Cart;
use RevBank::Prompt; use RevBank::Prompt;
our $VERSION = "5.1.0"; our $VERSION = "5.1.1";
our %HELP1 = ( our %HELP1 = (
"abort" => "Abort the current transaction", "abort" => "Abort the current transaction",
); );
@ -101,10 +101,9 @@ OUTER: for (;;) {
} }
} }
$default = $word_based my $sep = $word_based ? " " : "";
? join(" ", @accepted, @rejected, @trailing) $default = join($sep, @accepted, @rejected, @trailing);
: join("", @accepted, @rejected); $pos = @accepted ? length "@accepted$sep" : 0;
$pos = @accepted ? 1 + length "@accepted" : 0;
@retry = (); @retry = ();
$retry = 0; $retry = 0;
@ -122,14 +121,17 @@ OUTER: for (;;) {
@words = RevBank::Prompt::split_input($input); @words = RevBank::Prompt::split_input($input);
if (ref $words[0]) { if (ref $words[0]) {
my $pos = ${ $words[0] }; my $pos = ${ $words[0] };
@retry = @words = (); @retry = @words = ();
$retry = "Syntax error."; $retry = "Syntax error.";
if ($input =~ /['"]/) { if ($input =~ /['"]/) {
$retry .= " (Quotes must match and (only) be at both ends of a term.)"; $retry .= " (Quotes must match and (only) be at both ends of a term.)";
if (($input =~ tr/'//) == 1 and $input !~ /"/) { if (($input =~ tr/'//) == 1 and $input !~ /"/) {
$retry .= "\nDid you mean: " . $input =~ s/'/\\'/r; $retry .= "\nDid you mean: " . $input =~ s/'/\\'/r;
} }
} }
push @retry, substr($input, 0, $pos) if $pos > 0; push @retry, substr($input, 0, $pos) if $pos > 0;
push @retry, substr($input, $pos); push @retry, substr($input, $pos);
redo PROMPT; redo PROMPT;

19
t/prompt.t
View file

@ -72,13 +72,20 @@ are '"abort"', [qw/abort/];
are "\\", 0; are "\\", 0;
are "'foo", 0; are "'foo", 0;
are "foo'", 0;
are "foo'bar", 0;
are "bar 'foo", 3; # 0123
are "bar foo'", 3; are "foo'", 3;
are "bar foo'bar", 3; # 0123
are "foo'bar", 3;
are "foo 'bar'\"baz\"", 3; # 01234
are "bar 'foo", 4;
# 01234567
are "bar foo'", 7;
# 01234567
are "bar foo'bar", 7;
# 0123456789
are "foo 'bar'\"baz\"", 9;
done_testing; done_testing;