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. }