view release on metacpan or  search on metacpan

lib/Circle/FE/Term/Widget/Scroller.pm  view on Meta::CPAN

   my $indent = 4;
   if( grep { $_ eq "indent" } $str->tagnames and 
       my $extent = $str->get_tag_missing_extent( 0, "indent" ) ) {
      # TODO: Should use textwidth not just char. count
      $indent = $extent->end;
   }

   return Tickit::Widget::Scroller::Item::RichText->new( $str, indent => $indent );
}

my %colourcache;
sub _convert_colour
{
   my $self = shift;
   my ( $colspec ) = @_;

   return undef if !defined $colspec;

   return $colourcache{$colspec} ||= sub {
      return Convert::Color->new( "rgb8:$1$1$2$2$3$3" )->$AS_TERM->index if $colspec =~ m/^#([0-9A-F])([0-9A-F])([0-9A-F])$/i;
      return Convert::Color->new( "rgb8:$1$2$3" )->$AS_TERM->index if $colspec =~ m/^#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i;
      return Convert::Color->new( "vga:$colspec" )->index if $colspec =~ m/^[a-z]+$/;

      print STDERR "TODO: Unknown colour spec $colspec\n";
      6; # TODO
   }->();
}

sub _apply_formatting
{
   my $self = shift;
   my ( $format, $args, $str ) = @_;

   while( length $format ) {
      if( $format =~ s/^\$(\w+)// ) {
         my $val = exists $args->{$1} ? $args->{$1} : "<No such variable $1>";
         defined $val or $val = "<Variable $1 is not defined>";

         my @parts = ref $val eq "ARRAY" ? @$val : ( $val );

         my $is_initial = 1;
         my $needs_linefeed;

         foreach my $part ( @parts ) {
            my ( $text, %format ) = ref $part eq "ARRAY" ? @$part : ( $part );

            $str->append( "\n" ) if $needs_linefeed; $needs_linefeed = 0;

            # Convert some tags
            if( delete $format{m} ) {
               # Monospace
               $format{af} = 1;
               $format{bg} = "#303030";
            }
            if( delete $format{bq} ) {
               # Quoted text
               $format{bg} = "#303030";
               $format{fg} = "#00C0C0";

               # blockquotes get to be on their own line, with "> " prefixed on each
               $text = join( "\n", map { "> $_" } split m/\n/, $text );

               # surround the text by linefeeds
               $str->append( "\n" ) if !$is_initial;
               $needs_linefeed++;
            }

            # Tickit::Widget::Scroller::Item::Text doesn't like C0, C1 or DEL
            # control characters. Replace them with U+FFFD
            # Be sure to leave linefeed alone
            $text =~ s/[\x00-\x09\x0b-\x1f\x80-\x9f\x7f]/\x{fffd}/g;

            foreach (qw( fg bg )) {
               defined $format{$_} or next;
               $format{$_} = $self->_convert_colour( Circle::FE::Term->translate_theme_colour( $format{$_} ) );
            }

            $str->append_tagged( $text, %format );

            $is_initial = 0;
         }
      }
      elsif( $format =~ m/^\{/ ) {
         my $piece = extract_bracketed( $format, "{}" );
         s/^{//, s/}$// for $piece;

         if( $piece =~ m/^\?\$/ ) {
            # A conditional expansion in three parts
            #   {?$varname|IFTRUE|IFFALSE}
            my ( $varname, $iftrue, $iffalse ) = split( m/\|/, $piece, 3 );
            $varname =~ s/^\?\$//;

            if( defined $args->{$varname} ) {
               $self->_apply_formatting( $iftrue, $args, $str );
            }
            else {
               $self->_apply_formatting( $iffalse, $args, $str );
            }
         }
         elsif( $piece =~ m/ / ) {
            my ( $code, $content ) = split( m/ /, $piece, 2 );

            my ( $type, $arg ) = split( m/:/, $code, 2 );

            my $start = length $str->str;

            $self->_apply_formatting( $content, $args, $str );

            my $end = length $str->str;

            $arg = $self->_convert_colour( $arg ) if $type eq "fg" or $type eq "bg";
            $str->apply_tag( $start, $end - $start, $type => $arg );
         }
         else {
            $self->_apply_formatting( $piece, $args, $str );
         }
      }
      else {
         $format =~ s/^([^\$\{]+)//;
         my $val = $1;
         $str->append( $val );