X-Git-Url: https://ruderich.org/simon/gitweb/?p=fcscs%2Ffcscs.git;a=blobdiff_plain;f=bin%2Ffcscs;h=95a769a40d0225ade2fd7b0a2c205500e80ff60e;hp=ade298a6114e57a3d8ee7a77b1fff068fc1f041d;hb=37ec012bdcb1ac20deea423cb9b4ff4d8c13cade;hpb=eecb272ee61ad60d634b8bfe78094e5e2ecb4939 diff --git a/bin/fcscs b/bin/fcscs index ade298a..95a769a 100755 --- a/bin/fcscs +++ b/bin/fcscs @@ -344,7 +344,18 @@ package Screen { sub debug { my ($config, $module, @args) = @_; - say STDERR "$module: @args" if $config->{setting}{debug}; + return if not $config->{setting}{debug}; + + state $fh; # only open the file once per run + if (not defined $fh) { + # Ignore errors if the directory doesn't exist. + if (not open $fh, '>', "$ENV{HOME}/.config/fcscs/log") { + $fh = undef; # a failed open still writes a value to $fh + return; + } + } + + say $fh "$module: @args"; return; } @@ -390,7 +401,7 @@ sub get_regex_matches { my ($x, $y) = input_match_offset_to_coordinates($input->{width}, $offset); - push @matches, { x => $x, y => $y, string => $1 }; + push @matches, { x => $x, y => $y, offset => $offset, string => $1 }; } return @matches; } @@ -461,9 +472,6 @@ sub run_in_background { my $pid = fork; defined $pid or die $!; if ($pid == 0) { # child - # Disable debug mode as writing will fail with closed STDERR. - $config->{setting}{debug} = 0; - $sub->(); } exit; @@ -535,6 +543,8 @@ sub select_match { $screen->refresh; } + $screen->draw_matches($config, $matches, []); # remove matches + foreach (@{$matches}) { return { match => $_ } if $_->{id} == $number; } @@ -542,6 +552,86 @@ sub select_match { return { match => undef }; } +sub extend_match_regex_left { + my ($line, $match, $regex) = @_; + + my $s = reverse substr $line, 0, $match->{x}; + if ($s =~ /^($regex)/) { + $match->{string} = reverse($1) . $match->{string}; + $match->{x} -= length $1; + $match->{offset} -= length $1; + } + return; +} +sub extend_match_regex_right { + my ($line, $match, $regex) = @_; + + my $s = substr $line, $match->{x} + length $match->{string}; + if ($s =~ /^($regex)/) { + $match->{string} .= $1; + } + return; +} +sub extend_match { + my ($screen, $config, $input, $match) = @_; + + debug $config, 'extend_match', 'started'; + + $screen->prompt(name => 'extend', value => undef); + $screen->draw_prompt($config); + + delete $match->{id}; # don't draw any match ids + $screen->draw_matches($config, [], [$match]); + $screen->refresh; + + my $line = $input->{lines}[$match->{y}]; + + while (1) { + my $match_old = \%{$match}; + + my $char = $screen->getch; + if ($char eq "\n") { # accept match + last; + + } elsif ($char eq 'w') { # select current word (both directions) + extend_match_regex_left($line, $match, qr/\w+/); + extend_match_regex_right($line, $match, qr/\w+/); + } elsif ($char eq 'b') { # select current word (only left) + extend_match_regex_left($line, $match, qr/\w+/); + } elsif ($char eq 'e') { # select current word (only right) + extend_match_regex_right($line, $match, qr/\w+/); + + } elsif ($char eq 'W') { # select current WORD (both directions) + extend_match_regex_left($line, $match, qr/\S+/); + extend_match_regex_right($line, $match, qr/\S+/); + } elsif ($char eq 'B') { # select current WORD (only left) + extend_match_regex_left($line, $match, qr/\S+/); + } elsif ($char eq 'E') { # select current WORD (only right) + extend_match_regex_right($line, $match, qr/\S+/); + + } elsif ($char eq '^') { # select to beginning of line + extend_match_regex_left($line, $match, qr/.+/); + } elsif ($char eq '$') { # select to end of line + extend_match_regex_right($line, $match, qr/.+/); + + # Allow mode changes if not overwritten by local mappings. + } elsif (defined $config->{mapping}{mode}{$char}) { + $screen->draw_matches($config, [$match_old], []); # clear match + return { key => $char }; + + } else { + next; # ignore unknown mappings + } + + $screen->draw_matches($config, [$match_old], [$match]); + $screen->refresh; + } + + debug $config, 'extend_match', 'done'; + + return { match => $match }; +} + sub mapping_paste { my ($key, $screen, $config, $input) = @_; @@ -651,6 +741,7 @@ sub mapping_mode_search { return { select => 'search', matches => \@last_matches, + extend => 1, handler => $config->{handler}{yank}, }; } @@ -729,7 +820,7 @@ sub handler_paste { sub handler_url { my ($screen, $config, $match) = @_; - debug $config, 'handler_url', 'started'; + debug $config, 'handler_url', "opening $match->{value}"; run_in_background($config, sub { my @cmd = map { $screen->encode($_) } ( @@ -904,7 +995,7 @@ Defaults in parentheses. =over -=item B enable debug mode (redirect stderr when enabling) (C<0>) +=item B enable debug mode, writes to I<~/.config/fcscs/log> (C<0>) =item B start in this mode, must be a valid mode mapping (C<\&mapping_mode_url>) @@ -1034,6 +1125,7 @@ Used as mappings, see L above. Used as handler to yank, paste selection or open URL in browser. + debug() get_regex_matches() select_match() run_command() @@ -1066,6 +1158,8 @@ package Fcscs { sub handler_paste { return main::handler_paste(@_); } sub handler_url { return main::handler_url(@_); } + sub debug { return main::debug(@_); } + sub get_regex_matches { return main::get_regex_matches(@_); } sub select_match { return main::select_match(@_); } @@ -1203,6 +1297,13 @@ RESULT: $screen, \%config, $input, $result->{matches}); $result->{handler} = $tmp->{handler}; + $result->{extend} = $tmp->{extend}; + goto RESULT; # reprocess special entries in result + } + if (defined $result->{extend}) { + debug \%config, 'input', 'extending match'; + $result = extend_match($screen, \%config, $input, + $result->{match}); goto RESULT; # reprocess special entries in result } if (defined $result->{match}) { @@ -1211,10 +1312,20 @@ RESULT: } debug \%config, 'input', 'running handler'; - my $handler = $config{state}{handler}; # set by user - $handler = $result->{handler} unless defined $handler; # set by mapping - $handler = $config{handler}{yank} unless defined $handler; # fallback - $handler->($screen, \%config, $result->{match}); + + # Choose handler with falling priority. + my @handlers = ( + $config{state}{handler}, # set by user + $result->{match}->{handler}, # set by match + $result->{handler}, # set by mapping + $config{handler}{yank}, # fallback + ); + foreach my $handler (@handlers) { + next unless defined $handler; + + $handler->($screen, \%config, $result->{match}); + last; + } last; }