view release on metacpan or  search on metacpan

lib/App/sdview/Style.pm  view on Meta::CPAN

            }
            else {
               $k => sub { $FORMATSTYLES{$k}->%* };
            }
         } keys %FORMATSTYLES ),
      },
   );
}

my %PARASTYLES = (
   head1    => { fg => "vga:yellow", bold => 1 },
   head2    => { fg => "vga:cyan",   bold => 1, margin => 2 },
   head3    => { fg => "vga:green",  bold => 1, margin => 4 },
   head4    => { fg => "xterm:217",  under => 1, margin => 5 },
   plain    => { margin => 6, blank_after => 1 },
   verbatim => { margin => 8, blank_after => 1, inherit => "monospace" },
   list     => { margin => 6 },
   item     => { blank_after => 1 },
   leader   => { bold => 1 },
   table    => { margin => 8 },
   "table-heading" => { bold => 1 },
);
_fixup_colour_keys $_ for values %PARASTYLES;

sub para_style ( $pkg, $type )
{
   $PARASTYLES{$type} or
      die "Unrecognised paragraph style for $type";

   my %style = $PARASTYLES{$type}->%*;
   %style = ( %style, $FORMATSTYLES{delete $style{inherit}}->%* ) if defined $style{inherit};
   defined $style{$_} or delete $style{$_} for keys %style;

   return \%style;
}

my %HIGHLIGHTSTYLES = (
   # Names stolen from tree-sitter's highlight theme
   attribute  => { fg => "vga:cyan", italic => 1 },
   character  => { fg => "vga:magenta" },
   comment    => { fg => "xterm:15", bg => "xterm:54", italic => 1 },
   decorator  => { fg => "xterm:140", italic => 1 },
   function   => { fg => "xterm:147", },
   keyword    => { fg => "vga:yellow", bold => 1 },
   module     => { fg => "vga:green", bold => 1 },
   number     => { fg => "vga:magenta" },
   operator   => { fg => "vga:yellow" },
   string     => { fg => "vga:magenta" },
   type       => { fg => "vga:green" },
   variable   => { fg => "vga:cyan" },

   'string.special' => { fg => "vga:red" },
   'function.builtin' => { fg => "xterm:147", bold => 1 },
);
$HIGHLIGHTSTYLES{$_} = { fallback => "keyword"  } for qw( include repeat conditional exception );
$HIGHLIGHTSTYLES{$_} = { fallback => "function" } for qw( method );
_fixup_colour_keys $_ for values %HIGHLIGHTSTYLES;

sub highlight_style ( $pkg, $key )
{
   my @nameparts = split m/\./, $key;
   while( @nameparts ) {
      my $style = $HIGHLIGHTSTYLES{ join ".", @nameparts } or
         pop( @nameparts ), next;

      if( keys( $style->%* ) == 1 and defined( my $fbkey = $style->{fallback} ) ) {
         return $pkg->highlight_style( $fbkey );
      }

      return $style;
   }

   return undef;
}

my %VALID_STYLE_KEYS = map { $_ => 1 } qw(
   fg bg
   bold italic monospace blank_after
   under margin
);

sub _convert_val ( $stylekey, $val )
{
   return undef if !defined $val or $val eq "~";

   if( $stylekey =~ m/^(fg|bg)$/ ) {
      return Convert::Color->new( $val );
   }
   elsif( $stylekey =~ m/^(bold|italic|monospace|blank_after)$/ ) {
      return !!$val;
   }
   elsif( $stylekey =~ m/^(under|margin)$/ ) {
      return 0+$val;
   }
   else {
      return undef;
   }
}

sub load_config ( $pkg, $path )
{
   require Config::Tiny;

   # For unit testing, also accept a globref
   my $config = ( ref $path ) ? Config::Tiny->read_string( do { local $/; <$path> } )
                              : Config::Tiny->read( $path );

   foreach my $section ( sort keys %$config ) {
      my $configdata = $config->{$section};

      if( $section =~ m/^Inline (.*)$/ ) {
         my $format = $1;

         unless( $FORMATSTYLES{$format} ) {
            warn "Unrecognised $section format in $path\n";
            next;
         }

         foreach my $stylekey ( sort keys $configdata->%* ) {
            $VALID_STYLE_KEYS{$stylekey} or
               warn( "Unrecognised $section key $stylekey in $path\n" ), next;