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

12
revbank
View file

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

19
t/prompt.t
View file

@ -72,13 +72,20 @@ are '"abort"', [qw/abort/];
are "\\", 0;
are "'foo", 0;
are "foo'", 0;
are "foo'bar", 0;
are "bar 'foo", 3;
are "bar foo'", 3;
are "bar foo'bar", 3;
# 0123
are "foo'", 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;