@@ -1,6 +1,7 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
3Copyright (C) 2010-2015 Puneeth Chaganti <punchagan@gmail.com>
3Copyright (C) 2010-2015 Puneeth Chaganti <punchagan@gmail.com>
4+ Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>,
4 and John MacFarlane <jgm@berkeley.edu>
5 and John MacFarlane <jgm@berkeley.edu>
6This program is free software; you can redistribute it and/or modify
7This program is free software; you can redistribute it and/or modify
@@ -38,7 +39,8 @@ import Text.Pandoc.Shared
38import Text.Pandoc.Writers.Shared
39import Text.Pandoc.Writers.Shared
39import Text.Pandoc.Pretty
40import Text.Pandoc.Pretty
40import Text.Pandoc.Templates (renderTemplate')
41import Text.Pandoc.Templates (renderTemplate')
42+import Data.Char ( toLower )
41−import Data.List ( intersect, intersperse, transpose )
43+import Data.List ( intersect, intersperse, partition, transpose )
42import Control.Monad.State
44import Control.Monad.State
44data WriterState =
46data WriterState =
@@ -123,12 +125,34 @@ blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do
123 blankline
125 blankline
124blockToOrg (Div attrs bs) = do
126blockToOrg (Div attrs bs) = do
125 contents <- blockListToOrg bs
127 contents <- blockListToOrg bs
128+ let isGreaterBlockClass = (`elem` ["center", "quote"]) . map toLower
129+ return $ case attrs of
131+ -- nullAttr, treat contents as if it wasn't wrapped
132+ blankline $$ contents $$ blankline
134+ -- only an id: add id as an anchor, unwrap the rest
135+ blankline $$ "<<" <> text ident <> ">>" $$ contents $$ blankline
136+ (ident, classes, kv) ->
137+ -- if one class looks like the name of a greater block then output as
138+ -- such: The ID, if present, is added via the #+NAME keyword; other
139+ -- classes and key-value pairs are kept as #+ATTR_HTML attributes.
141+ (blockTypeCand, classes') = partition isGreaterBlockClass classes
142+ in case blockTypeCand of
143+ (blockType:classes'') ->
144+ blankline $$ attrHtml (ident, classes'' <> classes', kv) $$
145+ "#+BEGIN_" <> text blockType $$ contents $$
146+ "#+END_" <> text blockType $$ blankline
148+ -- fallback: wrap in div tags
126− let startTag = tagWithAttrs "div" attrs
150+ startTag = tagWithAttrs "div" attrs
127− let endTag = text "</div>"
151+ endTag = text "</div>"
128− return $ blankline $$ "#+BEGIN_HTML" $$
152+ in blankline $$ "#+BEGIN_HTML" $$
129− nest 2 startTag $$ "#+END_HTML" $$ blankline $$
153+ nest 2 startTag $$ "#+END_HTML" $$ blankline $$
130− contents $$ blankline $$ "#+BEGIN_HTML" $$
154+ contents $$ blankline $$ "#+BEGIN_HTML" $$
131− nest 2 endTag $$ "#+END_HTML" $$ blankline
155+ nest 2 endTag $$ "#+END_HTML" $$ blankline
132blockToOrg (Plain inlines) = inlineListToOrg inlines
156blockToOrg (Plain inlines) = inlineListToOrg inlines
133-- title beginning with fig: indicates that the image is a figure
157-- title beginning with fig: indicates that the image is a figure
134blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
158blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
@@ -260,6 +284,16 @@ propertiesDrawer (ident, classes, kv) =
260 kvToOrgProperty (key, value) =
284 kvToOrgProperty (key, value) =
261 text ":" <> text key <> text ": " <> text value <> cr
285 text ":" <> text key <> text ": " <> text value <> cr
287+attrHtml :: Attr -> Doc
288+attrHtml ("" , [] , []) = mempty
289+attrHtml (ident, classes, kvs) =
291+ name = if (null ident) then mempty else "#+NAME: " <> text ident <> cr
292+ keyword = "#+ATTR_HTML"
293+ classKv = ("class", unwords classes)
294+ kvStrings = map (\(k,v) -> ":" <> k <> " " <> v) (classKv:kvs)
295+ in name <> keyword <> ": " <> text (unwords kvStrings) <> cr
263-- | Convert list of Pandoc block elements to Org.
297-- | Convert list of Pandoc block elements to Org.
264blockListToOrg :: [Block] -- ^ List of block elements
298blockListToOrg :: [Block] -- ^ List of block elements
265 -> State WriterState Doc
299 -> State WriterState Doc