From 28bb27d79b6d7a2038cd57696942bc1b98ed265b Mon Sep 17 00:00:00 2001 From: Jonas Smedegaard Date: Mon, 23 Mar 2015 01:06:01 +0100 Subject: Refactor - should actually work sufficiently for current document now. --- pandoc-emphasis | 226 +++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 150 insertions(+), 76 deletions(-) (limited to 'pandoc-emphasis') 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 ]; } -- cgit v1.2.3