Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Merge pull request #1435 from bosmacs/org-babel-exports

Browse source 
Org reader: Respect :exports header arguments on code blocks
This commit is contained in:
John MacFarlane 2014-07-17 10:37:28 -07:00
commit c3db0bb6a9
2 changed files with 87 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
src/Text/Pandoc/Readers/Org.hs
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

60
tests/Tests/Readers/Org.hs
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"