aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2016-07-05 12:46:13 -0700
committerGitHub <noreply@github.com>2016-07-05 12:46:13 -0700
commite2659a46db3e3b118fe491bf5fd0cdae0268ef90 (patch)
tree2e9cfcfa94edae7b7fd10bc8f35255d484d95f1f /src/Text/Pandoc
parent6ea8ff19c3d9db5a32ebb1bc3ca63a55b27c3889 (diff)
parent5378b7c5bdf032938372883db0d31a5d44b82c57 (diff)
downloadpandoc-e2659a46db3e3b118fe491bf5fd0cdae0268ef90.tar.gz
Merge pull request #3014 from tarleb/org-writer-div
Org writer: improve Div handling
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Writers/Org.hs48
1 files changed, 41 insertions, 7 deletions
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 79ca37395..e903e9e42 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2010-2015 Puneeth Chaganti <punchagan@gmail.com>
+ Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>,
and John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
@@ -38,7 +39,8 @@ import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Pretty
import Text.Pandoc.Templates (renderTemplate')
-import Data.List ( intersect, intersperse, transpose )
+import Data.Char ( toLower )
+import Data.List ( intersect, intersperse, partition, transpose )
import Control.Monad.State
data WriterState =
@@ -123,12 +125,34 @@ blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do
blankline
blockToOrg (Div attrs bs) = do
contents <- blockListToOrg bs
- let startTag = tagWithAttrs "div" attrs
- let endTag = text "</div>"
- return $ blankline $$ "#+BEGIN_HTML" $$
- nest 2 startTag $$ "#+END_HTML" $$ blankline $$
- contents $$ blankline $$ "#+BEGIN_HTML" $$
- nest 2 endTag $$ "#+END_HTML" $$ blankline
+ let isGreaterBlockClass = (`elem` ["center", "quote"]) . map toLower
+ return $ case attrs of
+ ("", [], []) ->
+ -- nullAttr, treat contents as if it wasn't wrapped
+ blankline $$ contents $$ blankline
+ (ident, [], []) ->
+ -- only an id: add id as an anchor, unwrap the rest
+ blankline $$ "<<" <> text ident <> ">>" $$ contents $$ blankline
+ (ident, classes, kv) ->
+ -- if one class looks like the name of a greater block then output as
+ -- such: The ID, if present, is added via the #+NAME keyword; other
+ -- classes and key-value pairs are kept as #+ATTR_HTML attributes.
+ let
+ (blockTypeCand, classes') = partition isGreaterBlockClass classes
+ in case blockTypeCand of
+ (blockType:classes'') ->
+ blankline $$ attrHtml (ident, classes'' <> classes', kv) $$
+ "#+BEGIN_" <> text blockType $$ contents $$
+ "#+END_" <> text blockType $$ blankline
+ _ ->
+ -- fallback: wrap in div tags
+ let
+ startTag = tagWithAttrs "div" attrs
+ endTag = text "</div>"
+ in blankline $$ "#+BEGIN_HTML" $$
+ nest 2 startTag $$ "#+END_HTML" $$ blankline $$
+ contents $$ blankline $$ "#+BEGIN_HTML" $$
+ nest 2 endTag $$ "#+END_HTML" $$ blankline
blockToOrg (Plain inlines) = inlineListToOrg inlines
-- title beginning with fig: indicates that the image is a figure
blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
@@ -260,6 +284,16 @@ propertiesDrawer (ident, classes, kv) =
kvToOrgProperty (key, value) =
text ":" <> text key <> text ": " <> text value <> cr
+attrHtml :: Attr -> Doc
+attrHtml ("" , [] , []) = mempty
+attrHtml (ident, classes, kvs) =
+ let
+ name = if (null ident) then mempty else "#+NAME: " <> text ident <> cr
+ keyword = "#+ATTR_HTML"
+ classKv = ("class", unwords classes)
+ kvStrings = map (\(k,v) -> ":" <> k <> " " <> v) (classKv:kvs)
+ in name <> keyword <> ": " <> text (unwords kvStrings) <> cr
+
-- | Convert list of Pandoc block elements to Org.
blockListToOrg :: [Block] -- ^ List of block elements
-> State WriterState Doc