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.
This commit is contained in:
Craig S. Bosma 2014-07-14 19:14:46 -05:00 committed by Craig S. Bosma
parent e053562280
commit 1bb4f0c497
2 changed files with 87 additions and 5 deletions

View file

@ -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

View file

@ -886,6 +886,66 @@ tests =
, " (+ 23 42))" ]
in codeBlockWith ("", classes, params) code'
, "Source block with results and :exports both" =:
unlines [ "#+BEGIN_SRC emacs-lisp :exports both"
, "(progn (message \"Hello, World!\")"
, " (+ 23 42))"
, "#+END_SRC"
, ""
, "#+RESULTS:"
, ": 65"] =?>
let classes = [ "commonlisp" -- as kate doesn't know emacs-lisp syntax
, "rundoc-block"
]
params = [ ("rundoc-language", "emacs-lisp")
, ("rundoc-exports", "both")
]
code' = unlines [ "(progn (message \"Hello, World!\")"
, " (+ 23 42))" ]
results' = "65\n"
in codeBlockWith ("", classes, params) code'
<>
codeBlockWith ("", ["example"], []) results'
, "Source block with results and :exports code" =:
unlines [ "#+BEGIN_SRC emacs-lisp :exports code"
, "(progn (message \"Hello, World!\")"
, " (+ 23 42))"
, "#+END_SRC"
, ""
, "#+RESULTS:"
, ": 65" ] =?>
let classes = [ "commonlisp" -- as kate doesn't know emacs-lisp syntax
, "rundoc-block"
]
params = [ ("rundoc-language", "emacs-lisp")
, ("rundoc-exports", "code")
]
code' = unlines [ "(progn (message \"Hello, World!\")"
, " (+ 23 42))" ]
in codeBlockWith ("", classes, params) code'
, "Source block with results and :exports results" =:
unlines [ "#+BEGIN_SRC emacs-lisp :exports results"
, "(progn (message \"Hello, World!\")"
, " (+ 23 42))"
, "#+END_SRC"
, ""
, "#+RESULTS:"
, ": 65" ] =?>
let results' = "65\n"
in codeBlockWith ("", ["example"], []) results'
, "Source block with results and :exports none" =:
unlines [ "#+BEGIN_SRC emacs-lisp :exports none"
, "(progn (message \"Hello, World!\")"
, " (+ 23 42))"
, "#+END_SRC"
, ""
, "#+RESULTS:"
, ": 65" ] =?>
rawBlock "html" ""
, "Example block" =:
unlines [ "#+begin_example"
, "A chosen representation of"