From 0b2ea27117a15a653bfebc3143ec512283b962c3 Mon Sep 17 00:00:00 2001 From: Juerd Waalboer Date: Thu, 28 Dec 2023 03:45:28 +0100 Subject: [PATCH] Move prompt code to RevBank::Prompt Wanted to move split_input() to a package for unit testing, thought I'd move prompt() too since the main executable has become messy, and this would be a good first step in resolving that. --- lib/RevBank/Prompt.pm | 135 ++++++++++++++++++++++++++++++++ revbank | 178 +++++++++--------------------------------- 2 files changed, 171 insertions(+), 142 deletions(-) create mode 100755 lib/RevBank/Prompt.pm diff --git a/lib/RevBank/Prompt.pm b/lib/RevBank/Prompt.pm new file mode 100755 index 0000000..890173d --- /dev/null +++ b/lib/RevBank/Prompt.pm @@ -0,0 +1,135 @@ +package RevBank::Prompt; + +use v5.32; +use warnings; +use feature qw(signatures isa); +no warnings "experimental::signatures"; + +use IO::Select; +use List::Util qw(uniq); +use Term::ReadLine; +require Term::ReadLine::Gnu; # The other one sucks. + +use RevBank::Global; + +my %escapes = (a => "\a", r => "\r", n => "\n", t => "\t", 0 => "\0"); +my %unescapes = reverse %escapes; +my $unescapes = join "", keys %unescapes; + +sub split_input($input) { + $input =~ s/\s+$//; + + my @terms; + my $pos = 0; + + while ( + $input =~ m[ + \G \s*+ + (?| (') ( (?: \\. | [^\\'] )*+ ) ' (?=\s|;|$) + | (") ( (?: \\. | [^\\"] )*+ ) " (?=\s|;|$) + | () ( (?: \\. | [^\\;'"\s] )++ ) (?=\s|;|$) + | () (;) + ) + ]xg + ) { + push @terms, ( + (not $1) && $2 eq ";" ? "\0SEPARATOR" + : (not $1) && $2 eq "abort" ? "\0ABORT" + : $1 && $2 eq "abort" ? "abort" + : $2 + ); + $pos = pos($input) || 0; + } + + # End of string not reached + return \$pos if $pos < length($input); + + # End of string reached + s[\\(.)]{ $escapes{$1} // $1 }ge for @terms; + return @terms; +} + +sub reconstruct($word) { + $word =~ s/([;'"\\])/\\$1/g; + $word =~ s/\0SEPARATOR/;/; + $word =~ s/([$unescapes])/\\$unescapes{$1}/g; + $word = "'$word'" if $word =~ /\s/ or $word eq "abort"; + return $word; +} + +sub prompt($prompt, $completions = [], $default = "", $pos = 0, $cart = undef, $plugins = []) { + state $readline = Term::ReadLine->new($0); + + my $select = IO::Select->new; + $select->add(\*STDIN); + + if ($prompt) { + $prompt =~ s/$/:/ if $prompt !~ /[?>](?:\x01[^\x02]*\x02)?$/; + $prompt .= " "; + } else { + # \x01...\x02 = zero width markers for readline + # \e[...m = ansi escape (32 = green, 1 = bright) + $prompt = "\x01\e[32;1m\x02>\x01\e[0m\x02 "; + } + + my @matches; + $readline->Attribs->{completion_entry_function} = sub { + my ($word, $state) = @_; + return undef if $word eq ""; + @matches = grep /^\Q$word\E/i, @$completions if $state == 0; + return shift @matches; + }; + + # Term::ReadLine::Gnu (1.37) does not expose rl_completion_case_fold, + # but it can be assigned through the corresponding .inputrc command. + $readline->parse_and_bind("set completion-ignore-case on"); + + my $done; + my $input; + + $readline->callback_handler_install($prompt, sub { + $done = 1; + $input = shift; + $readline->callback_handler_remove; + }); + + $readline->insert_text($default); + $readline->Attribs->{point} = $pos; + $readline->redisplay(); + + my $begin = my $time = time; + while (not $done) { + if ($::ABORT_HACK) { + # Global variable that a signal handling plugin can set. + # Do not use, but "return ABORT" instead. + my $reason = $::ABORT_HACK; + $::ABORT_HACK = 0; + main::abort($reason); + } + if ($select->can_read(.05)) { + $readline->callback_read_char; + $begin = $time; + } + if (time > $time) { + $time = time; + call_hooks( + "prompt_idle", + $cart, + (@$plugins > 1 ? undef : $plugins->[0]), # >1 plugin = main loop + $time - $begin, + $readline, + ); + } + } + + print "\e[0m"; + defined $input or return; + $readline->addhistory($input); + + $input =~ s/^\s+//; # trim leading whitespace + $input =~ s/\s+$//; # trim trailing whitespace + + return $input; +} + +1; diff --git a/revbank b/revbank index 2b1ba3a..b1cface 100755 --- a/revbank +++ b/revbank @@ -16,6 +16,7 @@ use RevBank::Plugins; use RevBank::Global; use RevBank::Messages; use RevBank::Cart; +use RevBank::Prompt; our $VERSION = "5.1.0"; our %HELP1 = ( @@ -23,54 +24,16 @@ our %HELP1 = ( ); my @words; # input -my $retry; # reason (text) -my @retry; # (@accepted, $rejected, [@trailing]) my $one_off = 0; -my %escapes = (a => "\a", r => "\r", n => "\n", t => "\t", 0 => "\0"); -my %unescapes = reverse %escapes; - -sub split_input($input) { - $input =~ s/\s+$//; - - my @terms; - my $pos = 0; - - while ( - $input =~ m[ - \G \s*+ - (?| (') ( (?: \\. | [^\\'] )*+ ) ' (?=\s|;|$) - | (") ( (?: \\. | [^\\"] )*+ ) " (?=\s|;|$) - | () ( (?: \\. | [^\\;'"\s] )++ ) (?=\s|;|$) - | () (;) - ) - ]xg - ) { - push @terms, ( - (not $1) && $2 eq ";" ? "\0SEPARATOR" - : (not $1) && $2 eq "abort" ? "\0ABORT" - : $1 && $2 eq "abort" ? "abort" - : $2 - ); - $pos = pos($input) || 0; - } - - # End of string not reached - return \$pos if $pos < length($input); - - # End of string reached - s[\\(.)]{ $escapes{$1} // $1 }ge for @terms; - return @terms; -} - if (@ARGV) { # Non-interactive like in sh: -c command_string @ARGV >= 1 and $ARGV[0] eq '-c' or die "$0 has no switches, except -c."; $one_off = 1; - @words = split_input($ARGV[1]); + @words = RevBank::Prompt::split_input($ARGV[1]); @words and not ref $words[0] or die "Syntax error.\n"; push @words, @ARGV[3 .. $#ARGV] if @ARGV > 3; push @words, "help" if not @words; @@ -78,113 +41,15 @@ if (@ARGV) { $| = 1; -my $readline = Term::ReadLine->new($0); - -my $select = IO::Select->new; -$select->add(\*STDIN); - my $cart = RevBank::Cart->new; -sub prompt($prompt, $plugins, $completions) { - if ($prompt) { - $prompt =~ s/$/:/ if $prompt !~ /[?>](?:\x01[^\x02]*\x02)?$/; - $prompt .= " "; - } else { - # \x01...\x02 = zero width markers for readline - # \e[...m = ansi escape (32 = green, 1 = bright) - $prompt = "\x01\e[32;1m\x02>\x01\e[0m\x02 "; - } - - my @matches; - $readline->Attribs->{completion_entry_function} = sub { - my ($word, $state) = @_; - return undef if $word eq ""; - @matches = grep /^\Q$word\E/i, @$completions if $state == 0; - return shift @matches; - }; - - # Term::ReadLine::Gnu (1.37) does not expose rl_completion_case_fold, - # but it can be assigned through the corresponding .inputrc command. - $readline->parse_and_bind("set completion-ignore-case on"); - - my $done; - my $input; - - print "$retry\n" if $retry; - $readline->callback_handler_install($prompt, sub { - $done = 1; - $input = shift; - $readline->callback_handler_remove; - }); - - if ($retry) { - my $word_based = ref($retry[-1]); - my @trailing = $word_based ? @{ pop @retry } : (); - my @rejected = pop @retry; - my @accepted = @retry; - - if ($word_based) { - # Reconstruct quotes and escapes - for (@accepted, @rejected, @trailing) { - s/([;'"\\])/\\$1/g; - s/\0SEPARATOR/;/; - - my $unescapes = join "", keys %unescapes; - s/([$unescapes])/\\$unescapes{$1}/g; - $_ = "'$_'" if /\s/ or $_ eq "abort"; - } - } - - $readline->insert_text( - $word_based - ? join(" ", @accepted, @rejected, @trailing) - : join("", @accepted, @rejected) - ); - $readline->Attribs->{point} = @accepted ? 1 + length "@accepted" : 0; - @retry = (); - $retry = 0; - } - $readline->redisplay(); - - my $begin = my $time = time; - while (not $done) { - if ($::ABORT_HACK) { - # Global variable that a signal handling plugin can set. - # Do not use, but "return ABORT" instead. - my $reason = $::ABORT_HACK; - $::ABORT_HACK = 0; - abort($reason); - } - if ($select->can_read(.05)) { - $readline->callback_read_char; - $begin = $time; - } - if (time > $time) { - $time = time; - call_hooks( - "prompt_idle", - $cart, - (@$plugins > 1 ? undef : $plugins->[0]), # >1 plugin = main loop - $time - $begin, - $readline, - ); - } - } - - print "\e[0m"; - defined $input or return; - $readline->addhistory($input); - - $input =~ s/^\s+//; # trim leading whitespace - $input =~ s/\s+$//; # trim trailing whitespace - - return $input; -} - RevBank::Plugins->load; call_hooks("startup"); +my $retry; # reason (text) +my @retry; # (@accepted, $rejected, [@trailing]) + OUTER: for (;;) { if (not @words or $words[0] eq "\0SEPARATOR") { call_hooks("cart_changed", $cart) if $cart->changed; @@ -218,14 +83,43 @@ OUTER: for (;;) { my $split_input = !ref($method) && $method eq 'command'; my @completions = uniq 'abort', map $_->Tab($method), @plugins; - my $input = prompt $prompt, \@plugins, \@completions; + + my $default = ""; + my $pos = 0; + + if ($retry) { + print "$retry\n"; + + my $word_based = ref($retry[-1]); + my @trailing = $word_based ? @{ pop @retry } : (); + my @rejected = pop @retry; + my @accepted = @retry; + + if ($word_based) { + for (@accepted, @rejected, @trailing) { + $_ = RevBank::Prompt::reconstruct($_); + } + } + + $default = $word_based + ? join(" ", @accepted, @rejected, @trailing) + : join("", @accepted, @rejected); + $pos = @accepted ? 1 + length "@accepted" : 0; + + @retry = (); + $retry = 0; + } + + my $input = RevBank::Prompt::prompt( + $prompt, \@completions, $default, $pos, $cart, \@plugins + ); call_hooks "input", $cart, $input, $split_input; length $input or redo PROMPT; if ($split_input) { - @words = split_input($input); + @words = RevBank::Prompt::split_input($input); if (ref $words[0]) { my $pos = ${ $words[0] }; @retry = @words = ();