add match_last attribute to color last match
[fcscs/fcscs.git] / bin / fcscs
index 25a530207447007fd5a17ee8d3eecbcb08fe4b8f..d6a5878a6dcf51e3e911bde3748bcd64a1fdcb52 100755 (executable)
--- a/bin/fcscs
+++ b/bin/fcscs
@@ -54,6 +54,28 @@ None so far.
 
 =head1 USAGE
 
+Short overview of the general usage, details below:
+
+    - start fcscs
+    - configure actions (optional)
+        - enable pasting
+        - ...
+    - select mode (optional, URL mode is used on startup):
+        - f: file paths
+        - u: URLs
+        - ...
+        - /: search mode
+    - for `normal' modes:
+        - select match by displayed number or <return> for lowest numbered
+          match
+        - configured action is run, e.g. URL is opened with browser
+    - for `search' mode:
+        - perform incremental search
+        - on <return> go to `normal' mode to select a match
+        - after the match is selected wait for confirmation or extension
+        - confirmation: <return> run previously selected action
+        - extension: change match, e.g. select complete word or line
+
 GNU Screen setup (add to F<~/.screenrc>):
 
     bind ^B eval "hardcopy $HOME/.tmp/screen-fcscs" "screen fcscs $HOME/.tmp/screen-fcscs"
@@ -80,23 +102,29 @@ or another number to select the longer match. Use backspace to remove the last
 entered number.
 
 Press return before entering a number to select the last (lowest numbered)
-match. To abort without selecting any match either use "q".
+match (underlined by default). To abort without selecting any match either use
+"q".
 
 To change the selection mode (e.g. paths, files, etc.) use one of the mappings
 explained below. Per default URLs are selected, see options for a way to
 change this.
 
+I<NOTE>: Opening URLs in the browser passes the URL via the command line which
+leaks URLs to other users on the current system via C<ps aux> or C<top>.
+
 I<NOTE>: When yanking (copying) a temporary file is used to pass the data to
-GNU screen/Tmux without exposing it to C<ps ux> or C<top>. However this may
+GNU screen/Tmux without exposing it to C<ps aux> or C<top>. However this may
 leak data if those temporary files are written to disk. To prevent this change
-your C<$TMP> accordingly to point to a memory-only location or encrypted
-storage.
+your C<$TMP> to point to a memory-only location or encrypted storage.
 
 If no window appears, try running B<fcscs> manually to catch the error message
 and please report the bug:
 
     fcscs /path/to/screen-or-tmux-fcscs-file
 
+
+=head1 MODES
+
 =cut
 
 
@@ -240,6 +268,8 @@ package Screen {
     sub draw_prompt {
         my ($self, $config) = @_;
 
+        $self->debug('draw_prompt', 'started');
+
         my $x = 0;
         my $y = $self->height - 1;
 
@@ -249,17 +279,20 @@ package Screen {
         # Draw prompt flags.
         if (defined (my $s = $self->{prompt}{flags})) {
             $s = "[$s]";
+            $self->debug('draw_prompt', $s);
             $self->draw_clipped($y, $x, $config->{attribute}{prompt_flags}, $s);
             $x += length($s) + 1; # space between next element
         }
         # Draw prompt name.
         if (defined (my $s = $self->{prompt}{name})) {
             $s = "[$s]";
+            $self->debug('draw_prompt', $s);
             $self->draw_clipped($y, $x, $config->{attribute}{prompt_name}, $s);
             $x += length($s) + 1;
         }
         # Draw prompt value, e.g. a search field.
         if (defined (my $s = $self->{prompt}{value})) {
+            $self->debug('draw_prompt', $s);
             $self->draw_clipped($y, $x, undef, $s);
             $x += length($s) + 1;
         }
@@ -275,9 +308,13 @@ package Screen {
 
         my $attr_id     = $config->{attribute}{match_id};
         my $attr_string = $config->{attribute}{match_string};
+        my $attr_last   = $config->{attribute}{match_last};
 
         foreach (@{$matches_add}) {
-            $self->draw($_->{y}, $_->{x}, $attr_string, $_->{string});
+            my $attr = (defined $_->{id} and $_->{id} == 1)
+                     ? $attr_last
+                     : $attr_string;
+            $self->draw($_->{y}, $_->{x}, $attr, $_->{string});
             if (defined $_->{id}) {
                 $self->draw($_->{y}, $_->{x}, $attr_id, $_->{id});
             }
@@ -317,6 +354,26 @@ package Screen {
         $self->deinit;
         exit 1;
     }
+    sub debug {
+        my ($self, $module, @args) = @_;
+
+        return if not $self->{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;
+            }
+        }
+
+        foreach (@args) {
+            $_ = $self->encode($_);
+        }
+        say $fh "$module: @args";
+        return;
+    }
 
 
     sub prompt {
@@ -341,14 +398,6 @@ package Screen {
 
 # FUNCTIONS
 
-sub debug {
-    my ($config, $module, @args) = @_;
-
-    say STDERR "$module: @args" if $config->{setting}{debug};
-    return;
-}
-
-
 sub prepare_input {
     my ($screen, $input_ref) = @_;
 
@@ -390,16 +439,16 @@ 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;
 }
 
 
 sub run_command {
-    my ($config, $cmd) = @_;
+    my ($screen, $config, $cmd) = @_;
 
-    debug $config, 'run_command', "running @{$cmd}";
+    $screen->debug('run_command', "running @{$cmd}");
 
     my $exit = do {
         # Perl's system() combined with a $SIG{__WARN__} which die()s has
@@ -423,7 +472,8 @@ sub run_command {
         # a working $$.
         no warnings;
 
-        system { $cmd->[0] } @{$cmd};
+        my @cmd = map { $screen->encode($_) } @{$cmd};
+        system { $cmd[0] } @cmd;
     };
     if ($exit != 0) {
         my $msg;
@@ -439,9 +489,9 @@ sub run_command {
     return;
 }
 sub run_in_background {
-    my ($config, $sub) = @_;
+    my ($screen, $sub) = @_;
 
-    debug $config, 'run_in_background', "running $sub";
+    $screen->debug('run_in_background', "running $sub");
 
     my $pid = fork;
     defined $pid or die $!;
@@ -461,9 +511,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;
@@ -476,12 +523,12 @@ sub run_in_background {
 sub select_match {
     my ($name, $screen, $config, $input, $matches) = @_;
 
-    debug $config, 'select_match', 'started';
+    $screen->debug('select_match', 'started');
 
     return if @{$matches} == 0;
     # Don't return on initial run to give the user a chance to select another
     # mode, e.g. to switch from URL selection to search selection.
-    if (@{$matches} == 1 and not $config->{state}->{initial}) {
+    if (@{$matches} == 1 and not $config->{state}{initial}) {
         return { match => $matches->[0] };
     }
     $config->{state}{initial} = 0;
@@ -535,20 +582,104 @@ sub select_match {
         $screen->refresh;
     }
 
+    $screen->draw_matches($config, $matches, []); # remove matches
+
     foreach (@{$matches}) {
         return { match => $_ } if $_->{id} == $number;
     }
-    debug $config, 'select_match', 'no match selected';
+    $screen->debug('select_match', 'no match selected');
     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) = @_;
+
+    $screen->debug('extend_match', 'started');
+
+    return if not defined $match;
+
+    $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;
+    }
+
+    $screen->debug('extend_match', 'done');
+
+    return { match => $match };
+}
+
 
 sub mapping_paste {
     my ($key, $screen, $config, $input) = @_;
 
-    debug $config, 'mapping_paste', 'started';
+    $screen->debug('mapping_paste', 'started');
 
-    $config->{state}{handler} = \&handler_paste;
+    $config->{state}{handler} = $config->{handler}{paste};
 
     $screen->prompt(flags => 'P'); # paste
     $screen->draw_prompt($config);
@@ -559,9 +690,9 @@ sub mapping_paste {
 sub mapping_yank {
     my ($key, $screen, $config, $input) = @_;
 
-    debug $config, 'mapping_yank', 'started';
+    $screen->debug('mapping_yank', 'started');
 
-    $config->{state}{handler} = \&handler_yank;
+    $config->{state}{handler} = $config->{handler}{yank};
 
     $screen->prompt(flags => 'Y'); # yank
     $screen->draw_prompt($config);
@@ -571,35 +702,85 @@ sub mapping_yank {
 }
 
 
+=head2 NORMAL MODES
+
+Normal modes select matches by calling a function which returns them, e.g. by
+using a regex.
+
+The following normal modes are available:
+
+=over 4
+
+=item B<path mode> select relative/absolute paths
+
+=item B<url mode>  select URLs
+
+=back
+
+=cut
 sub mapping_mode_path {
     my ($key, $screen, $config, $input) = @_;
 
-    debug $config, 'mapping_mode_path', 'started';
+    $screen->debug('mapping_mode_path', 'started');
 
     my @matches = get_regex_matches($input, $config->{regex}{path});
     return {
         select  => 'path select',
         matches => \@matches,
-        handler => \&handler_yank,
+        handler => $config->{handler}{yank},
     };
 }
 sub mapping_mode_url {
     my ($key, $screen, $config, $input) = @_;
 
-    debug $config, 'mapping_mode_url', 'started';
+    $screen->debug('mapping_mode_url', 'started');
 
     my @matches = get_regex_matches($input, $config->{regex}{url});
     return {
         select  => 'url select',
         matches => \@matches,
-        handler => \&handler_url,
+        handler => $config->{handler}{url},
     };
 }
 
+=head2 SEARCH MODE (AND EXTEND MODE)
+
+Search mode is a special mode which lets you type a search string (a Perl
+regex) and then select one of the matches. Afterwards you can extend the
+match. For example select the complete word or to the end of the line. This
+allows quick selection of arbitrary text.
+
+The following mappings are available during the extension mode (not
+configurable at the moment):
+
+=over 4
+
+=item B<w> select current word
+
+=item B<b> extend word to the left
+
+=item B<e> extend word to the right
+
+=item B<W> select current WORD
+
+=item B<B> extend WORD to the left
+
+=item B<E> extend WORD to the right
+
+=item B<^> extend to beginning of line
+
+=item B<$> extend to end of line
+
+=back
+
+C<word> includes any characters matching C<\w+>, C<WORD> any non-whitespace
+characters (C<\S+>), just like in Vim.
+
+=cut
 sub mapping_mode_search {
     my ($key, $screen, $config, $input) = @_;
 
-    debug $config, 'mapping_mode_search', 'started';
+    $screen->debug('mapping_mode_search', 'started');
 
     $screen->cursor(1);
 
@@ -651,7 +832,8 @@ sub mapping_mode_search {
     return {
         select  => 'search',
         matches => \@last_matches,
-        handler => \&handler_yank,
+        extend  => 1,
+        handler => $config->{handler}{yank},
     };
 }
 
@@ -666,29 +848,29 @@ sub mapping_quit {
 sub handler_yank {
     my ($screen, $config, $match) = @_;
 
-    debug $config, 'handler_yank', 'started';
+    $screen->debug('handler_yank', 'started');
 
     require File::Temp;
 
     # Use a temporary file to prevent leaking the yanked data to other users
     # with the command line, e.g. ps aux or top.
     my ($fh, $tmp) = File::Temp::tempfile(); # dies on its own
-    print $fh $screen->encode($match->{string});
+    print $fh $screen->encode($match->{value});
     close $fh or die $!;
 
     if ($config->{setting}{multiplexer} eq 'screen') {
-        debug $config, 'handler_yank', 'using screen';
+        $screen->debug('handler_yank', 'using screen');
 
         # GNU screen displays an annoying "Slurping X characters into buffer".
         # Use 'msgwait 0' as a hack to disable it.
         my $msgwait = $config->{setting}{screen_msgwait};
-        run_command($config, ['screen', '-X', 'msgwait', 0]);
-        run_command($config, ['screen', '-X', 'readbuf', $tmp]);
-        run_command($config, ['screen', '-X', 'msgwait', $msgwait]);
+        run_command($screen, $config, ['screen', '-X', 'msgwait', 0]);
+        run_command($screen, $config, ['screen', '-X', 'readbuf', $tmp]);
+        run_command($screen, $config, ['screen', '-X', 'msgwait', $msgwait]);
     } elsif ($config->{setting}{multiplexer} eq 'tmux') {
-        debug $config, 'handler_yank', 'using tmux';
+        $screen->debug('handler_yank', 'using tmux');
 
-        run_command($config, ['tmux', 'load-buffer', $tmp]);
+        run_command($screen, $config, ['tmux', 'load-buffer', $tmp]);
     } else {
         die 'unsupported multiplexer';
     }
@@ -699,22 +881,22 @@ sub handler_yank {
 sub handler_paste {
     my ($screen, $config, $match) = @_;
 
-    debug $config, 'handler_paste', 'started';
+    $screen->debug('handler_paste', 'started');
 
     require Time::HiRes;
 
     my @cmd;
     if ($config->{setting}{multiplexer} eq 'screen') {
-        debug $config, 'handler_paste', 'using screen';
+        $screen->debug('handler_paste', 'using screen');
         @cmd = qw( screen -X paste . );
     } elsif ($config->{setting}{multiplexer} eq 'tmux') {
-        debug $config, 'handler_paste', 'using tmux';
+        $screen->debug('handler_paste', 'using tmux');
         @cmd = qw( tmux paste-buffer );
     } else {
         die 'unsupported multiplexer';
     }
 
-    run_in_background($config, sub {
+    run_in_background($screen, sub {
         # We need to get the data in the paste buffer before we can paste
         # it.
         handler_yank($screen, $config, $match);
@@ -722,25 +904,18 @@ sub handler_paste {
         # Sleep until we switch back to the current window.
         Time::HiRes::usleep($config->{setting}{paste_sleep});
 
-        run_command($config, \@cmd);
+        run_command($screen, $config, \@cmd);
     });
     return;
 }
 sub handler_url {
     my ($screen, $config, $match) = @_;
 
-    debug $config, 'handler_url', 'started';
-
-    run_in_background($config, sub {
-        my $url = defined $match->{url}
-                ? $match->{url}
-                : $match->{string};
+    $screen->debug('handler_url', "opening $match->{value}");
 
-        my @cmd = map { $screen->encode($_) } (
-            @{$config->{setting}{browser}},
-            $url,
-        );
-        run_command($config, \@cmd);
+    run_in_background($screen, sub {
+        my @cmd = ( @{$config->{setting}{browser}}, $match->{value} );
+        run_command($screen, $config, \@cmd);
     });
     return;
 }
@@ -880,6 +1055,8 @@ Defaults in parentheses (foreground, background, attribute).
 
 =item B<match_string>  attribute for matches (yellow, default, normal)
 
+=item B<match_last>    attribute for the match selected by return (yellow, default, underline)
+
 =item B<prompt_name>   attribute for prompt name (standout)
 
 =item B<prompt_flags>  attribute for prompt flags (standout)
@@ -898,6 +1075,8 @@ my %attribute = (
     match_id     => $screen->color_pair(Curses::COLOR_RED, -1)
                     | Curses::A_BOLD,
     match_string => $screen->color_pair(Curses::COLOR_YELLOW, -1),
+    match_last   => $screen->color_pair(Curses::COLOR_YELLOW, -1)
+                    | Curses::A_UNDERLINE,
     prompt_name  => Curses::A_STANDOUT,
     prompt_flags => Curses::A_STANDOUT,
 );
@@ -908,7 +1087,7 @@ Defaults in parentheses.
 
 =over
 
-=item B<debug>          enable debug mode (redirect stderr when enabling) (C<0>)
+=item B<debug>          enable debug mode, writes to I<~/.config/fcscs/log> (C<0>)
 
 =item B<initial_mode>   start in this mode, must be a valid mode mapping (C<\&mapping_mode_url>)
 
@@ -949,7 +1128,7 @@ my %setting = (
 
 =over
 
-=item B<url> used by C<\&mapping_mode_url()>
+=item B<url>  used by C<\&mapping_mode_url()>
 
 =item B<path> used by C<\&mapping_mode_path()>
 
@@ -967,6 +1146,45 @@ my %regex = (
     path => qr{(~?[a-zA-Z0-9_./-]*/[a-zA-Z0-9_./-]+)},
 );
 
+=head2 HANDLERS
+
+Handlers are used to perform actions on the selected string.
+
+The following handlers are available, defaults in parentheses.
+
+=over
+
+=item B<yank>  used to yank (copy) selection to paste buffer (C<\&handler_yank>)
+
+=item B<paste> used to paste selection into window (C<\&handler_paste>)
+
+=item B<url>   used to open URLs (e.g. in a browser) (C<\&handler_url>)
+
+=back
+
+Example:
+
+    # Download YouTube videos with a custom wrapper, handle all other URLs
+    # with the default URL handler.
+    $config{handler}{url} = sub {
+        my ($screen, $config, $match) = @_;
+
+        if ($match->{value} =~ m{^https://www.youtube.com/}) {
+            return run_in_background($screen, sub {
+                run_command($screen, $config,
+                            ['youtube-dl-wrapper', $match->{value}]);
+            });
+        }
+        handler_url(@_);
+    };
+
+=cut
+my %handler = (
+    yank  => \&handler_yank,
+    paste => \&handler_paste,
+    url   => \&handler_url,
+);
+
 my %state = (
     initial => 1, # used by select_match() for 'initial_mode'
     handler => undef,
@@ -998,10 +1216,9 @@ Used as mappings, see L</MAPPINGS> above.
     handler_paste()
     handler_url()
 
-Used as handler to yank, paste selection or open URL in browser. They are
-either set by the matching mapping function (C<mapping_paste()>, etc.) or
-configured by the current mode.
+Used as handler to yank, paste selection or open URL in browser.
 
+    debug()
     get_regex_matches()
     select_match()
     run_command()
@@ -1034,6 +1251,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(@_); }
 
@@ -1055,6 +1274,7 @@ $config{mapping}{simple} = \%mapping_simple;
 $config{attribute}       = \%attribute;
 $config{setting}         = \%setting;
 $config{regex}           = \%regex;
+$config{handler}         = \%handler;
 $config{state}           = \%state;
 
 package Fcscs {
@@ -1139,7 +1359,7 @@ eval {
     while (1) {
         if (not defined $mapping) {
             $key = $screen->getch unless defined $key;
-            debug \%config, 'input', "got key '$key'";
+            $screen->debug('input', "got key '$key'");
 
             $mapping = $config{mapping}{mode}{$key};
             $mapping = $config{mapping}{simple}{$key} unless defined $mapping;
@@ -1149,35 +1369,56 @@ eval {
             }
         }
 
-        debug \%config, 'input', 'running mapping';
+        $screen->debug('input', 'running mapping');
         my $result = $mapping->($key, $screen, \%config, $input);
         $mapping = undef;
 
 RESULT:
         if (defined $result->{quit}) {
-            debug \%config, 'input', 'quitting';
+            $screen->debug('input', 'quitting');
             last;
         }
         if (defined $result->{key}) {
             $key = $result->{key}; # lookup another mapping
-            debug \%config, 'input', "processing new key: '$key'";
+            $screen->debug('input', "processing new key: '$key'");
             next;
         }
         if (defined $result->{select}) {
-            debug \%config, 'input', 'selecting match';
+            $screen->debug('input', 'selecting match');
             my $tmp = $result;
             $result = select_match($result->{select},
-                                $screen, \%config, $input,
-                                $result->{matches});
+                                   $screen, \%config, $input,
+                                   $result->{matches});
             $result->{handler} = $tmp->{handler};
+            $result->{extend}  = $tmp->{extend};
+            goto RESULT; # reprocess special entries in result
+        }
+        if (defined $result->{extend}) {
+            $screen->debug('input', 'extending match');
+            $result = extend_match($screen, \%config, $input,
+                                   $result->{match});
             goto RESULT; # reprocess special entries in result
         }
         if (defined $result->{match}) {
-            debug \%config, 'input', 'running handler';
-            my $handler = $config{state}{handler};                 # set by user
-            $handler = $result->{handler} unless defined $handler; # set by mapping
-            $handler = \&handler_yank     unless defined $handler; # fallback
-            $handler->($screen, \%config, $result->{match});
+            if (not defined $result->{match}{value}) {
+                $result->{match}{value} = $result->{match}{string};
+            }
+
+            $screen->debug('input', 'running handler');
+
+            # 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;
         }