Org writer: add :PROPERTIES: drawer support

This allows header attributes to be added to org documents in the form
of `:PROPERTIES:` drawers.  All available attributes are stored as
key/value pairs.  This reflects the way the org reader handles
`:PROPERTIES:` blocks.

This closes #1962.

1 files changed, 21 insertions, 2 deletions

diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index e57a6fc11..bc400c998 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -137,10 +137,13 @@ blockToOrg (RawBlock f str) | isRawFormat f =
   return $ text str
 blockToOrg (RawBlock _ _) = return empty
 blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline
-blockToOrg (Header level _ inlines) = do
+blockToOrg (Header level attr inlines) = do
   contents <- inlineListToOrg inlines
   let headerStr = text $ if level > 999 then " " else replicate level '*'
-  return $ headerStr <> " " <> contents <> blankline
+  let drawerStr = if attr == nullAttr
+                  then empty
+                  else cr <> nest (level + 1) (propertiesDrawer attr)
+  return $ headerStr <> " " <> contents <> drawerStr <> blankline
 blockToOrg (CodeBlock (_,classes,_) str) = do
   opts <- stOptions <$> get
   let tabstop = writerTabStop opts
@@ -230,6 +233,22 @@ definitionListItemToOrg (label, defs) = do
   contents <- liftM vcat $ mapM blockListToOrg defs
   return $ hang 3 "-  " $ label' <> " :: " <> (contents <> cr)
 
+-- | Convert list of key/value pairs to Org :PROPERTIES: drawer.
+propertiesDrawer :: Attr -> Doc
+propertiesDrawer (ident, classes, kv) =
+  let
+    drawerStart = text ":PROPERTIES:"
+    drawerEnd   = text ":END:"
+    kv'  = if (classes == mempty) then kv  else ("class", unwords classes):kv
+    kv'' = if (ident == mempty)   then kv' else ("id", ident):kv'
+    properties = vcat $ map kvToOrgProperty kv''
+  in
+    drawerStart <> cr <> properties <> cr <> drawerEnd
+ where
+   kvToOrgProperty :: (String, String) -> Doc
+   kvToOrgProperty (key, value) =
+     text ":" <> text key <> text ": " <> text value <> cr
+
 -- | Convert list of Pandoc block elements to Org.
 blockListToOrg :: [Block]       -- ^ List of block elements
                -> State WriterState Doc