@@ -1,6 +1,7 @@
11{-# LANGUAGE OverloadedStrings #-}
22{-
33Copyright (C) 2010-2015 Puneeth Chaganti <punchagan@gmail.com>
4+ Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>,
45 and John MacFarlane <jgm@berkeley.edu>
56
67This program is free software; you can redistribute it and/or modify
@@ -38,7 +39,8 @@ import Text.Pandoc.Shared
3839import Text.Pandoc.Writers.Shared
3940import Text.Pandoc.Pretty
4041import Text.Pandoc.Templates (renderTemplate')
41−import Data.List ( intersect, intersperse, transpose )
42+import Data.Char ( toLower )
43+import Data.List ( intersect, intersperse, partition, transpose )
4244import Control.Monad.State
4345
4446data WriterState =
@@ -123,12 +125,34 @@ blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do
123125 blankline
124126blockToOrg (Div attrs bs) = do
125127 contents <- blockListToOrg bs
126− let startTag = tagWithAttrs "div" attrs
127− let endTag = text "</div>"
128− return $ blankline $$ "#+BEGIN_HTML" $$
129− nest 2 startTag $$ "#+END_HTML" $$ blankline $$
130− contents $$ blankline $$ "#+BEGIN_HTML" $$
131− nest 2 endTag $$ "#+END_HTML" $$ blankline
128+ let isGreaterBlockClass = (`elem` ["center", "quote"]) . map toLower
129+ return $ case attrs of
130+ ("", [], []) ->
131+ -- nullAttr, treat contents as if it wasn't wrapped
132+ blankline $$ contents $$ blankline
133+ (ident, [], []) ->
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.
140+ let
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
147+ _ ->
148+ -- fallback: wrap in div tags
149+ let
150+ startTag = tagWithAttrs "div" attrs
151+ endTag = text "</div>"
152+ in blankline $$ "#+BEGIN_HTML" $$
153+ nest 2 startTag $$ "#+END_HTML" $$ blankline $$
154+ contents $$ blankline $$ "#+BEGIN_HTML" $$
155+ nest 2 endTag $$ "#+END_HTML" $$ blankline
132156blockToOrg (Plain inlines) = inlineListToOrg inlines
133157-- title beginning with fig: indicates that the image is a figure
134158blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
@@ -260,6 +284,16 @@ propertiesDrawer (ident, classes, kv) =
260284 kvToOrgProperty (key, value) =
261285 text ":" <> text key <> text ": " <> text value <> cr
262286
287+attrHtml :: Attr -> Doc
288+attrHtml ("" , [] , []) = mempty
289+attrHtml (ident, classes, kvs) =
290+ let
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
296+
263297-- | Convert list of Pandoc block elements to Org.
264298blockListToOrg :: [Block] -- ^ List of block elements
265299 -> State WriterState Doc