view release on metacpan or  search on metacpan

lib/Tickit/Style.pm  view on Meta::CPAN

sub load_style_file
{
   shift;
   my ( $path ) = @_;
   # TODO: use ->from_file( $path, binmode => ":encoding(UTF-8)" ) when available
   my $str = do {
      open my $fh, "<:encoding(UTF-8)", $path or croak "Cannot read $path - $!";
      local $/;
      <$fh>;
   };
   _load_style( Tickit::Style::Parser->new->from_string( $str ) );
}

=head2 load_style_from_DATA

   Tickit::Style->load_style_from_DATA

A convenient shortcut for loading style definitions from the caller's C<DATA>
filehandle.

=cut

sub load_style_from_DATA
{
   shift;
   my $pkg = caller;
   my $fh = do { no strict 'refs'; \*{"${pkg}::DATA"} };
   my $str = do { local $/; <$fh> };
   _load_style( Tickit::Style::Parser->new->from_string( $str ) );
}

=head2 on_style_load

   Tickit::Style::on_style_load( \&code )

Adds a CODE reference to be invoked after either C<load_style> or
C<load_style_file> are called. This may be useful to flush any caches or
invalidate any state that depends on style information.

=cut

sub on_style_load
{
   my ( $code ) = @_;
   push @ON_STYLE_LOAD, $code;
}

package # hide from indexer
   Tickit::Style::_Tagset;

use Struct::Dumb;

# A "Keyset" is the set of style keys applied to one particular set of style
# tags
struct Keyset => [qw( tags style )];

sub new
{
   my $class = shift;
   return bless [], $class;
}

sub clone
{
   my $proto = shift;
   return bless [ map { Keyset( $_->tags, { %{$_->style} } ) }
                      @$proto ], ref $proto;
}

sub add
{
   my $self = shift;
   my ( $key, $value ) = @_;

   my %tags;
   $tags{$1}++ while $key =~ s/:([A-Z0-9_-]+)//i;

   $self->merge_with_tags( \%tags, { $key => $value } );
}

sub merge
{
   my $self = shift;
   my ( $other ) = @_;

   foreach my $keyset ( $other->keysets ) {
      $self->merge_with_tags( $keyset->tags, $keyset->style );
   }
}

sub merge_with_tags
{
   my $self = shift;
   my ( $tags, $style ) = @_;

   my $keyset = Keyset( $tags, $style );
   @$self = ( $keyset ) and return if !@$self;

   # First see if we have to merge an existing one
   KEYSET: foreach my $keyset ( @$self ) {
      $keyset->tags->{$_} or next KEYSET for keys %$tags;
      $tags->{$_} or next KEYSET for keys %{ $keyset->tags };

      # Merge
      foreach my $key ( keys %$style ) {
         defined $style->{$key} ? $keyset->style->{$key} = $style->{$key}
                                : delete $keyset->style->{$key};
      }
      return;
   }

   # Keep sorted, most tags first
   # TODO: this might be doable more efficiently but we don't care for now
   @$self = sort { scalar keys %{ $b->tags } <=> scalar keys %{ $a->tags } } ( @$self, $keyset );
}

sub keysets
{
   my $self = shift;
   return @$self;
}

0x55AA;