summaryrefslogtreecommitdiff
path: root/pandoc-emphasis
blob: 50da37ee9d2fd8bec4df54075ecaef4221d5b10f (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;
  15. use Scalar::Util qw(reftype);
  16. use Clone qw(clone);
  17. use Log::Any qw($log);
  18. use Log::Any::Adapter ( 'ScreenColoredLevel',
  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 = stringify(
  107.                 $self->content->[$kid]->content->[0] );
  108.             $log->infof( 'emphasis: Quoted+Emph→title: %s',
  109.                 $new_content );
  110.             # FIXME: LaTeX-encode content
  111.             $womb->create(
  112.                 Quoted( DoubleQuote,
  113.                 $new_content ));
  114.             $kid++;
  115.             next;
  116.         }
  117.         # title markup via quotation mark in Str
  118.         if ( $self->content->[$kid]->name eq 'Str'
  119.             and $self->content->[$kid]->content =~ /$doublequote/
  120.             and $self->content->[$kid+1]->name eq 'Emph'
  121.             and $self->content->[$kid+2]->name eq 'Str'
  122.             and $self->content->[$kid+2]->content =~ /$doublequote/
  123.         ) {
  124.             $log->infof( 'emphasis: %s+Emph→title: %s',
  125.                 $self->content->[$kid]->content,
  126.                 stringify(
  127.                     $self->content->[$kid+1]->content ));
  128.             $womb->create(
  129.                 Quoted( DoubleQuote,
  130.                 $self->content->[$kid+1]->content ));
  131.             $kid += 3;
  132.             next;
  133.         };
  134.         # foreign markup via Quoted
  135.         # TODO: limit container to type DoubleQuote
  136.         if ( $self->content->[$kid]->name eq 'Emph'
  137.             and $self->content->[$kid]->content->[0]->name eq 'Quoted'
  138.         ) {
  139.             my $new_content = stringify(
  140.                 $self->content->[$kid]->content->[0] );
  141.             $log->infof( 'emphasis: Emph+Quoted→foreign: %s',
  142.                 $new_content );
  143.             # FIXME: LaTeX-encode content
  144.             $womb->create(
  145.                 RawInline( 'latex',
  146.                 sprintf( '\foreign{%s}',
  147.                     $new_content )));
  148.             $kid++;
  149.             next;
  150.         }
  151.         # foreign markup via quotation mark in Str
  152.         if ( $self->content->[$kid]->name eq 'Emph'
  153.             and stringify($self->content->[$kid])
  154. #           =~ /^(\")([^\"]+)\"$/
  155.             =~ /^($doublequote)(^$nodoublequote+)$doublequote$/
  156.         ) {
  157.             $log->infof( 'emphasis: Emph+%s→foreign: %s',
  158.                 $1, $2 );
  159.             # FIXME: LaTeX-encode content
  160.             $womb->create(
  161.                 RawInline( 'latex',
  162.                 sprintf( '\foreign{%s}',
  163.                     $2 )));
  164.             $kid++;
  165.             next;
  166.         }
  167.         # clone healthy kid, in case of monstrous siblings
  168.         $womb->implant( $self->content->[$kid] );
  169.         $kid++;
  170.     }
  171.     # cheaper to abort (i.e. return nothing) if no monsters created
  172.     return $womb->abort unless ($womb->is_monstrous);
  173.     my $kids = $womb->deliver;
  174.     $log->debugf( 'delivered kids: %s', $kids );
  175.     # dirty hack to preserve non-content block parts
  176.     my $new_block = clone $self;
  177.     $$new_block{c} = $kids;
  178.     $log->debugf( 'block: %s', $new_block );
  179.     return [ $new_block ];
  180. }