summaryrefslogtreecommitdiff
path: root/pandoc-emphasis
blob: 35f60762fe72ee5b00cffff9d90594c57670d13a (plain)
  1. #!/usr/bin/perl
  2. # emphasis + doublequote means technical or foreign term.
  3. # doublequote + emphasis means title.
  4. #
  5. # Pandoc parses quotation marks in two ways (possibly concurrently):
  6. #  * Leave as-is when parsing and serializing
  7. #  * smart-converts to Quoted object and serializes to ``'' or `'
  8. # Some quotation marks may still be left as-is in smart mode, depending
  9. # on parser.  See e.g. https://github.com/jgm/pandoc/issues/2012
  10. #
  11. # This filter handles Quoted objects and (less reliably) Char quotes.
  12. use Moops -strict;
  13. use Pandoc::Filter 0.06;
  14. use Pandoc::Elements 0.12;
  15. use Scalar::Util qw(reftype);
  16. use Clone qw(clone);
  17. use Log::Any qw($log);
  18. use Log::Any::Adapter ( 'Screen',
  19.     use_color => ! -t *STDERR );
  20. # TODO: add class Egg, and coercing roles Exotic and Noble
  21. class Uterus with MooX::Role::Logger {
  22.     lexical_has fetuses => (
  23.         isa => ArrayRef[Object],
  24.         default => sub { [] },
  25.         reader => \( my $fetuses ),
  26.         lazy => 1,
  27.     );
  28.     has is_monstrous => (
  29.         is => 'rw',
  30.         isa => Bool,
  31.         default => sub { 0 },
  32.     );
  33.     # TODO: replace with method fertilize, with Egg coercions
  34.     method implant ( Object $clone ) {
  35.         push @{ $self->$fetuses }, $clone;
  36.     }
  37.     method create ( Object $monster ) {
  38.         push @{ $self->$fetuses }, $monster;
  39.         $self->is_monstrous(1);
  40.     }
  41.     method abort () {
  42.         splice @{ $self->$fetuses };
  43.         return;
  44.     }
  45.     method deliver () {
  46.         my @babies = splice @{ $self->$fetuses };
  47.         if ($self->_logger->is_debug()) {
  48. #           $self->_logger->debugf( 'giving birth: %s',
  49. #               \@babies );
  50.             for my $baby ( @babies ) {
  51.                 $self->_logger->debugf( 'giving birth: %s',
  52.                     $baby->name );
  53.             };
  54.         };
  55.         return [ @babies ];
  56.     }
  57. }
  58. my $doublequote = qr/[\"\x{00AB}\x{00BB}\x{201C}-\x{201F}\x{300C}-\x{300F}\x{301D}-\x{301F}\x{FE41}-\x{FE44}\x{FF02}\x{FF62}\x{FF63}]/;
  59. my $nodoublequote = qr/[^\"\x{00AB}\x{00BB}\x{201C}-\x{201F}\x{300C}-\x{300F}\x{301D}-\x{301F}\x{FE41}-\x{FE44}\x{FF02}\x{FF62}\x{FF63}]/;
  60. my $womb = Uterus->new;
  61. pandoc_filter(
  62.     \&emphasis,
  63. );
  64. # FIXME: wrongly messes with "'''open'''": avoid strong emphasis
  65. # FIXME: wrongly adds quotation mark to "'''''if''''' ...": maybe avoid emphasis not immediately followed by plain text?
  66. # TODO: flatten only Str and Space as content of new children, else skip
  67. sub emphasis {
  68.     my $self = shift;
  69.     # TODO: replace @children with $kids ref, and use at more places
  70.     my (@children, $last_child, $kid);
  71.     # we do our own walk of inline objects
  72.     return unless $self->is_block;
  73.     # skip known irrelevant block types
  74.     return if ( $self->name =~
  75.         /CodeBlock|RawBlock|Header|HorizontalRule|Null/ );
  76.     # skip known irrelevant block types
  77.     if ( $self->name =~
  78.         /OrderedList|BulletList|DefinitionList|Table/
  79.     ) {
  80.         $log->infof( 'emphasis: skipping unsupported block: %s',
  81.             $self->name );
  82.         return
  83.     };
  84.     # align coherently and walk direct descendants
  85.     if ( reftype $self->content eq 'ARRAY') {
  86.         @children = @{ $self->content };
  87.         $last_child = scalar $self->content->[
  88.             ( keys @{ $self->content } ) -1 ];
  89.     } elsif ( reftype $self->content eq 'HASH') {
  90.         @children = [ $self->content ];
  91.         $last_child = scalar $self->content;
  92.     } else {
  93.         $log->warnf( 'emphasis: skipping oddly structured block: %s',
  94.             $self->name );
  95.         return;
  96.     }
  97.     $kid = 0;
  98.     $log->debugf( 'emphasis: processing block: %s',
  99.         $self->name );
  100.     while ($kid < keys @children ) {
  101.         # title markup via Quoted
  102.         # TODO: limit container to type DoubleQuote
  103.         if ( $self->content->[$kid]->name eq 'Quoted'
  104.             and $self->content->[$kid]->content->[0]->name eq 'Emph'
  105.         ) {
  106.             my $new_content = $self->content->[$kid]->content->[0]->string;
  107.             $log->infof( 'emphasis: Quoted+Emph→title: %s',
  108.                 $new_content );
  109.             # FIXME: LaTeX-encode content
  110.             $womb->create(
  111.                 Quoted( DoubleQuote,
  112.                 $new_content ));
  113.             $kid++;
  114.             next;
  115.         }
  116.         # title markup via quotation mark in Str
  117.         if ( $self->content->[$kid]->name eq 'Str'
  118.             and $self->content->[$kid]->content =~ /$doublequote/
  119.             and $self->content->[$kid+1]->name eq 'Emph'
  120.             and $self->content->[$kid+2]->name eq 'Str'
  121.             and $self->content->[$kid+2]->content =~ /$doublequote/
  122.         ) {
  123.             $log->infof( 'emphasis: %s+Emph→title: %s',
  124.                 $self->content->[$kid]->content,
  125.                 stringify(
  126.                     $self->content->[$kid+1]->content ));
  127.             $womb->create(
  128.                 Quoted( DoubleQuote,
  129.                 $self->content->[$kid+1]->content ));
  130.             $kid += 3;
  131.             next;
  132.         };
  133.         # foreign markup via Quoted
  134.         # TODO: limit container to type DoubleQuote
  135.         if ( $self->content->[$kid]->name eq 'Emph'
  136.             and $self->content->[$kid]->content->[0]->name eq 'Quoted'
  137.         ) {
  138.             my $new_content = $self->content->[$kid]->content->[0]->string;
  139.             $log->infof( 'emphasis: Emph+Quoted→foreign: %s',
  140.                 $new_content );
  141.             # FIXME: LaTeX-encode content
  142.             $womb->create(
  143.                 RawInline( 'latex',
  144.                 sprintf( '\foreign{%s}',
  145.                     $new_content )));
  146.             $kid++;
  147.             next;
  148.         }
  149.         # foreign markup via quotation mark in Str
  150.         if ( $self->content->[$kid]->name eq 'Emph'
  151.             and $self->content->[$kid]->string
  152. #           =~ /^(\")([^\"]+)\"$/
  153.             =~ /^($doublequote)(^$nodoublequote+)$doublequote$/
  154.         ) {
  155.             $log->infof( 'emphasis: Emph+%s→foreign: %s',
  156.                 $1, $2 );
  157.             # FIXME: LaTeX-encode content
  158.             $womb->create(
  159.                 RawInline( 'latex',
  160.                 sprintf( '\foreign{%s}',
  161.                     $2 )));
  162.             $kid++;
  163.             next;
  164.         }
  165.         # clone healthy kid, in case of monstrous siblings
  166.         $womb->implant( $self->content->[$kid] );
  167.         $kid++;
  168.     }
  169.     # cheaper to abort (i.e. return nothing) if no monsters created
  170.     return $womb->abort unless ($womb->is_monstrous);
  171.     my $kids = $womb->deliver;
  172.     $log->debugf( 'delivered kids: %s', $kids );
  173.     # dirty hack to preserve non-content block parts
  174.     my $new_block = clone $self;
  175.     $$new_block{c} = $kids;
  176.     $log->debugf( 'block: %s', $new_block );
  177.     return [ $new_block ];
  178. }