From 1bb4f0c497a352a12a546fd9f1dff570bdee4018 Mon Sep 17 00:00:00 2001
From: "Craig S. Bosma" <craig.bosma@gmail.com>
Date: Mon, 14 Jul 2014 19:14:46 -0500
Subject: Org reader: Respect :exports header arguments on code blocks

Adds support to the org reader for conditionally exporting either the code block,
results block immediately following, both, or neither, depending on the value
of the `:exports` header argument. If no such argument is supplied, the default
org behavior (for most languages) of exporting code is used.
---
 src/Text/Pandoc/Readers/Org.hs | 32 +++++++++++++++++++++++++++-----
 1 file changed, 27 insertions(+), 5 deletions(-)

(limited to 'src/Text/Pandoc/Readers/Org.hs')

diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 7a35e2ca0..41ba5c1a6 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -341,14 +341,36 @@ verseBlock blkProp = try $ do
   fmap B.para . mconcat . intersperse (pure B.linebreak)
     <$> mapM (parseFromString parseInlines) (lines content)
 
+exportsCode :: [(String, String)] -> Bool
+exportsCode attrs = not (("rundoc-exports", "none") `elem` attrs
+                         || ("rundoc-exports", "results") `elem` attrs)
+
+exportsResults :: [(String, String)] -> Bool
+exportsResults attrs = ("rundoc-exports", "results") `elem` attrs
+                       || ("rundoc-exports", "both") `elem` attrs
+
+followingResultsBlock :: OrgParser (Maybe String)
+followingResultsBlock =
+       optionMaybe (try $ blanklines *> stringAnyCase "#+RESULTS:"
+                                     *> blankline
+                                     *> (unlines <$> many1 exampleLine))
+
 codeBlock :: BlockProperties -> OrgParser (F Blocks)
 codeBlock blkProp = do
   skipSpaces
-  (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
-  id'           <- fromMaybe "" <$> lookupBlockAttribute "name"
-  content       <- rawBlockContent blkProp
-  let codeBlck  = B.codeBlockWith ( id', classes, kv ) content
-  maybe (pure codeBlck) (labelDiv codeBlck) <$> lookupInlinesAttr "caption"
+  (classes, kv)     <- codeHeaderArgs <|> (mempty <$ ignHeaders)
+  id'               <- fromMaybe "" <$> lookupBlockAttribute "name"
+  content           <- rawBlockContent blkProp
+  resultsContent    <- followingResultsBlock
+  let includeCode    = exportsCode kv
+  let includeResults = exportsResults kv
+  let codeBlck       = B.codeBlockWith ( id', classes, kv ) content
+  labelledBlck      <- maybe (pure codeBlck)
+                             (labelDiv codeBlck)
+                             <$> lookupInlinesAttr "caption"
+  let resultBlck     = pure $ maybe mempty (exampleCode) resultsContent
+  return $ (if includeCode then labelledBlck else mempty)
+           <> (if includeResults then resultBlck else mempty)
  where
    labelDiv blk value =
        B.divWith nullAttr <$> (mappend <$> labelledBlock value
-- 
cgit v1.2.3