quit fcscs (C<\&mapping_quit>) =back The following simple mappings are available by default: =over =item Benable pasting (C<\&mapping_paste>) =item B
paste current selection (like C<\n> but paste) (C<\&mapping_paste_now>) =item B
enable yanking (copying) (C<\&mapping_yank>) =item B yank current selection (like C<\n> but yank) (C<\&mapping_yank_now>) =back Note that yanking only uses the GNU screen or Tmux paste buffer by default. To also copy to X11 selection, enable the B option. The following additional mappings are available by default: =over =item B<\n> accept current selection (not customizable) =item B additional key to accept selection (Boption) =back All (single-byte) keys except numbers, backspace and return can be mapped. Unknown mappings are ignored when pressing keys. To remove a default mapping, delete it from the mapping hash. Example: # Map 'p' to select paths, 'P' to enable pasting. $config{mapping}{mode}{p} = \&mapping_mode_path; $config{mapping}{simple}{P} = \&mapping_paste; # Disable 'f' mapping. delete $config{mapping}{mode}{f}; =cut my %mapping_mode = ( f => \&mapping_mode_path, u => \&mapping_mode_url, i => \&mapping_mode_ip, c => \&mapping_mode_checksum, '/' => \&mapping_mode_search, q => \&mapping_quit, ); my %mapping_simple = ( p => \&mapping_paste, P => \&mapping_paste_now, y => \&mapping_yank, Y => \&mapping_yank_now, ); =head2 ATTRIBUTES Attributes are used to style the output. They must be Curses attributes. Defaults in parentheses (foreground, background, attribute). =over =item B attribute for match numbers (red, default, bold) =item B attribute for matches (yellow, default, normal) =item B attribute for the match selected by return (yellow, default, underline) =item B attribute for prompt name (standout) =item B attribute for prompt flags (standout) =back Example: # Draw prompt flags in bold red with default background color. $config{attribute}{prompt_flags} = Curses::A_BOLD | color_pair(Curses::COLOR_RED, -1); =cut 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, ); =head2 SETTINGS Defaults in parentheses. =over =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>) =item B set multiplexer ("screen" or "tmux") if not autodetected (C ) =item B ignore case when searching (C<0>) =item B ignore case unless one uppercase character is searched (C<1>) =item B copy selection also to X11 primary selection when yanking (C<0>) =item B sleep x us before running paste command (C<100_000>) =item B GNU Screen's msgwait variable, used when yanking (C<5>) =item B additional accept key like return, set to C<\n> to disable (C ) =item Bbrowser command as array reference (C<['x-www-browser']>) =back Example: # Select paths on startup instead of URLs. $config{setting}{initial_mode} = \&mapping_mode_path; =cut my %setting = ( # options debug => 0, initial_mode => \&mapping_mode_url, multiplexer => undef, ignorecase => 0, smartcase => 1, yank_x11 => 0, paste_sleep => 100_000, screen_msgwait => 5, # global mappings alternative_return => 's', # commands browser => ['x-www-browser'], ); =head2 REGEXPS =over =item B used by C<\&mapping_mode_url> =item B used by C<\&mapping_mode_path> =item B used by C<\&mapping_mode_ip> =item B used by C<\&mapping_mode_ip> =back Example: # Select all non-whitespace characters when searching for paths. $config{regex}{path} = qr{(\S+)}; =cut my %regex = ( # Taken from urlview's default configuration file, thanks. url => qr{((?:(?:(?:http|https|ftp|gopher)|mailto):(?://)?[^ <>"\t]*|(?:www|ftp)[0-9]?\.[-a-z0-9.]+)[^ .,;\t\n\r<">\):]?[^, <>"\t]*[^ .,;\t\n\r<">\):])}, path => qr{(~?[a-zA-Z0-9_./-]*/[a-zA-Z0-9_./-]+)}, # IP addresses with optional prefix. Not perfectly accurate but good # enough. ipv4 => qr!\b(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:/\d{1,2})?)\b!, ipv6 => qr!\b((?:[0-9a-fA-F]{1,4})?(?::+[0-9a-fA-F]{1,4})+(?:/\d{1,3})?)\b!, # MD5, SHA1, SHA256, SHA512 checksum => qr!\b([0-9a-fA-F]{32}|[0-9a-fA-F]{40}|[0-9a-fA-F]{64}|[0-9a-fA-F]{128})\b!, ); =head2 HANDLERS Handlers are used to perform actions on the selected string. The following handlers are available, defaults in parentheses. =over =item B used to yank (copy) selection to paste buffer (C<\&handler_yank>) =item B used to paste selection into window (C<\&handler_paste>) =item B used to open URLs (e.g. in a browser) (C<\&handler_url>) =item B used to handle IPs (C<\&handler_yank>) =item B used to handle checksums (C<\&handler_yank>) =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, ['youtube-dl-wrapper', $match->{value}]); }); } handler_url(@_); }; =cut my %handler = ( yank => \&handler_yank, paste => \&handler_paste, url => \&handler_url, ip => \&handler_yank, checksum => \&handler_yank, ); my %state = ( initial => 1, # used by select_match() for 'initial_mode' handler => undef, ); # CONFIGURATION "API" =head2 FUNCTIONS The following functions are available: color_pair($fg, $bg) Create a new Curses attribute with the given fore- and background color. mapping_mode_path() mapping_mode_url() mapping_mode_ip() mapping_mode_checksum() mapping_mode_search() mapping_paste() mapping_paste_now() mapping_yank() mapping_yank_now() mapping_quit() Used as mappings, see L above. handler_yank() handler_paste() handler_url() Used as handler to yank, paste selection or open URL in browser. get_regex_matches() select_match() run_command() run_in_background() Helper functions when writing custom mappings, see the source for details. Example: # Enhance URL mode by updating the mapping. $config{mapping}{mode}{u} = sub { my ($key, $screen, $config, $input) = @_; # First get matches of normal URL mode. my $result = mapping_mode_url(@_); # Add all strings matching "CVE-1234-1234" with URLs pointing to the # Debian security tracker. "->{value}" is the string which is used as # result of the match (e.g. the URL in this case). my @matches = get_regex_matches($input, qr/\b(CVE-\d+-\d+)\b/); foreach (@matches) { $_->{value} = "https://security-tracker.debian.org/$_->{string}"; } push @{$result->{matches}}, @matches; # Change all YouTube links to use the custom "youtube" handler (see # below). This will allow us to automatically open YouTube URLs with a # custom program, like `youtube-dl` or `mpv`. foreach (@{$result->{matches}}) { if ($_->{string} =~ m{^https://www.youtube.com/}) { $_->{handler} = $config{handler}{youtube}; } } return $result; } # Also update initial mode to use our new "URL mode". $config{setting}{initial_mode} = $config{mapping}{mode}{u}; # Special handler to download YouTube URLs with `youtube-dl`. You could # also use `mpv` here to immediately play them. $config{handler}{youtube} = sub { my ($screen, $config, $match) = @_; return run_in_background($screen, sub { run_command($screen, ['youtube-dl', $match->{value}]); }); }; =cut # All variables and functions which are usable by ~/.fcscsrc. package Fcscs { our $screen; # "private" our %config; sub color_pair { return $screen->color_pair(@_); } sub mapping_mode_path { return main::mapping_mode_path(@_); } sub mapping_mode_url { return main::mapping_mode_url(@_); } sub mapping_mode_ip { return main::mapping_mode_ip(@_); } sub mapping_mode_checksum { return main::mapping_mode_checksum(@_); } sub mapping_mode_search { return main::mapping_mode_search(@_); } sub mapping_paste { return main::mapping_paste(@_); } sub mapping_paste_now { return main::mapping_paste_now(@_); } sub mapping_yank { return main::mapping_yank(@_); } sub mapping_yank_now { return main::mapping_yank_now(@_); } sub mapping_quit { return main::mapping_quit(@_); } sub handler_yank { return main::handler_yank(@_); } sub handler_paste { return main::handler_paste(@_); } sub handler_url { return main::handler_url(@_); } sub get_regex_matches { return main::get_regex_matches(@_); } sub select_match { return main::select_match(@_); } sub run_command { return main::run_command(@_); } sub run_in_background { return main::run_in_background(@_); } } $Fcscs::screen = $screen; # LOAD USER CONFIG # Alias %config and %Fcscs::config. %config is less to type. our %config; local *config = \%Fcscs::config; $config{mapping}{mode} = \%mapping_mode; $config{mapping}{simple} = \%mapping_simple; $config{attribute} = \%attribute; $config{setting} = \%setting; $config{regex} = \%regex; $config{handler} = \%handler; $config{state} = \%state; package Fcscs { my @configs = ("$ENV{HOME}/.fcscsrc", "$ENV{HOME}/.config/fcscs/fcscsrc"); foreach my $path (@configs) { my $decoded = $screen->decode($path); # Load configuration file. Checks have a race condition if the home # directory is writable by an attacker (but then the user is screwed # anyway). next unless -e $path; if (not -O $path) { $screen->die("Config '$decoded' not owned by current user!"); } # Make sure the file is not writable by other users. Doesn't handle # ACLs and see comment above about race conditions. my @stat = stat $path or $screen->die("Config '$decoded': $!"); my $mode = $stat[2]; if (($mode & Fcntl::S_IWGRP) or ($mode & Fcntl::S_IWOTH)) { $screen->die("Config '$decoded' must not be writable by other users."); } my $result = do $path; if (not $result) { $screen->die("Failed to parse '$decoded': $@") if $@; $screen->die("Failed to do '$decoded': $!") unless defined $result; $screen->die("Failed to run '$decoded'."); } last; # success, don't load more files } } $screen->{debug} = $config{setting}{debug}; # MAIN eval { # Auto-detect current multiplexer. if (not defined $config{setting}{multiplexer}) { if (defined $ENV{STY} and defined $ENV{TMUX}) { die 'Found both $STY and $TMUX, set $config{setting}{multiplexer}.'; } elsif (defined $ENV{STY}) { $config{setting}{multiplexer} = 'screen'; } elsif (defined $ENV{TMUX}) { $config{setting}{multiplexer} = 'tmux'; } else { die 'No multiplexer found.'; } } my $binmode = $encoding; # GNU screen stores the screen dump for unknown reasons as ISO-8859-1 # instead of the currently active encoding. if ($config{setting}{multiplexer} eq 'screen') { $binmode = 'ISO-8859-1'; } my @input_lines; open my $fh, '<', $ARGV[0] or die $!; binmode $fh, ":encoding($binmode)" or die $!; while (<$fh>) { chomp; push @input_lines, $_; } close $fh or die $!; my $input = prepare_input($screen, \@input_lines); # Display original screen content. my $y = 0; foreach (@{$input->{lines}}) { $screen->draw_simple($y++, 0, undef, $_); } $screen->refresh; my $mapping = $config{setting}{initial_mode}; my $key; while (1) { if (not defined $mapping) { $key = $screen->getch unless defined $key; $screen->debug('input', "got key '$key'"); $mapping = $config{mapping}{mode}{$key}; $mapping = $config{mapping}{simple}{$key} unless defined $mapping; if (not defined $mapping) { # ignore unknown mappings $key = undef; next; } } $screen->debug('input', 'running mapping'); my $result = $mapping->($key, $screen, \%config, $input); $mapping = undef; RESULT: if (defined $result->{quit}) { $screen->debug('input', 'quitting'); last; } if (defined $result->{key}) { $key = $result->{key}; # lookup another mapping $screen->debug('input', "processing new key: '$key'"); next; } if (defined $result->{select}) { $screen->debug('input', 'selecting match'); my $tmp = $result; $result = select_match($result->{select}, $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}) { 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; } $key = undef; # get next key from user } }; if ($@) { $screen->die("$@"); } $screen->deinit; __END__ =head1 EXIT STATUS =over 4 =item B<0> Success. =item B<1> An error occurred. =item B<2> Invalid arguments/options. =back =head1 AUTHOR Simon Ruderich E simon@ruderich.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2013-2016 by Simon Ruderich This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see E http://www.gnu.org/licenses/E . =head1 SEE ALSO L , L , L =cut