summaryrefslogtreecommitdiff
path: root/pandoc-emphasis
blob: 13c39413839c0745a1e29b0a5b0b2606d09fd2d9 (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 $womb = Uterus->new;
  59. pandoc_filter(
  60. \&emphasis,
  61. );
  62. # FIXME: wrongly messes with "'''open'''": avoid strong emphasis
  63. # FIXME: wrongly adds quotation mark to "'''''if''''' ...": maybe avoid emphasis not immediately followed by plain text?
  64. # TODO: flatten only Str and Space as content of new children, else skip
  65. sub emphasis {
  66. my $self = shift;
  67. # TODO: replace @children with $kids ref, and use at more places
  68. my (@children, $last_child, $kid);
  69. # we do our own walk of inline objects
  70. return unless $self->is_block;
  71. # skip known irrelevant block types
  72. return if ( $self->name =~
  73. /CodeBlock|RawBlock|Header|HorizontalRule|Null/ );
  74. # skip known irrelevant block types
  75. if ( $self->name =~
  76. /OrderedList|BulletList|DefinitionList|Table/
  77. ) {
  78. $log->infof( 'emphasis: skipping unsupported block: %s',
  79. $self->name );
  80. return
  81. };
  82. # align coherently and walk direct descendants
  83. if ( reftype $self->content eq 'ARRAY') {
  84. @children = @{ $self->content };
  85. $last_child = scalar $self->content->[
  86. ( keys @{ $self->content } ) -1 ];
  87. } elsif ( reftype $self->content eq 'HASH') {
  88. @children = [ $self->content ];
  89. $last_child = scalar $self->content;
  90. } else {
  91. $log->warnf( 'emphasis: skipping oddly structured block: %s',
  92. $self->name );
  93. return;
  94. }
  95. $kid = 0;
  96. $log->debugf( 'emphasis: processing block: %s',
  97. $self->name );
  98. while ($kid < keys @children ) {
  99. # title markup via Quoted
  100. # TODO: limit container to type DoubleQuote
  101. if ( $self->content->[$kid]->name eq 'Quoted'
  102. and $self->content->[$kid]->content->[0]->name eq 'Emph'
  103. ) {
  104. my $new_content = stringify(
  105. $self->content->[$kid]->content->[0] );
  106. $log->infof( 'emphasis: Quoted+Emph→title: %s',
  107. $new_content );
  108. # FIXME: LaTeX-encode content
  109. $womb->create(
  110. Quoted( DoubleQuote,
  111. $new_content ));
  112. $kid++;
  113. next;
  114. }
  115. # title markup via quotation mark in Str
  116. # TODO: widen container to non-upright doublequote
  117. if ( $self->content->[$kid]->name eq 'Str'
  118. and $self->content->[$kid]->content eq '"'
  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 eq '"'
  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 = stringify(
  139. $self->content->[$kid]->content->[0] );
  140. $log->infof( 'emphasis: Emph+Quoted→foreign: %s',
  141. $new_content );
  142. # FIXME: LaTeX-encode content
  143. $womb->create(
  144. RawInline( 'latex',
  145. sprintf( '\foreign{%s}',
  146. $new_content )));
  147. $kid++;
  148. next;
  149. }
  150. # foreign markup via quotation mark in Str
  151. # TODO: widen container to non-upright doublequote
  152. if ( $self->content->[$kid]->name eq 'Emph'
  153. and stringify($self->content->[$kid]) =~ /^(\")([^\"]+)\"$/
  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. }