summaryrefslogtreecommitdiff
path: root/pandoc-emphasis
blob: 5427068a72273953319b46b7099c493f42872199 (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. $self->content->[$kid+1]->content );
  126. $womb->create(
  127. Quoted( DoubleQuote,
  128. $self->content->[$kid+1]->content ));
  129. $kid += 3;
  130. next;
  131. };
  132. # foreign markup via Quoted
  133. # TODO: limit container to type DoubleQuote
  134. if ( $self->content->[$kid]->name eq 'Emph'
  135. and $self->content->[$kid]->content->[0]->name eq 'Quoted'
  136. ) {
  137. my $new_content = $self->content->[$kid]->content->[0]->string;
  138. $log->infof( 'emphasis: Emph+Quoted→foreign: %s',
  139. $new_content );
  140. # FIXME: LaTeX-encode content
  141. $womb->create(
  142. RawInline( 'latex',
  143. sprintf( '\foreign{%s}',
  144. $new_content )));
  145. $kid++;
  146. next;
  147. }
  148. # foreign markup via quotation mark in Str
  149. if ( $self->content->[$kid]->name eq 'Emph'
  150. and $self->content->[$kid]->string
  151. # =~ /^(\")([^\"]+)\"$/
  152. =~ /^($doublequote)(^$nodoublequote+)$doublequote$/
  153. ) {
  154. $log->infof( 'emphasis: Emph+%s→foreign: %s',
  155. $1, $2 );
  156. # FIXME: LaTeX-encode content
  157. $womb->create(
  158. RawInline( 'latex',
  159. sprintf( '\foreign{%s}',
  160. $2 )));
  161. $kid++;
  162. next;
  163. }
  164. # clone healthy kid, in case of monstrous siblings
  165. $womb->implant( $self->content->[$kid] );
  166. $kid++;
  167. }
  168. # cheaper to abort (i.e. return nothing) if no monsters created
  169. return $womb->abort unless ($womb->is_monstrous);
  170. my $kids = $womb->deliver;
  171. $log->debugf( 'delivered kids: %s', $kids );
  172. # dirty hack to preserve non-content block parts
  173. my $new_block = clone $self;
  174. $$new_block{c} = $kids;
  175. $log->debugf( 'block: %s', $new_block );
  176. return [ $new_block ];
  177. }