Update documentation
[fcscs/fcscs.git] / bin / fcscs
1 #!/usr/bin/perl
2
3 # fcscs - fast curses screen content select
4
5 # Copyright (C) 2013-2017  Simon Ruderich
6 #
7 # This program is free software: you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation, either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # This program is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
19
20
21 use strict;
22 use warnings;
23
24 use v5.10; # say, state
25
26 use Encode ();
27 use Fcntl ();
28 use I18N::Langinfo ();
29
30 use Curses ();
31
32 our $VERSION = '0.01';
33
34
35 =head1 NAME
36
37 fcscs - fast curses screen content select
38
39 =head1 SYNOPSIS
40
41 B<fcscs> [I<options>] I<path/to/screen/capture/file>
42
43 =head1 DESCRIPTION
44
45 B<fcscs> is a small tool which allows quick selection of terminal screen
46 contents (like URLs, paths, regex matches, etc.) and passes the selection to
47 GNU Screen's or Tmux's paste buffer or any other program. The selection can
48 then quickly be pasted, e.g. in the shell. Requires GNU Screen or Tmux to
49 capture the terminal content. It's licensed under the GPL 3 or later.
50
51 =head1 OPTIONS
52
53 None so far.
54
55 =head1 USAGE
56
57 Short overview of the general usage, details below:
58
59     - start fcscs
60     - configure actions (optional)
61         - enable pasting
62         - ...
63     - select mode (optional, URL mode is used on startup):
64         - f: file paths
65         - i: IPs
66         - u: URLs
67         - c: checksums (e.g. MD5, SHA1, ..)
68         - ...
69         - /: search mode
70     - for `normal' modes:
71         - select match by displayed number or <return> for lowest numbered
72           match
73         - configured action is run, e.g. URL is opened with browser
74     - for `search' mode:
75         - perform incremental search
76         - on <return> go to `normal' mode to select a match
77         - after the match is selected wait for confirmation or extension
78         - confirmation: <return> run previously selected action
79         - extension: change match, e.g. select complete word or line
80
81 GNU Screen setup (add to F<~/.screenrc>):
82
83     bind ^B eval "hardcopy $HOME/.tmp/screen-fcscs" "screen fcscs $HOME/.tmp/screen-fcscs"
84
85 Tmux setup (add to F<~/.tmux.conf>):
86
87     bind-key C-b capture-pane \; save-buffer ~/.tmp/tmux-fcscs \; delete-buffer \; new-window "fcscs ~/.tmp/tmux-fcscs"
88
89 This requires a writable ~/.tmp directory. Adapt the mapping according to your
90 preferences. Ensure these files are not readable by others as they can contain
91 private data (umask or protected directory). B<fcscs> must be in your C<$PATH>
92 for the above mappings to work.
93
94 Pressing the configured mapping (Prefix Ctrl-B in this example) opens B<fcscs>
95 in a new GNU screen/Tmux window. After selection, the content is either passed
96 to external programs (e.g. for URLs) or copied to the paste buffer or directly
97 pasted in your previous window and the new window is closed.
98
99 To select a match just type its number. If the match is unique, the entry is
100 automatically selected (e.g. you press 2 and there are only 19 matches). If
101 there are multiple matches left (e.g. you press 1 and there are more than ten
102 matches available), press return to select the current match (1 in this case)
103 or another number to select the longer match. Use backspace to remove the last
104 entered number.
105
106 Press return before entering a number to select the last (lowest numbered)
107 match (underlined by default). To abort without selecting any match use "q".
108
109 To change the selection mode (e.g. paths, files, etc.) use one of the mappings
110 explained below. Per default URLs are selected, see options for a way to
111 change this.
112
113 I<NOTE>: Opening URLs in the browser passes the URL via the command line which
114 might leak URLs to other users on the current system via C<ps aux> or C<top>
115 (mount C</proc> with C<hidepid=2> on Linux to prevent this information
116 leakage).
117
118 I<NOTE>: When yanking (copying) a temporary file is used to pass the data to
119 GNU screen/Tmux without exposing it to C<ps aux> or C<top>. However this may
120 leak data if those temporary files are written to disk. To prevent this change
121 your C<$TMP> to point to a memory-only location or encrypted storage.
122
123 If no window appears, try running B<fcscs> manually to catch the error message
124 and please report the bug:
125
126     fcscs /path/to/screen-or-tmux-fcscs-file
127
128
129 =head1 MODES
130
131 =cut
132
133
134 # CLASSES
135
136 # Helper class for drawing on the screen using Curses.
137 package Screen {
138     sub init {
139         my ($class, $encoding) = @_;
140
141         # Prefer strict UTF-8 handling (see perldoc Encode); just in case.
142         if (lc $encoding eq 'utf8') {
143             $encoding = 'UTF-8';
144         }
145         # Get Encode object to speed up decode()/encode().
146         my $encoding_object = Encode::find_encoding($encoding);
147         die "unsupported encoding '$encoding'" unless ref $encoding_object;
148
149         my $curses = Curses->new or die $!;
150
151         my $self = {
152             encoding        => $encoding,
153             encoding_object => $encoding_object,
154             curses          => $curses,
155             debug           => 0,
156             prompt          => {
157                 flags => undef,
158                 name  => undef,
159                 value => undef,
160             },
161         };
162         bless $self, $class;
163
164         Curses::start_color;
165         # Allow default colors by passing -1 to init_pair. A default color is
166         # not drawn on screen thus allowing terminals with pseudo-transparency
167         # to use the transparent background in place of the default color.
168         Curses::use_default_colors;
169
170         Curses::cbreak;
171         Curses::noecho;
172         $self->cursor(0);
173
174         return $self;
175     }
176     sub deinit {
177         my ($self) = @_;
178
179         Curses::nocbreak;
180         Curses::echo;
181         $self->cursor(1);
182
183         Curses::endwin;
184         return;
185     }
186
187     # Convert between Perl's internal encoding and the terminal's encoding.
188     sub encode {
189         my ($self, $string) = @_;
190         return $self->{encoding_object}->encode($string);
191     }
192     sub decode {
193         my ($self, $string) = @_;
194         return eval { # returns undef on decode failure
195             $self->{encoding_object}->decode($string, Encode::FB_CROAK);
196         };
197     }
198
199     # Create attribute for the given fore-/background colors.
200     sub color_pair {
201         my ($self, $fg, $bg) = @_;
202
203         state $next_color_pair = 1; # must start at 1 for init_pair()
204
205         Curses::init_pair($next_color_pair, $fg, $bg);
206         return Curses::COLOR_PAIR($next_color_pair++);
207     }
208
209     # Draw a string which must fit in the current line. Wrapping/clipping is
210     # not supported and must be handled by the caller.
211     sub draw_simple {
212         my ($self, $y, $x, $attributes, $string) = @_;
213
214         die if $string =~ /\n/;
215         # FIXME: wide characters
216         die if $x + length $string > $self->width;
217
218         $self->{curses}->attron($attributes) if defined $attributes;
219         $self->{curses}->addstr($y, $x, $self->encode($string));
220         $self->{curses}->attroff($attributes) if defined $attributes;
221         return;
222     }
223     # Like draw_simple(), but the string is automatically clipped.
224     sub draw_clipped {
225         my ($self, $y, $x, $attributes, $string) = @_;
226
227         # FIXME: wide characters
228         $string = substr $string, 0, $self->width - $x;
229         $self->draw_simple($y, $x, $attributes, $string);
230         return;
231     }
232     sub draw {
233         my ($self, $y, $x, $attributes, $string) = @_;
234
235         die unless defined $string;
236
237         while (1) {
238             my $offset;
239             # We must print each line separately. Search for next newline or
240             # line end, whichever is closer.
241             if ($string =~ /\n/) {
242                 $offset = $-[0];
243             }
244             # FIXME: wide characters
245             if ($x + length $string > $self->width) {
246                 my $new_offset = $self->width - $x;
247                 if (not defined $offset or $offset > $new_offset) {
248                     $offset = $new_offset;
249                 }
250             }
251             last unless defined $offset;
252
253             # FIXME: wide characters
254             $self->draw_simple($y, $x, $attributes, substr $string, 0, $offset);
255
256             # Don't draw "\n" itself.
257             if ("\n" eq substr $string, $offset, 1) {
258                 $offset++;
259             }
260
261             $string = substr $string, $offset;
262
263             $y++;
264             $x = 0;
265         }
266
267         $self->draw_simple($y, $x, $attributes, $string);
268         return $y;
269     }
270
271     sub draw_prompt {
272         my ($self, $config) = @_;
273
274         $self->debug('draw_prompt', 'started');
275
276         my $x = 0;
277         my $y = $self->height - 1;
278
279         # Clear line for better visibility.
280         $self->draw_simple($y, $x, undef, ' ' x $self->width);
281
282         # Draw prompt flags.
283         if (defined (my $s = $self->{prompt}{flags})) {
284             $s = "[$s]";
285             $self->debug('draw_prompt', $s);
286             $self->draw_clipped($y, $x, $config->{attribute}{prompt_flags}, $s);
287             $x += length($s) + 1; # space between next element
288         }
289         # Draw prompt name.
290         if (defined (my $s = $self->{prompt}{name})) {
291             $s = "[$s]";
292             $self->debug('draw_prompt', $s);
293             $self->draw_clipped($y, $x, $config->{attribute}{prompt_name}, $s);
294             $x += length($s) + 1;
295         }
296         # Draw prompt value, e.g. a search field.
297         if (defined (my $s = $self->{prompt}{value})) {
298             $self->debug('draw_prompt', $s);
299             $self->draw_clipped($y, $x, undef, $s);
300             $x += length($s) + 1;
301         }
302         return;
303     }
304
305     sub draw_matches {
306         my ($self, $config, $matches_remove, $matches_add) = @_;
307
308         foreach (@{$matches_remove}) {
309             $self->draw($_->{y}, $_->{x}, Curses::A_NORMAL, $_->{string});
310         }
311
312         my $attr_id     = $config->{attribute}{match_id};
313         my $attr_string = $config->{attribute}{match_string};
314         my $attr_last   = $config->{attribute}{match_last};
315
316         foreach (@{$matches_add}) {
317             my $attr = (defined $_->{id} and $_->{id} == 1)
318                      ? $attr_last
319                      : $attr_string;
320             $self->draw($_->{y}, $_->{x}, $attr, $_->{string});
321             if (defined $_->{id}) {
322                 $self->draw($_->{y}, $_->{x}, $attr_id, $_->{id});
323             }
324         }
325         return;
326     }
327
328
329     sub prompt {
330         my ($self, %settings) = @_;
331
332         foreach (keys %settings) {
333             die if not exists $self->{prompt}{$_};
334             $self->{prompt}{$_} = $settings{$_};
335         }
336         return;
337     }
338
339
340     sub debug {
341         my ($self, $module, @args) = @_;
342
343         return if not $self->{debug};
344
345         state $fh; # only open the file once per run
346         if (not defined $fh) {
347             # Ignore errors if the directory doesn't exist.
348             if (not open $fh, '>', "$ENV{HOME}/.config/fcscs/log") {
349                 $fh = undef; # a failed open still writes a value to $fh
350                 return;
351             }
352             $fh->autoflush(1);
353         }
354
355         foreach (@args) {
356             $_ = $self->encode($_);
357         }
358         say $fh "$module: @args" or die $!;
359         return;
360     }
361     sub die {
362         my ($self, @args) = @_;
363
364         my $attr = $self->color_pair(Curses::COLOR_RED, -1) | Curses::A_BOLD;
365
366         # Clear the screen to improve visibility of the error message.
367         $self->{curses}->clear;
368
369         my $y = $self->draw(0, 0, $attr, "@args");
370
371         if ($self->{debug}) {
372             my $msg;
373             eval {
374                 require Devel::StackTrace;
375             };
376             if ($@) {
377                 $msg = "Devel::StackTrace missing, no stack trace.\n";
378             } else {
379                 my $trace = Devel::StackTrace->new;
380                 $msg = "Stack trace:\n" . $trace->as_string;
381             }
382             $y = $self->draw($y + 1, 0, Curses::A_NORMAL, $msg);
383         }
384
385         $self->draw($y + 1, 0, Curses::A_NORMAL,
386                     'Press any key to terminate fcscs.');
387         $self->refresh;
388
389         $self->getch;
390         $self->deinit;
391         exit 1;
392     }
393
394     # Wrapper for Curses.
395     sub width   { return $Curses::COLS; }
396     sub height  { return $Curses::LINES; }
397     sub refresh { return $_[0]->{curses}->refresh; }
398     sub getch   { return $_[0]->{curses}->getch; }
399     sub cursor  { Curses::curs_set($_[1]); return; }
400 }
401
402
403
404 # FUNCTIONS
405
406 sub prepare_input {
407     my ($screen, $input_ref) = @_;
408
409     # Make sure the input fits on the screen by removing the top lines if
410     # necessary.
411     splice @{$input_ref}, 0, -$screen->height;
412
413     # Pad each line with spaces to the screen width to correctly handle
414     # multi-line regexes.
415     # FIXME: wide characters
416     my @padded = map { sprintf '%-*s', $screen->width, $_ } @{$input_ref};
417
418     my $string = join "\n", @padded;
419     return {
420         string => $string,
421         lines  => $input_ref,
422         width  => $screen->width + 1,
423                   # + 1 = "\n", used in input_match_offset_to_coordinates
424     };
425 }
426
427 sub input_match_offset_to_coordinates {
428     my ($width, $offset) = @_;
429
430     die unless defined $offset;
431
432     my $y = int($offset / $width);
433     my $x = $offset - $y * $width;
434     return ($x, $y);
435 }
436
437 sub get_regex_matches {
438     my ($input, $regex) = @_;
439
440     my @matches;
441     while ($input->{string} =~ /$regex/g) {
442         my $offset = $-[1];
443         die "Match group required in regex '$regex'" if not defined $offset;
444
445         my ($x, $y) = input_match_offset_to_coordinates($input->{width},
446                                                         $offset);
447         push @matches, { x => $x, y => $y, offset => $offset, string => $1 };
448     }
449     return @matches;
450 }
451
452
453 sub run_command {
454     my ($screen, $cmd) = @_;
455
456     $screen->debug('run_command', "running @{$cmd}");
457
458     my $exit = do {
459         # Perl's system() combined with a $SIG{__WARN__} which die()s has
460         # issues due to the fork. The die() in the __WARN__ handler doesn't
461         # die but the program continues after the system().
462         #
463         # If the forked process fails to exec (e.g. program not found) then
464         # the __WARN__ handler is called (because a warning is about to be
465         # displayed) and the die() should display a message and terminate the
466         # process. But due to the fork it doesn't terminate the parent process
467         # and instead changes the return value of system(); it's no longer -1
468         # which makes it impossible to detect that case.
469         #
470         # Perl < 5.18 (found in 5.14) doesn't setup $$ during system() which
471         # makes it impossible to detect if the handler was called from inside
472         # the child.
473         #
474         # Instead, just ignore any warnings during the system(). Thanks to
475         # mauke in #perl on Freenode (2013-10-29 23:30 CET) for the idea to
476         # use no warnings and anno for testing a more recent Perl version with
477         # a working $$.
478         no warnings;
479
480         my @cmd = map { $screen->encode($_) } @{$cmd};
481         system { $cmd[0] } @cmd;
482     };
483     if ($exit != 0) {
484         my $msg;
485         if ($? == -1) {
486             $msg = 'failed to execute: ' . $!;
487         } elsif ($? & 127) {
488             $msg = 'killed by signal ' . ($? & 127);
489         } else {
490             $msg = 'exited with code ' . ($? >> 8);
491         }
492         die "system(@{$cmd}) $msg.";
493     }
494     return;
495 }
496 sub run_in_background {
497     my ($screen, $sub) = @_;
498
499     $screen->debug('run_in_background', "running $sub");
500
501     my $pid = fork;
502     defined $pid or die $!;
503
504     if ($pid == 0) {
505         # The terminal multiplexer sends a SIGHUP to the process when it
506         # closes the window (because the parent process has exited).
507         local $SIG{HUP} = 'IGNORE';
508
509         # Necessary for GNU screen or it'll keep the window open until an
510         # external command has run.
511         require File::Spec; # load here to speedup startup
512         my $devnull = File::Spec->devnull();
513         open STDIN,  '<', $devnull or die $!;
514         open STDOUT, '>', $devnull or die $!;
515         open STDERR, '>', $devnull or die $!;
516
517         # Double-fork to prevent zombies.
518         my $pid = fork;
519         defined $pid or die $!;
520         if ($pid == 0) { # child
521             $sub->();
522         }
523         exit;
524     }
525     waitpid $pid, 0 or die $!;
526     return;
527 }
528
529
530 sub select_match {
531     my ($name, $screen, $config, $input, $matches) = @_;
532
533     $screen->debug('select_match', 'started');
534
535     return if @{$matches} == 0;
536     # Don't return on initial run to give the user a chance to select another
537     # mode, e.g. to switch from URL selection to search selection.
538     if (@{$matches} == 1 and not $config->{state}{initial}) {
539         return { match => $matches->[0] };
540     }
541     $config->{state}{initial} = 0;
542
543     my @sorted = sort { $b->{y} <=> $a->{y} or $b->{x} <=> $a->{x} } @{$matches};
544
545     my $i = 1;
546     foreach (@sorted) {
547         $_->{id} = $i++;
548     }
549
550     $screen->prompt(name => $name, value => undef);
551     $screen->draw_prompt($config);
552
553     $screen->draw_matches($config, [], $matches);
554     $screen->refresh;
555
556     my $number = 0;
557     while (1) {
558         my $char = $screen->getch;
559         if ($char =~ /^\d$/) {
560             $number = $number * 10 + $char;
561         } elsif ($char eq "\b" or $char eq "\x7f") { # backspace
562             $number = int($number / 10);
563         } elsif ($char eq "\n"
564                 or $char eq $config->{setting}{alternative_return}) {
565             last;
566
567         # Selecting a new mode requires falling through into the main input
568         # loop and then starting the new mode.
569         } elsif (defined $config->{mapping}{mode}{$char}) {
570             $screen->draw_matches($config, $matches, []); # clear matches
571             return { key => $char };
572         # All other mappings stay in the current mode.
573         } elsif (defined (my $m = $config->{mapping}{simple}{$char})) {
574             my $result = $m->($char, $screen, $config, $input);
575             last if defined $result->{select_match};
576             next;
577
578         } else {
579             next; # ignore unknown mappings
580         }
581
582         last if $number > 0 and $number * 10 > @{$matches}; # unique match
583
584         my @remaining = $number == 0
585                       ? @{$matches}
586                       : grep { $_->{id} =~ /^$number/ } @{$matches};
587         $screen->draw_matches($config, $matches, \@remaining);
588         $screen->refresh;
589     }
590     # Number without selection matches last entry.
591     if ($number == 0) {
592         $number = 1;
593     }
594
595     $screen->draw_matches($config, $matches, []); # clear matches
596
597     foreach (@{$matches}) {
598         return { match => $_ } if $_->{id} == $number;
599     }
600     $screen->debug('select_match', 'no match selected');
601     return { match => undef };
602 }
603
604 sub extend_match_regex_left {
605     my ($line, $match, $regex) = @_;
606
607     my $s = reverse substr $line, 0, $match->{x};
608     if ($s =~ /^($regex)/) {
609         $match->{string}  = reverse($1) . $match->{string};
610         $match->{x}      -= length $1;
611         $match->{offset} -= length $1;
612     }
613     return;
614 }
615 sub extend_match_regex_right {
616     my ($line, $match, $regex) = @_;
617
618     my $s = substr $line, $match->{x} + length $match->{string};
619     if ($s =~ /^($regex)/) {
620         $match->{string} .= $1;
621     }
622     return;
623 }
624 sub extend_match {
625     my ($screen, $config, $input, $match) = @_;
626
627     $screen->debug('extend_match', 'started');
628
629     return if not defined $match;
630
631     $screen->prompt(name => 'extend', value => undef);
632     $screen->draw_prompt($config);
633
634     delete $match->{id}; # don't draw any match ids
635     $screen->draw_matches($config, [], [$match]);
636     $screen->refresh;
637
638     my $line = $input->{lines}[$match->{y}];
639
640     while (1) {
641         my $match_old = \%{$match};
642
643         my $char = $screen->getch;
644         if ($char eq "\n"
645                 or $char eq $config->{setting}{alternative_return}) {
646             last; # accept match
647
648         } elsif ($char eq 'w') { # select current word (both directions)
649             extend_match_regex_left($line,  $match, qr/\w+/);
650             extend_match_regex_right($line, $match, qr/\w+/);
651         } elsif ($char eq 'b') { # select current word (only left)
652             extend_match_regex_left($line,  $match, qr/\w+/);
653         } elsif ($char eq 'e') { # select current word (only right)
654             extend_match_regex_right($line, $match, qr/\w+/);
655
656         } elsif ($char eq 'W') { # select current WORD (both directions)
657             extend_match_regex_left($line,  $match, qr/\S+/);
658             extend_match_regex_right($line, $match, qr/\S+/);
659         } elsif ($char eq 'B') { # select current WORD (only left)
660             extend_match_regex_left($line,  $match, qr/\S+/);
661         } elsif ($char eq 'E') { # select current WORD (only right)
662             extend_match_regex_right($line, $match, qr/\S+/);
663
664         } elsif ($char eq '0') { # select to beginning of line
665             extend_match_regex_left($line, $match, qr/.+/);
666         } elsif ($char eq '$') { # select to end of line
667             extend_match_regex_right($line, $match, qr/.+/);
668
669         # Allow mode changes if not overwritten by above mappings.
670         } elsif (defined $config->{mapping}{mode}{$char}) {
671             $screen->draw_matches($config, [$match_old], []); # clear match
672             return { key => $char };
673
674         } else {
675             next; # ignore unknown mappings
676         }
677
678         $screen->draw_matches($config, [$match_old], [$match]);
679         $screen->refresh;
680     }
681
682     $screen->debug('extend_match', 'done');
683
684     return { match => $match };
685 }
686
687
688 sub mapping_state_helper {
689     my ($name, $flags, $key, $screen, $config, $input) = @_;
690
691     $screen->debug("mapping_$name", 'started');
692
693     $config->{state}{handler} = $config->{handler}{$name};
694
695     $screen->prompt(flags => $flags);
696     $screen->draw_prompt($config);
697     $screen->refresh;
698
699     return {};
700 }
701 sub mapping_state_now_helper {
702     my ($name, $key, $screen, $config, $input) = @_;
703
704     $screen->debug("mapping_${name}_now", 'started');
705
706     $config->{state}{handler} = $config->{handler}{$name};
707
708     return {
709         select_match => 1,
710     };
711 }
712
713 sub mapping_paste {
714     return mapping_state_helper('paste', 'P', @_);
715 }
716 sub mapping_paste_now {
717     return mapping_state_now_helper('paste', @_);
718 }
719
720 sub mapping_yank {
721     return mapping_state_helper('yank', 'Y', @_);
722 }
723 sub mapping_yank_now {
724     return mapping_state_now_helper('yank', @_);
725 }
726
727
728 =head2 NORMAL MODES
729
730 Normal modes select matches by calling a function which returns them, e.g. by
731 using a regex.
732
733 The following normal modes are available:
734
735 =over 4
736
737 =item B<path mode>     select relative/absolute paths
738
739 =item B<url mode>      select URLs
740
741 =item B<ip mode>       select IPv4 and IPv6 addresses
742
743 =item B<checksum mode> select checksums (MD5, SHA1, SHA256, SHA512)
744
745 =back
746
747 =cut
748 sub mapping_mode_helper {
749     my ($name, $select, $key, $screen, $config, $input) = @_;
750
751     $screen->debug("mapping_mode_$name", 'started');
752
753     my @matches = get_regex_matches($input, $config->{regex}{$name});
754     return {
755         select  => $select,
756         matches => \@matches,
757         handler => $config->{handler}{$name},
758     };
759 }
760 sub mapping_mode_path {
761     return mapping_mode_helper('path', 'path select', @_);
762 }
763 sub mapping_mode_url {
764     return mapping_mode_helper('url', 'url select', @_);
765 }
766 sub mapping_mode_ip {
767     my ($key, $screen, $config, $input) = @_;
768
769     $screen->debug('mapping_mode_ip', 'started');
770
771     my @ipv4 = get_regex_matches($input, $config->{regex}{ipv4});
772     my @ipv6 = get_regex_matches($input, $config->{regex}{ipv6});
773     return {
774         select  => 'ip select',
775         matches => [@ipv4, @ipv6],
776         handler => $config->{handler}{ip},
777     };
778 }
779 sub mapping_mode_checksum {
780     return mapping_mode_helper('checksum', 'checksum select', @_);
781 }
782
783 =head2 SEARCH MODE (AND EXTEND MODE)
784
785 Search mode is a special mode which lets you type a search string (a Perl
786 regex) and then select one of the matches. Afterwards you can extend the
787 match. For example select the complete word or to the end of the line. This
788 allows quick selection of arbitrary text.
789
790 The following mappings are available during the extension mode (not
791 configurable at the moment):
792
793 =over 4
794
795 =item B<w> select current word
796
797 =item B<b> extend word to the left
798
799 =item B<e> extend word to the right
800
801 =item B<W> select current WORD
802
803 =item B<B> extend WORD to the left
804
805 =item B<E> extend WORD to the right
806
807 =item B<0> extend to beginning of line
808
809 =item B<$> extend to end of line
810
811 =back
812
813 C<word> includes any characters matching C<\w+>, C<WORD> any non-whitespace
814 characters (C<\S+>), just like in Vim.
815
816 =cut
817 sub mapping_mode_search {
818     my ($key, $screen, $config, $input) = @_;
819
820     $screen->debug('mapping_mode_search', 'started');
821
822     $screen->cursor(1);
823
824     my $search = ''; # encoded
825     my @last_matches;
826     while (1) {
827         # getch doesn't return decoded characters but raw input bytes. Wait
828         # until the input character is complete.
829         my $value = $screen->decode($search);
830         $value = '' unless defined $value; # undef on decode failure
831
832         $screen->prompt(name => 'search', value => $value);
833         $screen->draw_prompt($config);
834         $screen->refresh;
835
836         my $char = $screen->getch;
837         # TODO: readline editing support
838         if ($char eq "\n") {
839             last;
840         } elsif ($char eq "\b" or $char eq "\x7f") { # backspace
841             # Remove a character, not a byte.
842             $search = $screen->decode($search);
843             chop $search;
844             $search = $screen->encode($search);
845         } else {
846             $search .= $char;
847             next unless defined $screen->decode($search);
848         }
849
850         my @matches;
851         if ($search ne '') {
852             my $case = '';
853             if (($config->{setting}{smartcase} and $search eq lc $search)
854                     or $config->{setting}{ignorecase}) {
855                 $case = '(?i)';
856             }
857             # Ignore invalid regexps.
858             # TODO: display warning on error?
859             eval {
860                 @matches = get_regex_matches($input, qr/($case$search)/);
861             };
862         }
863         $screen->draw_matches($config, \@last_matches, \@matches);
864         @last_matches = @matches;
865     }
866
867     $screen->cursor(0);
868
869     $screen->prompt(name => undef, value => undef); # clear prompt
870     $screen->draw_prompt($config);
871
872     $screen->debug('mapping_mode_search', 'done');
873
874     return {
875         select  => 'search',
876         matches => \@last_matches,
877         extend  => 1,
878         handler => $config->{handler}{yank},
879     };
880 }
881
882 sub mapping_quit {
883     my ($key, $screen, $config, $input) = @_;
884
885     # Key is necessary to fall through to main event loop which then quits.
886     return { key => $key, quit => 1 };
887 }
888
889
890 sub handler_yank {
891     my ($screen, $config, $match) = @_;
892
893     $screen->debug('handler_yank', 'started');
894
895     require File::Temp; # load here to speedup startup
896
897     # Use a temporary file to prevent leaking the yanked data to other users
898     # with the command line, e.g. ps aux or top.
899     my ($fh, $tmp) = File::Temp::tempfile(); # dies on its own
900     print $fh $screen->encode($match->{value}) or die $!;
901     close $fh or die $!;
902
903     if ($config->{setting}{multiplexer} eq 'screen') {
904         $screen->debug('handler_yank', 'using screen');
905
906         # GNU screen displays an annoying "Slurping X characters into buffer".
907         # Use 'msgwait 0' as a hack to disable it.
908         my $msgwait = $config->{setting}{screen_msgwait};
909         run_command($screen, ['screen', '-X', 'msgwait', 0]);
910         run_command($screen, ['screen', '-X', 'readbuf', $tmp]);
911         run_command($screen, ['screen', '-X', 'msgwait', $msgwait]);
912     } elsif ($config->{setting}{multiplexer} eq 'tmux') {
913         $screen->debug('handler_yank', 'using tmux');
914
915         run_command($screen, ['tmux', 'load-buffer', $tmp]);
916     } else {
917         die 'unsupported multiplexer';
918     }
919
920     unlink $tmp or die $!;
921
922     if ($config->{setting}{yank_x11}) {
923         $screen->debug('handler_yank', 'setting X11 selection');
924
925         my @xsel_cmd  = qw( xsel --input --primary );
926         my @xclip_cmd = qw( xclip -in -selection primary );
927
928         my $fh;
929         {
930             # We don't care if a program doesn't exist.
931             no warnings;
932
933             if (not open $fh, '|-', @xsel_cmd) {
934                 if (not open $fh, '|-', @xclip_cmd) {
935                     die "install xsel or xlip to yank to X11 selection\n";
936                 }
937             }
938         }
939         print $fh $match->{value} or die $!;
940         close $fh or die $!;
941     }
942
943     return;
944 }
945 sub handler_paste {
946     my ($screen, $config, $match) = @_;
947
948     $screen->debug('handler_paste', 'started');
949
950     require Time::HiRes; # load here to speedup startup
951
952     my @cmd;
953     if ($config->{setting}{multiplexer} eq 'screen') {
954         $screen->debug('handler_paste', 'using screen');
955         @cmd = qw( screen -X paste . );
956     } elsif ($config->{setting}{multiplexer} eq 'tmux') {
957         $screen->debug('handler_paste', 'using tmux');
958         @cmd = qw( tmux paste-buffer );
959     } else {
960         die 'unsupported multiplexer';
961     }
962
963     run_in_background($screen, sub {
964         # We need to get the data in the paste buffer before we can paste
965         # it.
966         handler_yank($screen, $config, $match);
967
968         # Sleep until we switch back to the current window.
969         Time::HiRes::usleep($config->{setting}{paste_sleep});
970
971         run_command($screen, \@cmd);
972     });
973     return;
974 }
975 sub handler_url {
976     my ($screen, $config, $match) = @_;
977
978     $screen->debug('handler_url', "opening $match->{value}");
979
980     run_in_background($screen, sub {
981         my @cmd = ( @{$config->{setting}{browser}}, $match->{value} );
982         run_command($screen, \@cmd);
983     });
984     return;
985 }
986
987
988
989 # CONFIGURATION DEFAULTS
990
991 =head1 CONFIGURATION
992
993 fcscs is configured through F<~/.fcscsrc> (preferred) or
994 F<~/.config/fcscs/fcscsrc> which is a normal Perl script with all of Perl's
995 usual features (only loaded if not writable by others).
996
997 All configuration values are stored in the hash C<%config>. All manually
998 defined keys overwrite the default settings.
999
1000 A simple F<~/.fcscsrc> could look like this (for details about the used
1001 settings see below):
1002
1003     use strict;
1004     use warnings;
1005
1006     use Curses; # for COLOR_* and A_* constants
1007
1008     our %config;
1009
1010     # Draw matches in blue.
1011     $config{attribute}{match_string} = color_pair(COLOR_BLUE, -1);
1012     # Draw numbers in bold yellow.
1013     $config{attribute}{match_id} = color_pair(COLOR_YELLOW, -1)
1014                                  | A_BOLD;
1015     # Disable Vim-like 'smartcase' (ignore case until an upper character is
1016     # searched) which is enabled by default.
1017     $config{setting}{smartcase} = 0;
1018
1019     # Use chromium to open URLs if running under X, elinks otherwise.
1020     if (defined $ENV{DISPLAY}) {
1021         $config{setting}{browser} = ['chromium'];
1022     } else {
1023         $config{setting}{browser} = ['elinks', '-remote'];
1024     }
1025
1026     # Let fcscs know the file was loaded successfully.
1027     1;
1028
1029 =cut
1030
1031
1032 if (@ARGV != 1) {
1033     require Pod::Usage;
1034     Pod::Usage::pod2usage(2);
1035 }
1036
1037
1038 # Determine terminal encoding from the environment ($ENV{LANG} or similar).
1039 my $encoding = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET);
1040
1041 my $screen = Screen->init($encoding);
1042
1043 # We must restore the screen before exiting.
1044 local $SIG{INT} = sub {
1045     $screen->deinit;
1046     exit 128 + 2;
1047 };
1048 # Make all warnings fatal to make sure they don't get lost (stderr is normally
1049 # not displayed).
1050 local $SIG{__WARN__} = sub {
1051     $screen->die('warning', @_);
1052 };
1053
1054
1055
1056 =head2 MAPPINGS
1057
1058 I<NOTE>: Mappings are split in two categories: Mode mappings which change the
1059 selection and may receive additional input (e.g. a search string) and simple
1060 mappings which only change some config value. Mode mappings are configured via
1061 C<$config{mapping}{mode}>, simple mappings via C<$config{mapping}{simple}>.
1062
1063 The following mode mappings are available by default (the function to remap
1064 them in parentheses):
1065
1066 =over
1067
1068 =item B<f> select absolute/relative paths (C<\&mapping_mode_path>)
1069
1070 =item B<u> select URLs (C<\&mapping_mode_url>)
1071
1072 =item B<i> select IPv4 and IPv6 addresses (C<\&mapping_mode_ip>)
1073
1074 =item B<c> select checksums (e.g. MD5, SHA) (C<\&mapping_mode_checksum>)
1075
1076 =item B</> search for regex to get selection (C<\&mapping_mode_search>)
1077
1078 =item B<q> quit fcscs (C<\&mapping_quit>)
1079
1080 =back
1081
1082 The following simple mappings are available by default:
1083
1084 =over
1085
1086 =item B<p> enable pasting (C<\&mapping_paste>)
1087
1088 =item B<P> paste current selection (like C<\n> but paste) (C<\&mapping_paste_now>)
1089
1090 =item B<y> enable yanking (copying) (C<\&mapping_yank>)
1091
1092 =item B<Y> yank current selection (like C<\n> but yank) (C<\&mapping_yank_now>)
1093
1094 =back
1095
1096 Note that yanking only uses the GNU screen or Tmux paste buffer by default. To
1097 also copy to X11 selection, enable the B<yank_x11> option.
1098
1099 The following additional mappings are available by default:
1100
1101 =over
1102
1103 =item B<\n> accept current selection (not customizable)
1104
1105 =item B<s>  additional key to accept selection (B<alternative_return> option)
1106
1107 =back
1108
1109 All (single-byte) keys except numbers, backspace and return can be mapped.
1110
1111 Unknown mappings are ignored when pressing keys.
1112
1113 To remove a default mapping, delete it from the mapping hash.
1114
1115 Example:
1116
1117     # Map 'p' to select paths, 'P' to enable pasting.
1118     $config{mapping}{mode}{p} = \&mapping_mode_path;
1119     $config{mapping}{simple}{P} = \&mapping_paste;
1120
1121     # Disable 'f' mapping.
1122     delete $config{mapping}{mode}{f};
1123
1124 =cut
1125 my %mapping_mode = (
1126     f   => \&mapping_mode_path,
1127     u   => \&mapping_mode_url,
1128     i   => \&mapping_mode_ip,
1129     c   => \&mapping_mode_checksum,
1130     '/' => \&mapping_mode_search,
1131     q   => \&mapping_quit,
1132 );
1133 my %mapping_simple = (
1134     p => \&mapping_paste,
1135     P => \&mapping_paste_now,
1136     y => \&mapping_yank,
1137     Y => \&mapping_yank_now,
1138 );
1139
1140 =head2 ATTRIBUTES
1141
1142 Attributes are used to style the output. They must be Curses attributes.
1143 Defaults in parentheses (foreground, background, attribute).
1144
1145 =over
1146
1147 =item B<match_id>      attribute for match numbers (red, default, bold)
1148
1149 =item B<match_string>  attribute for matches (yellow, default, normal)
1150
1151 =item B<match_last>    attribute for the match selected by return (yellow, default, underline)
1152
1153 =item B<prompt_name>   attribute for prompt name (standout)
1154
1155 =item B<prompt_flags>  attribute for prompt flags (standout)
1156
1157 =back
1158
1159 Example:
1160
1161     # Draw prompt flags in bold red with default background color.
1162     $config{attribute}{prompt_flags}
1163         = Curses::A_BOLD
1164         | color_pair(Curses::COLOR_RED, -1);
1165
1166 =cut
1167 my %attribute = (
1168     match_id     => $screen->color_pair(Curses::COLOR_RED, -1)
1169                     | Curses::A_BOLD,
1170     match_string => $screen->color_pair(Curses::COLOR_YELLOW, -1),
1171     match_last   => $screen->color_pair(Curses::COLOR_YELLOW, -1)
1172                     | Curses::A_UNDERLINE,
1173     prompt_name  => Curses::A_STANDOUT,
1174     prompt_flags => Curses::A_STANDOUT,
1175 );
1176
1177 =head2 SETTINGS
1178
1179 Defaults in parentheses.
1180
1181 =over
1182
1183 =item B<debug>              enable debug mode, writes to I<~/.config/fcscs/log> (C<0>)
1184
1185 =item B<initial_mode>       start in this mode, must be a valid mode mapping (C<\&mapping_mode_url>)
1186
1187 =item B<multiplexer>        set multiplexer ("screen" or "tmux"), defaults to autodetection (C<undef>)
1188
1189 =item B<ignorecase>         ignore case when searching (C<0>)
1190
1191 =item B<smartcase>          ignore case unless one uppercase character is searched (C<1>)
1192
1193 =item B<yank_x11>           copy selection also to X11 primary selection when yanking (C<0>)
1194
1195 =item B<paste_sleep>        sleep x us before running paste command (C<100_000>)
1196
1197 =item B<screen_msgwait>     GNU Screen's msgwait variable, overwritten with this value when yanking (C<5>)
1198
1199 =item B<alternative_return> additional accept key like return, set to C<\n> to disable (C<s>)
1200
1201 =item B<browser>            browser command as array reference (C<['x-www-browser']>)
1202
1203 =back
1204
1205 Example:
1206
1207     # Select paths on startup instead of URLs.
1208     $config{setting}{initial_mode} = \&mapping_mode_path;
1209
1210 =cut
1211 my %setting = (
1212     # options
1213     debug              => 0,
1214     initial_mode       => \&mapping_mode_url,
1215     multiplexer        => undef,
1216     ignorecase         => 0,
1217     smartcase          => 1,
1218     yank_x11           => 0,
1219     paste_sleep        => 100_000,
1220     screen_msgwait     => 5,
1221     # global mappings
1222     alternative_return => 's',
1223     # commands
1224     browser            => ['x-www-browser'],
1225 );
1226
1227 =head2 REGEXPS
1228
1229 =over
1230
1231 =item B<url>  used by C<\&mapping_mode_url>
1232
1233 =item B<path> used by C<\&mapping_mode_path>
1234
1235 =item B<ipv4> used by C<\&mapping_mode_ip>
1236
1237 =item B<ipv6> used by C<\&mapping_mode_ip>
1238
1239 =back
1240
1241 Example:
1242
1243     # Select all non-whitespace characters when searching for paths.
1244     $config{regex}{path} = qr{(\S+)};
1245
1246 =cut
1247 my %regex = (
1248     # Taken from urlview's default configuration file, thanks.
1249     url  => qr{((?:(?:(?:http|https|ftp|gopher)|mailto):(?://)?[^ <>"\t]*|(?:www|ftp)[0-9]?\.[-a-z0-9.]+)[^ .,;\t\n\r<">\):]?[^, <>"\t]*[^ .,;\t\n\r<">\):])},
1250     path => qr{(~?[a-zA-Z0-9_./-]*/[a-zA-Z0-9_./-]+)},
1251     # IP addresses with optional prefix. Not perfectly accurate but good
1252     # enough.
1253     ipv4 => qr!\b(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:/\d{1,2})?)\b!,
1254     ipv6 => qr!\b((?:[0-9a-fA-F]{1,4})?(?::+[0-9a-fA-F]{1,4})+(?:/\d{1,3})?)\b!,
1255     # MD5, SHA1, SHA256, SHA512
1256     checksum => qr!\b([0-9a-fA-F]{32}|[0-9a-fA-F]{40}|[0-9a-fA-F]{64}|[0-9a-fA-F]{128})\b!,
1257 );
1258
1259 =head2 HANDLERS
1260
1261 Handlers are used to perform actions on the selected string.
1262
1263 The following handlers are available, defaults in parentheses.
1264
1265 =over
1266
1267 =item B<yank>     used to yank (copy) selection to paste buffer (C<\&handler_yank>)
1268
1269 =item B<paste>    used to paste selection into window (C<\&handler_paste>)
1270
1271 =item B<path>     used to handle paths (C<\&handler_yank>)
1272
1273 =item B<url>      used to open URLs (e.g. in a browser) (C<\&handler_url>)
1274
1275 =item B<ip>       used to handle IPs (C<\&handler_yank>)
1276
1277 =item B<checksum> used to handle checksums (C<\&handler_yank>)
1278
1279 =back
1280
1281 Example:
1282
1283     # Download YouTube videos with a custom wrapper, handle all other URLs
1284     # with the default URL handler.
1285     $config{handler}{url} = sub {
1286         my ($screen, $config, $match) = @_;
1287
1288         if ($match->{value} =~ m{^https://www.youtube.com/}) {
1289             return run_in_background($screen, sub {
1290                 run_command($screen, ['youtube-dl-wrapper', $match->{value}]);
1291             });
1292         }
1293         handler_url(@_);
1294     };
1295
1296 =cut
1297 my %handler = (
1298     yank     => \&handler_yank,
1299     paste    => \&handler_paste,
1300     path     => \&handler_yank,
1301     url      => \&handler_url,
1302     ip       => \&handler_yank,
1303     checksum => \&handler_yank,
1304 );
1305
1306 my %state = (
1307     initial => 1, # used by select_match() for 'initial_mode'
1308     handler => undef,
1309 );
1310
1311
1312
1313 # CONFIGURATION "API"
1314
1315 =head2 FUNCTIONS
1316
1317 The following functions are available:
1318
1319     color_pair($fg, $bg)
1320
1321 Create a new Curses attribute with the given fore- and background color.
1322
1323     mapping_mode_path()
1324     mapping_mode_url()
1325     mapping_mode_ip()
1326     mapping_mode_checksum()
1327     mapping_mode_search()
1328
1329     mapping_paste()
1330     mapping_paste_now()
1331     mapping_yank()
1332     mapping_yank_now()
1333     mapping_quit()
1334
1335 Used as mappings, see L</MAPPINGS> above.
1336
1337     handler_yank()
1338     handler_paste()
1339     handler_url()
1340
1341 Used as handler to yank, paste selection or open URL in browser.
1342
1343     get_regex_matches()
1344     select_match()
1345     run_command()
1346     run_in_background()
1347
1348 Helper functions when writing custom mappings, see the source and example for
1349 details.
1350
1351 Example:
1352
1353     # Enhance URL mode by updating the mapping.
1354     $config{mapping}{mode}{u} = sub {
1355         my ($key, $screen, $config, $input) = @_;
1356
1357         # First get matches of normal URL mode.
1358         my $result = mapping_mode_url(@_);
1359
1360         # Add all strings matching "CVE-1234-1234" with URLs pointing to the
1361         # Debian security tracker. "->{value}" is the string which is used as
1362         # result of the match (e.g. the URL in this case).
1363         my @matches = get_regex_matches($input, qr/\b(CVE-\d+-\d+)\b/);
1364         foreach (@matches) {
1365             $_->{value} = "https://security-tracker.debian.org/$_->{string}";
1366         }
1367         push @{$result->{matches}}, @matches;
1368
1369         # Change all YouTube links to use the custom "youtube" handler (see
1370         # below). This will allow us to automatically open YouTube URLs with a
1371         # custom program, like `youtube-dl` or `mpv`.
1372         foreach (@{$result->{matches}}) {
1373             if ($_->{string} =~ m{^https://www.youtube.com/}) {
1374                 $_->{handler} = $config{handler}{youtube};
1375             }
1376         }
1377
1378         return $result;
1379     };
1380     # Also update initial mode to use our new "URL mode".
1381     $config{setting}{initial_mode} = $config{mapping}{mode}{u};
1382
1383     # Special handler to download YouTube URLs with `youtube-dl`. You could
1384     # also use `mpv` here to immediately play them.
1385     $config{handler}{youtube} = sub {
1386         my ($screen, $config, $match) = @_;
1387
1388         return run_in_background($screen, sub {
1389             run_command($screen, ['youtube-dl', $match->{value}]);
1390         });
1391     };
1392
1393 =cut
1394
1395 # All variables and functions which are usable by ~/.fcscsrc.
1396 package Fcscs {
1397     our $screen; # "private"
1398     our %config;
1399
1400     sub color_pair { return $screen->color_pair(@_); }
1401
1402     sub mapping_mode_path { return main::mapping_mode_path(@_); }
1403     sub mapping_mode_url { return main::mapping_mode_url(@_); }
1404     sub mapping_mode_ip { return main::mapping_mode_ip(@_); }
1405     sub mapping_mode_checksum { return main::mapping_mode_checksum(@_); }
1406     sub mapping_mode_search { return main::mapping_mode_search(@_); }
1407
1408     sub mapping_paste { return main::mapping_paste(@_); }
1409     sub mapping_paste_now { return main::mapping_paste_now(@_); }
1410     sub mapping_yank { return main::mapping_yank(@_); }
1411     sub mapping_yank_now { return main::mapping_yank_now(@_); }
1412     sub mapping_quit { return main::mapping_quit(@_); }
1413
1414     sub handler_yank { return main::handler_yank(@_); }
1415     sub handler_paste { return main::handler_paste(@_); }
1416     sub handler_url { return main::handler_url(@_); }
1417
1418     sub get_regex_matches { return main::get_regex_matches(@_); }
1419     sub select_match { return main::select_match(@_); }
1420
1421     sub run_command { return main::run_command(@_); }
1422     sub run_in_background { return main::run_in_background(@_); }
1423 }
1424 $Fcscs::screen = $screen;
1425
1426
1427
1428 # LOAD USER CONFIG
1429
1430 # Alias %config and %Fcscs::config. %config is less to type.
1431 our %config;
1432 local *config = \%Fcscs::config;
1433
1434 $config{mapping}{mode}   = \%mapping_mode;
1435 $config{mapping}{simple} = \%mapping_simple;
1436 $config{attribute}       = \%attribute;
1437 $config{setting}         = \%setting;
1438 $config{regex}           = \%regex;
1439 $config{handler}         = \%handler;
1440 $config{state}           = \%state;
1441
1442 package Fcscs {
1443     my @configs = ("$ENV{HOME}/.fcscsrc",
1444                    "$ENV{HOME}/.config/fcscs/fcscsrc");
1445     foreach my $path (@configs) {
1446         my $decoded = $screen->decode($path);
1447
1448         # Load configuration file. Checks have a race condition if the home
1449         # directory is writable by an attacker (but then the user is screwed
1450         # anyway).
1451         next unless -e $path;
1452         if (not -O $path) {
1453             $screen->die("Config '$decoded' not owned by current user!");
1454         }
1455         # Make sure the file is not writable by other users. Doesn't handle
1456         # ACLs and see comment above about race conditions.
1457         my @stat = stat $path or $screen->die("Config '$decoded': $!");
1458         my $mode = $stat[2];
1459         if (($mode & Fcntl::S_IWGRP) or ($mode & Fcntl::S_IWOTH)) {
1460             $screen->die("Config '$decoded' must not be writable by other users.");
1461         }
1462
1463         my $result = do $path;
1464         if (not $result) {
1465             $screen->die("Failed to parse '$decoded': $@") if $@;
1466             $screen->die("Failed to do '$decoded': $!") unless defined $result;
1467             $screen->die("Failed to run '$decoded'.");
1468         }
1469
1470         last; # success, don't load more files
1471     }
1472 }
1473 $screen->{debug} = $config{setting}{debug};
1474
1475
1476 # MAIN
1477
1478 eval {
1479     # Auto-detect current multiplexer.
1480     if (not defined $config{setting}{multiplexer}) {
1481         if (defined $ENV{STY} and defined $ENV{TMUX}) {
1482             die 'Found both $STY and $TMUX, set $config{setting}{multiplexer}.';
1483         } elsif (defined $ENV{STY}) {
1484             $config{setting}{multiplexer} = 'screen';
1485         } elsif (defined $ENV{TMUX}) {
1486             $config{setting}{multiplexer} = 'tmux';
1487         } else {
1488             die 'No multiplexer found.';
1489         }
1490     }
1491
1492     my $binmode = $encoding;
1493     # GNU screen stores the screen dump for unknown reasons as ISO-8859-1
1494     # instead of the currently active encoding.
1495     if ($config{setting}{multiplexer} eq 'screen') {
1496         $binmode = 'ISO-8859-1';
1497     }
1498
1499     my @input_lines;
1500     open my $fh, '<', $ARGV[0] or die $!;
1501     binmode $fh, ":encoding($binmode)" or die $!;
1502     while (<$fh>) {
1503         chomp;
1504         push @input_lines, $_;
1505     }
1506     close $fh or die $!;
1507
1508     my $input = prepare_input($screen, \@input_lines);
1509
1510     # Display original screen content.
1511     my $y = 0;
1512     foreach (@{$input->{lines}}) {
1513         $screen->draw_simple($y++, 0, undef, $_);
1514     }
1515     $screen->refresh;
1516
1517
1518     my $mapping = $config{setting}{initial_mode};
1519
1520     my $key;
1521     while (1) {
1522         if (not defined $mapping) {
1523             $key = $screen->getch unless defined $key;
1524             $screen->debug('input', "got key '$key'");
1525
1526             $mapping = $config{mapping}{mode}{$key};
1527             $mapping = $config{mapping}{simple}{$key} unless defined $mapping;
1528             if (not defined $mapping) { # ignore unknown mappings
1529                 $key = undef;
1530                 next;
1531             }
1532         }
1533
1534         $screen->debug('input', 'running mapping');
1535         my $result = $mapping->($key, $screen, \%config, $input);
1536         $mapping = undef;
1537
1538 RESULT:
1539         if (defined $result->{quit}) {
1540             $screen->debug('input', 'quitting');
1541             last;
1542         }
1543         if (defined $result->{key}) {
1544             $key = $result->{key}; # lookup another mapping
1545             $screen->debug('input', "processing new key: '$key'");
1546             next;
1547         }
1548         if (defined $result->{select}) {
1549             $screen->debug('input', 'selecting match');
1550             my $tmp = $result;
1551             $result = select_match($result->{select},
1552                                    $screen, \%config, $input,
1553                                    $result->{matches});
1554             $result->{handler} = $tmp->{handler};
1555             $result->{extend}  = $tmp->{extend};
1556             goto RESULT; # reprocess special entries in result
1557         }
1558         if (defined $result->{extend}) {
1559             $screen->debug('input', 'extending match');
1560             $result = extend_match($screen, \%config, $input,
1561                                    $result->{match});
1562             goto RESULT; # reprocess special entries in result
1563         }
1564         if (defined $result->{match}) {
1565             if (not defined $result->{match}{value}) {
1566                 $result->{match}{value} = $result->{match}{string};
1567             }
1568
1569             $screen->debug('input', 'running handler');
1570
1571             # Choose handler with falling priority.
1572             my @handlers = (
1573                 $config{state}{handler},     # set by user
1574                 $result->{match}{handler},   # set by match
1575                 $result->{handler},          # set by mapping
1576                 $config{handler}{yank},      # fallback
1577             );
1578             foreach my $handler (@handlers) {
1579                 next unless defined $handler;
1580
1581                 $handler->($screen, \%config, $result->{match});
1582                 last;
1583             }
1584             last;
1585         }
1586
1587         $key = undef; # get next key from user
1588     }
1589 };
1590 if ($@) {
1591     $screen->die("$@");
1592 }
1593
1594 $screen->deinit;
1595
1596 __END__
1597
1598 =head1 EXIT STATUS
1599
1600 =over 4
1601
1602 =item B<0>
1603
1604 Success.
1605
1606 =item B<1>
1607
1608 An error occurred.
1609
1610 =item B<2>
1611
1612 Invalid arguments/options.
1613
1614 =back
1615
1616 =head1 AUTHOR
1617
1618 Simon Ruderich E<lt>simon@ruderich.orgE<gt>
1619
1620 =head1 LICENSE AND COPYRIGHT
1621
1622 Copyright (C) 2013-2017 by Simon Ruderich
1623
1624 This program is free software: you can redistribute it and/or modify
1625 it under the terms of the GNU General Public License as published by
1626 the Free Software Foundation, either version 3 of the License, or
1627 (at your option) any later version.
1628
1629 This program is distributed in the hope that it will be useful,
1630 but WITHOUT ANY WARRANTY; without even the implied warranty of
1631 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1632 GNU General Public License for more details.
1633
1634 You should have received a copy of the GNU General Public License
1635 along with this program.  If not, see E<lt>http://www.gnu.org/licenses/E<gt>.
1636
1637 =head1 SEE ALSO
1638
1639 L<screen(1)>, L<tmux(1)>, L<urlview(1)>
1640
1641 =cut