#!/usr/bin/env perl # vifm # Copyright (C) 2015 xaizek. # # 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 2 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, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA use strict; use warnings; use File::Basename('basename'); use Getopt::Long('GetOptions'); # "{color number} -> {Vifm color name}" mapping. my @COLORS = ( 'black', 'red', 'green', 'yellow', 'blue', 'magenta', 'cyan', 'white', ); # "{dircolors type} -> {Vifm color group}" mapping. my %GROUPS = ( 'chr' => 'Device', 'blk' => 'Device', 'normal' => 'Win', 'file' => 'Win', 'dir' => 'Directory', 'exec' => 'Executable', 'fifo' => 'Fifo', 'link' => 'Link', 'orphan' => 'BrokenLink', 'sock' => 'Socket', ); # "{$LS_COLORS type} -> {Vifm color group}" mapping. my %SHORT_GROUPS = ( 'cd' => 'Device', 'bd' => 'Device', 'no' => 'Win', 'fi' => 'Win', 'di' => 'Directory', 'ex' => 'Executable', 'ln' => 'Link', 'or' => 'BrokenLink', 'pi' => 'Fifo', 'so' => 'Socket', ); my ($help, $env, $readable); GetOptions('h|help|?' => \$help, 'e|environment' => \$env, 'r|human-readable' => \$readable) or exit 1; if ($help) { &abort_with_usage(1); } if (scalar(@ARGV) > 1) { &abort_with_usage_error("Too many arguments."); } # Input source data either from file/stdin or LS_COLORS environment variable. my ($patcol, $typecol); if ($env) { ($patcol, $typecol) = &import_from_env('LS_COLORS'); } else { my $dircolors = shift; ($patcol, $typecol) = &import_from_file($dircolors); } my %patcol = %$patcol; my %typecol = %$typecol; # Join extensions that have same attributes into single record. my %colpat = &invert_attrmap(\%patcol); # Print out Vifm commands to stdout. if (%typecol) { print "\" generic file types\n"; &print_typecol(\%typecol); } if (%colpat) { print "\n" if %typecol; print "\" file name specific highlight\n"; &print_attrmap(\%colpat); } # Aborts execution after displaying a message. # * $msg - error message. sub abort_with_usage_error { my $msg = shift; print STDERR "@{[basename($0)]}: $msg\n"; &abort_with_usage(0); } # Aborts execution after displaying usage. # * $detailed - whether short description should be displayed. sub abort_with_usage { my $detailed = shift; if ($detailed) { print "Description:\n\n". "Converts ls file highlighting configuration (man dircolors) ". "into set\nof Vifm highlight commands.\n\n"; } print "Usage: @{[basename($0)]} [-h|--help] ". "[-e|--environment] ". "[-r|--human-readable] ". "[dircolors_file] By default standard input is processed. Options: -h, --help brief help message -e, --environment parse \$LS_COLORS for configuration -r, --human-readable output patterns on separate lines\n"; exit 1; } # Imports initial data from file/stdin. # * $dircolors - path to the file or undef for stdin. # Returns (\%patcol, \%typecol), where # * %patcol - "suffix" => "attrlist" # * %typecol - "Vifm highlight group" => "attrlist". sub import_from_file { my $dircolors = shift; if (!defined($dircolors)) { $dircolors = '-'; } my %patcol = (); my %typecol = (); open (DIRCOLORS, $dircolors) or die("Cannot open $dircolors $!"); while (my $line = <DIRCOLORS>) { chomp $line; if ($line =~ /^\.(\S+)\s+(\S+)/) { my $pat = '\.'.$1; my $attrs = $2; &add_to_attrmap(\%patcol, $pat, $attrs); } elsif ($line =~ /^\*(\S+)\s+(\S+)/) { my $pat = $1; my $attrs = $2; &add_to_attrmap(\%patcol, $pat, $attrs); } elsif ($line =~ /^(\S+)\s+(\S+)/) { my $type = lc $1; my $attrs = $2; if (exists($GROUPS{$type})) { my $group = $GROUPS{$type}; $typecol{$group} = $attrs; } } } close DIRCOLORS; return (\%patcol, \%typecol); } # Imports initial data from an environment variable. # * $env - name of environment variable to use. # Returns (\%patcol, \%typecol), where # * %patcol - "suffix" => "attrlist" # * %typecol - "Vifm highlight group" => "attrlist" sub import_from_env { my $env = shift; my %patcol = (); my %typecol = (); my @specs = split(':', $ENV{$env}); foreach my $spec (@specs) { my ($name, $attrs) = split('=', $spec); if (exists($SHORT_GROUPS{lc $name})) { my $group = $SHORT_GROUPS{$name}; $typecol{$group} = $attrs; } elsif ($name =~ /^\*\.(\S+)/) { my $pat = '\.'.$1; &add_to_attrmap(\%patcol, $pat, $attrs); } elsif ($name =~ /^\*(\S+)/) { my $pat = $1; &add_to_attrmap(\%patcol, $pat, $attrs); } } return (\%patcol, \%typecol); } # Adds extension pattern entry to a dictionary ("suffix" => "attrlist"). # * $extcol - the dictionary. # * $ext - the pattern. # * $attrs - list of attributes. sub add_to_attrmap { my $extcol = shift; my $ext = shift; my $attrs = shift; if (exists($extcol->{$ext}) && $extcol->{$ext} ne $attrs) { warn 'Different attributes for extension in different cases: '. $ext; } $extcol->{$ext} = $attrs; } # Join extensions that have same attributes into single record. # * $attrmap - "suffix" => "attrlist". # Returns %inverted, where # * %inverted - "attrlist" => "suffix,...". sub invert_attrmap { my $attrmap = shift; my %attrmap = %$attrmap; my %dotonly = (); foreach my $ext (keys %attrmap) { my $color = $attrmap{$ext}; if (!exists($dotonly{$color})) { $dotonly{$color} = 1; } if ($ext !~ /^\\\..*$/) { $dotonly{$color} = 0; } } my %inverted = (); foreach my $ext (sort keys %attrmap) { my $color = $attrmap{$ext}; if (exists($inverted{$color})) { $inverted{$color} .= $readable ? "|\n \\" : '|'; } if ($dotonly{$color}) { $inverted{$color} .= substr $ext, 2; } else { $inverted{$color} .= $ext; } } foreach my $color (keys %inverted) { if ($dotonly{$color}) { $inverted{$color} = "^.*\\\.($inverted{$color})\$"; } else { $inverted{$color} = "^.*($inverted{$color})\$"; } } return %inverted; } # Formats and prints to stdout generic file types highlighting commands. # * \%typecol - "Vifm highlight group" => "attrlist". sub print_typecol { my $typecol = shift; my %typecol = %$typecol; return unless %typecol; foreach my $type (sort keys %typecol) { my $color = $typecol{$type}; my $hi = &color_to_hi($color); print 'highlight ', $type, $hi, "\n"; } } # Formats and prints to stdout file name specific highlighting commands. # * \%attrmap - "attrlist" => "suffix". sub print_attrmap { my $attrmap = shift; my %attrmap = %$attrmap; return unless %attrmap; foreach my $color (sort keys %attrmap) { my $pattern = "/$attrmap{$color}/I"; my $hi = &color_to_hi($color); print 'highlight ', $pattern, $hi, "\n"; } } # Converts list of attributes (escape codes) into arguments for the :highlight # command of Vifm. # * $color - semicolon-separated list of attributes. # Returns $hi_str, where # * $hi_str - arguments in form of string that starts with white space. sub color_to_hi { my $color = shift; my @attrs = (); my $fg = undef; my $bg = undef; my @color_components = split(';', $color); my $long_fg = 0; my $long_bg = 0; foreach my $component (@color_components) { if (&long_attr($component, \$fg, \$long_fg)) { next; } if (&long_attr($component, \$bg, \$long_bg)) { next; } if ($component == 0) { @attrs = (); $fg = undef; $bg = undef; } elsif ($component == 1) { push @attrs, 'bold'; } elsif ($component == 4) { push @attrs, 'underline'; } elsif ($component == 3 || $component == 7) { push @attrs, 'reverse'; } elsif ($component >= 30 && $component <= 37) { $fg = $COLORS[$component - 30]; } elsif ($component == 38) { $long_fg = 1; } elsif ($component == 39) { $fg = undef; } elsif ($component >= 40 && $component <= 47) { $bg = $COLORS[$component - 40]; } elsif ($component == 48) { $long_bg = 1; } elsif ($component == 49) { $bg = undef; } } my $hi_str = ''; if (scalar(@attrs) != 0) { $hi_str .= ' cterm='.join(',', @attrs); } else { $hi_str .= ' cterm=none'; } if (defined $fg) { $hi_str .= ' ctermfg='.$fg; } else { $hi_str .= ' ctermfg=default'; } if (defined $bg) { $hi_str .= ' ctermbg='.$bg; } else { $hi_str .= ' ctermbg=default'; } return $hi_str; } # Parses long attribute (256-color). # * $component - attribute. # * \$col - final color storage. # * \$state - long attribute parsing state (0 - not active, 1 - start, 2 - mid). # Returns $consumed, where # * $consumed - true when component is consumed, false otherwise. sub long_attr { my $component = shift; my $col = shift; my $state = shift; if (${$state} == 1) { if ($component == 5) { $${state} = 2; return 1; } } elsif (${$state} == 2) { ${$col} = $component; $${state} = 0; return 1; } return 0; }