summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJonas Smedegaard <dr@jones.dk>2015-03-23 01:06:01 +0100
committerJonas Smedegaard <dr@jones.dk>2015-03-23 01:06:01 +0100
commit28bb27d79b6d7a2038cd57696942bc1b98ed265b (patch)
tree0fc2384d77bf53039fb579b413eba5fc373fc4d9
parentf264ef9110344de5273e6cca5ccc729538cd0815 (diff)
Refactor - should actually work sufficiently for current document now.
-rwxr-xr-xpandoc-emphasis226
1 files changed, 150 insertions, 76 deletions
diff --git a/pandoc-emphasis b/pandoc-emphasis
index 34770f5..13c3941 100755
--- a/pandoc-emphasis
+++ b/pandoc-emphasis
@@ -2,121 +2,195 @@
# emphasis + doublequote means technical or foreign term.
# doublequote + emphasis means title.
+#
+# Pandoc parses quotation marks in two ways (possibly concurrently):
+# * Leave as-is when parsing and serializing
+# * smart-converts to Quoted object and serializes to ``'' or `'
+# Some quotation marks may still be left as-is in smart mode, depending
+# on parser. See e.g. https://github.com/jgm/pandoc/issues/2012
+#
+# This filter handles Quoted objects and (less reliably) Char quotes.
use Moops -strict;
use Pandoc::Filter 0.06;
use Pandoc::Elements;
+use Scalar::Util qw(reftype);
+use Clone qw(clone);
use Log::Any qw($log);
use Log::Any::Adapter ( 'ScreenColoredLevel',
use_color => ! -t *STDERR );
-class Window {
- use Pandoc::Filter;
+# TODO: add class Egg, and coercing roles Exotic and Noble
- has view => {
+class Uterus with MooX::Role::Logger {
+ lexical_has fetuses => (
+ isa => ArrayRef[Object],
+ default => sub { [] },
+ reader => \( my $fetuses ),
+ lazy => 1,
+ );
+ has is_monstrous => (
is => 'rw',
- isa => Object,
- };
- has ledge => {
- is => 'rw',
- isa => Maybe[Object],
- };
- method set_view ( Object $object ) {
- $self->view($object);
- }
- method peek_at_ledge () {
- return
- unless ( $self->ledge );
- my $value = stringify( $self->ledge );
- $value = $self->ledge->content;
- return $value;
+ isa => Bool,
+ default => sub { 0 },
+ );
+ # TODO: replace with method fertilize, with Egg coercions
+ method implant ( Object $clone ) {
+ push @{ $self->$fetuses }, $clone;
}
- method clear_ledge () {
- $self->ledge(undef);
+ method create ( Object $monster ) {
+ push @{ $self->$fetuses }, $monster;
+ $self->is_monstrous(1);
}
- method my $recall_from_ledge () {
- my $oldview = $self->ledge;
- $self->clear_ledge;
- return $oldview;
- }
- method describe_view () {
- return [ $self->$recall_from_ledge, $self->view ]
- if ( $self->ledge );
+ method abort () {
+ splice @{ $self->$fetuses };
return;
}
- method interpret_view ( Object $interpretation ) {
- return [ $self->$recall_from_ledge, $interpretation ]
- if ( $self->$recall_from_ledge );
- return [ $interpretation ];
- }
- method suppress_view () {
- return [ $self->$recall_from_ledge ]
- if ( $self->ledge );
- return [];
- }
- method postpone_view () {
- $self->ledge( $self->view );
- return [];
+ method deliver () {
+ my @babies = splice @{ $self->$fetuses };
+ if ($self->_logger->is_debug()) {
+# $self->_logger->debugf( 'giving birth: %s',
+# \@babies );
+ for my $baby ( @babies ) {
+ $self->_logger->debugf( 'giving birth: %s',
+ $baby->name );
+ };
+ };
+ return [ @babies ];
}
}
-my $window = Window->new;
-
-my ($title, $foreign);
+my $womb = Uterus->new;
pandoc_filter(
\&emphasis,
);
+# FIXME: wrongly messes with "'''open'''": avoid strong emphasis
+# FIXME: wrongly adds quotation mark to "'''''if''''' ...": maybe avoid emphasis not immediately followed by plain text?
+# TODO: flatten only Str and Space as content of new children, else skip
sub emphasis {
my $self = shift;
- return unless ( $self->name =~ /Str|Emph/ );
- if ( $self->name eq 'Emph' ) {
- $window->set_view($self);
- if ( $self->content->[0]->name eq 'Str'
- and $window->peek_at_ledge() eq '"'
+ # TODO: replace @children with $kids ref, and use at more places
+ my (@children, $last_child, $kid);
+
+ # we do our own walk of inline objects
+ return unless $self->is_block;
+
+ # skip known irrelevant block types
+ return if ( $self->name =~
+ /CodeBlock|RawBlock|Header|HorizontalRule|Null/ );
+
+ # skip known irrelevant block types
+ if ( $self->name =~
+ /OrderedList|BulletList|DefinitionList|Table/
+ ) {
+ $log->infof( 'emphasis: skipping unsupported block: %s',
+ $self->name );
+ return
+ };
+
+ # align coherently and walk direct descendants
+ if ( reftype $self->content eq 'ARRAY') {
+ @children = @{ $self->content };
+ $last_child = scalar $self->content->[
+ ( keys @{ $self->content } ) -1 ];
+ } elsif ( reftype $self->content eq 'HASH') {
+ @children = [ $self->content ];
+ $last_child = scalar $self->content;
+ } else {
+ $log->warnf( 'emphasis: skipping oddly structured block: %s',
+ $self->name );
+ return;
+ }
+ $kid = 0;
+ $log->debugf( 'emphasis: processing block: %s',
+ $self->name );
+ while ($kid < keys @children ) {
+ # title markup via Quoted
+ # TODO: limit container to type DoubleQuote
+ if ( $self->content->[$kid]->name eq 'Quoted'
+ and $self->content->[$kid]->content->[0]->name eq 'Emph'
+ ) {
+ my $new_content = stringify(
+ $self->content->[$kid]->content->[0] );
+ $log->infof( 'emphasis: Quoted+Emph→title: %s',
+ $new_content );
+ # FIXME: LaTeX-encode content
+ $womb->create(
+ Quoted( DoubleQuote,
+ $new_content ));
+ $kid++;
+ next;
+ }
+ # title markup via quotation mark in Str
+ # TODO: widen container to non-upright doublequote
+ if ( $self->content->[$kid]->name eq 'Str'
+ and $self->content->[$kid]->content eq '"'
+ and $self->content->[$kid+1]->name eq 'Emph'
+ and $self->content->[$kid+2]->name eq 'Str'
+ and $self->content->[$kid+2]->content eq '"'
) {
- $window->clear_ledge();
- $title++;
$log->infof( 'emphasis: %s+Emph→title: %s',
- '"',
+ $self->content->[$kid]->content,
stringify(
- $self->content ));
- return $window->interpret_view(
+ $self->content->[$kid+1]->content ));
+ $womb->create(
Quoted( DoubleQuote,
- $self->content ));
- }
- if ( $self->content->[0]->name eq 'Quoted'
+ $self->content->[$kid+1]->content ));
+ $kid += 3;
+ next;
+ };
+ # foreign markup via Quoted
+ # TODO: limit container to type DoubleQuote
+ if ( $self->content->[$kid]->name eq 'Emph'
+ and $self->content->[$kid]->content->[0]->name eq 'Quoted'
) {
my $new_content = stringify(
- $self->content->[0] );
+ $self->content->[$kid]->content->[0] );
$log->infof( 'emphasis: Emph+Quoted→foreign: %s',
$new_content );
# FIXME: LaTeX-encode content
- return $window->interpret_view(
+ $womb->create(
RawInline( 'latex',
sprintf( '\foreign{%s}',
$new_content )));
+ $kid++;
+ next;
}
- return $window->describe_view();
- }
- if ( $self->name eq 'Str' ) {
- $window->set_view($self);
- if ( $self->content eq '"' ) {
- if ($title) {
- $title--;
- return $window->suppress_view();
- };
- return $window->postpone_view();
- }
- $window->clear_ledge();
- if ($title) {
- $log->warnf( "emphasis: odd title end markup." );
- $title--;
+ # foreign markup via quotation mark in Str
+ # TODO: widen container to non-upright doublequote
+ if ( $self->content->[$kid]->name eq 'Emph'
+ and stringify($self->content->[$kid]) =~ /^(\")([^\"]+)\"$/
+ ) {
+ $log->infof( 'emphasis: Emph+%s→foreign: %s',
+ $1, $2 );
+ # FIXME: LaTeX-encode content
+ $womb->create(
+ RawInline( 'latex',
+ sprintf( '\foreign{%s}',
+ $2 )));
+ $kid++;
+ next;
}
- return $window->describe_view();
+
+ # clone healthy kid, in case of monstrous siblings
+ $womb->implant( $self->content->[$kid] );
+ $kid++;
}
- return;
+
+ # cheaper to abort (i.e. return nothing) if no monsters created
+ return $womb->abort unless ($womb->is_monstrous);
+
+ my $kids = $womb->deliver;
+ $log->debugf( 'delivered kids: %s', $kids );
+
+ # dirty hack to preserve non-content block parts
+ my $new_block = clone $self;
+ $$new_block{c} = $kids;
+ $log->debugf( 'block: %s', $new_block );
+
+ return [ $new_block ];
}