diff options
-rw-r--r-- | src/Text/Pandoc/Readers/Org/Blocks.hs | 32 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Org/Inlines.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Org/Shared.hs | 24 | ||||
-rw-r--r-- | test/Tests/Readers/Org.hs | 59 |
4 files changed, 50 insertions, 72 deletions
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 6fc12d84b..3cb9c7ed8 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -39,8 +39,7 @@ import Text.Pandoc.Readers.Org.Meta (metaExport, metaKey, metaLine) import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing import Text.Pandoc.Readers.Org.Shared (cleanLinkString, isImageFilename, - rundocBlockClass, toRundocAttrib, - translateLang) + originalLang, translateLang) import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B @@ -493,16 +492,14 @@ codeBlock blockAttrs blockType = do content <- rawBlockContent blockType resultsContent <- trailingResultsBlock let id' = fromMaybe mempty $ blockAttrName blockAttrs - let includeCode = exportsCode kv - let includeResults = exportsResults kv let codeBlck = B.codeBlockWith ( id', classes, kv ) content let labelledBlck = maybe (pure codeBlck) (labelDiv codeBlck) (blockAttrCaption blockAttrs) let resultBlck = fromMaybe mempty resultsContent return $ - (if includeCode then labelledBlck else mempty) <> - (if includeResults then resultBlck else mempty) + (if exportsCode kv then labelledBlck else mempty) <> + (if exportsResults kv then resultBlck else mempty) where labelDiv :: Blocks -> F Inlines -> F Blocks labelDiv blk value = @@ -511,13 +508,11 @@ codeBlock blockAttrs blockType = do labelledBlock :: F Inlines -> F Blocks labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], [])) -exportsCode :: [(String, String)] -> Bool -exportsCode attrs = not (("rundoc-exports", "none") `elem` attrs - || ("rundoc-exports", "results") `elem` attrs) + exportsCode :: [(String, String)] -> Bool + exportsCode = maybe True (`elem` ["code", "both"]) . lookup "exports" -exportsResults :: [(String, String)] -> Bool -exportsResults attrs = ("rundoc-exports", "results") `elem` attrs - || ("rundoc-exports", "both") `elem` attrs + exportsResults :: [(String, String)] -> Bool + exportsResults = maybe False (`elem` ["results", "both"]) . lookup "exports" trailingResultsBlock :: PandocMonad m => OrgParser m (Maybe (F Blocks)) trailingResultsBlock = optionMaybe . try $ do @@ -532,16 +527,9 @@ codeHeaderArgs = try $ do language <- skipSpaces *> orgArgWord (switchClasses, switchKv) <- switchesAsAttributes parameters <- manyTill blockOption newline - let pandocLang = translateLang language - let classes = pandocLang : switchClasses - return $ - if hasRundocParameters parameters - then ( classes <> [ rundocBlockClass ] - , switchKv <> map toRundocAttrib (("language", language) : parameters) - ) - else (classes, switchKv <> parameters) - where - hasRundocParameters = not . null + return $ ( translateLang language : switchClasses + , originalLang language <> switchKv <> parameters + ) switchesAsAttributes :: Monad m => OrgParser m ([String], [(String, String)]) switchesAsAttributes = try $ do diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs index 31bfe4478..d227eb66a 100644 --- a/src/Text/Pandoc/Readers/Org/Inlines.hs +++ b/src/Text/Pandoc/Readers/Org/Inlines.hs @@ -37,8 +37,7 @@ import Text.Pandoc.Readers.Org.BlockStarts (endOfBlock, noteMarker) import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing import Text.Pandoc.Readers.Org.Shared (cleanLinkString, isImageFilename, - rundocBlockClass, toRundocAttrib, - translateLang) + originalLang, translateLang) import Text.Pandoc.Builder (Inlines) import qualified Text.Pandoc.Builder as B @@ -518,8 +517,8 @@ inlineCodeBlock = try $ do lang <- many1 orgArgWordChar opts <- option [] $ enclosedByPair '[' ']' inlineBlockOption inlineCode <- enclosedByPair '{' '}' (noneOf "\n\r") - let attrClasses = [translateLang lang, rundocBlockClass] - let attrKeyVal = map toRundocAttrib (("language", lang) : opts) + let attrClasses = [translateLang lang] + let attrKeyVal = originalLang lang <> opts returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode where inlineBlockOption :: PandocMonad m => OrgParser m (String, String) diff --git a/src/Text/Pandoc/Readers/Org/Shared.hs b/src/Text/Pandoc/Readers/Org/Shared.hs index a5b285f30..f89ce6732 100644 --- a/src/Text/Pandoc/Readers/Org/Shared.hs +++ b/src/Text/Pandoc/Readers/Org/Shared.hs @@ -29,12 +29,10 @@ Utility functions used in other Pandoc Org modules. module Text.Pandoc.Readers.Org.Shared ( cleanLinkString , isImageFilename - , rundocBlockClass - , toRundocAttrib + , originalLang , translateLang ) where -import Control.Arrow (first) import Data.Char (isAlphaNum) import Data.List (isPrefixOf, isSuffixOf) @@ -68,17 +66,17 @@ cleanLinkString s = in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme && not (null path) --- | Prefix used for Rundoc classes and arguments. -rundocPrefix :: String -rundocPrefix = "rundoc-" +-- | Creates an key-value pair marking the original language name specified for +-- a piece of source code. --- | The class-name used to mark rundoc blocks. -rundocBlockClass :: String -rundocBlockClass = rundocPrefix ++ "block" - --- | Prefix the name of a attribute, marking it as a code execution parameter. -toRundocAttrib :: (String, String) -> (String, String) -toRundocAttrib = first (rundocPrefix ++) +-- | Creates an key-value attributes marking the original language name +-- specified for a piece of source code. +originalLang :: String -> [(String, String)] +originalLang lang = + let transLang = translateLang lang + in if transLang == lang + then [] + else [("data-org-language", lang)] -- | Translate from Org-mode's programming language identifiers to those used -- by Pandoc. This is useful to allow for proper syntax highlighting in diff --git a/test/Tests/Readers/Org.hs b/test/Tests/Readers/Org.hs index 4801bea3a..55fa00d1a 100644 --- a/test/Tests/Readers/Org.hs +++ b/test/Tests/Readers/Org.hs @@ -275,17 +275,17 @@ tests = , "Inline code block" =: "src_emacs-lisp{(message \"Hello\")}" =?> (para $ codeWith ( "" - , [ "commonlisp", "rundoc-block" ] - , [ ("rundoc-language", "emacs-lisp") ]) + , [ "commonlisp" ] + , [ ("data-org-language", "emacs-lisp") ]) "(message \"Hello\")") , "Inline code block with arguments" =: "src_sh[:export both :results output]{echo 'Hello, World'}" =?> (para $ codeWith ( "" - , [ "bash", "rundoc-block" ] - , [ ("rundoc-language", "sh") - , ("rundoc-export", "both") - , ("rundoc-results", "output") + , [ "bash" ] + , [ ("data-org-language", "sh") + , ("export", "both") + , ("results", "output") ] ) "echo 'Hello, World'") @@ -293,9 +293,9 @@ tests = , "Inline code block with toggle" =: "src_sh[:toggle]{echo $HOME}" =?> (para $ codeWith ( "" - , [ "bash", "rundoc-block" ] - , [ ("rundoc-language", "sh") - , ("rundoc-toggle", "yes") + , [ "bash" ] + , [ ("data-org-language", "sh") + , ("toggle", "yes") ] ) "echo $HOME") @@ -1472,16 +1472,14 @@ tests = in mconcat [ para $ spcSep [ "Low", "German", "greeting" ] , codeBlockWith attr' code' ] - , "Source block with rundoc/babel arguments" =: + , "Source block with babel arguments" =: unlines [ "#+BEGIN_SRC emacs-lisp :exports both" , "(progn (message \"Hello, World!\")" , " (+ 23 42))" , "#+END_SRC" ] =?> - let classes = [ "commonlisp" -- as kate doesn't know emacs-lisp syntax - , "rundoc-block" - ] - params = [ ("rundoc-language", "emacs-lisp") - , ("rundoc-exports", "both") + let classes = [ "commonlisp" ] -- as kate doesn't know emacs-lisp syntax + params = [ ("data-org-language", "emacs-lisp") + , ("exports", "both") ] code' = unlines [ "(progn (message \"Hello, World!\")" , " (+ 23 42))" ] @@ -1495,11 +1493,9 @@ tests = , "" , "#+RESULTS:" , ": 65"] =?> - let classes = [ "commonlisp" -- as kate doesn't know emacs-lisp syntax - , "rundoc-block" - ] - params = [ ("rundoc-language", "emacs-lisp") - , ("rundoc-exports", "both") + let classes = [ "commonlisp" ] + params = [ ("data-org-language", "emacs-lisp") + , ("exports", "both") ] code' = unlines [ "(progn (message \"Hello, World!\")" , " (+ 23 42))" ] @@ -1516,11 +1512,9 @@ tests = , "" , "#+RESULTS:" , ": 65" ] =?> - let classes = [ "commonlisp" -- as kate doesn't know emacs-lisp syntax - , "rundoc-block" - ] - params = [ ("rundoc-language", "emacs-lisp") - , ("rundoc-exports", "code") + let classes = [ "commonlisp" ] + params = [ ("data-org-language", "emacs-lisp") + , ("exports", "code") ] code' = unlines [ "(progn (message \"Hello, World!\")" , " (+ 23 42))" ] @@ -1552,8 +1546,8 @@ tests = , "echo $HOME" , "#+END_SRC" ] =?> - let classes = [ "bash", "rundoc-block" ] - params = [ ("rundoc-language", "sh"), ("rundoc-noeval", "yes") ] + let classes = [ "bash" ] + params = [ ("data-org-language", "sh"), ("noeval", "yes") ] in codeBlockWith ("", classes, params) "echo $HOME\n" , "Source block with line number switch" =: @@ -1562,7 +1556,7 @@ tests = , "#+END_SRC" ] =?> let classes = [ "bash", "numberLines" ] - params = [ ("startFrom", "10") ] + params = [ ("data-org-language", "sh"), ("startFrom", "10") ] in codeBlockWith ("", classes, params) ":() { :|:& };:\n" , "Example block" =: @@ -1712,12 +1706,11 @@ tests = , "code body" , "#+END_SRC" ] =?> - let classes = [ "c", "rundoc-block" ] - params = [ ("rundoc-language", "C") - , ("rundoc-tangle", "xxxx.c") - , ("rundoc-city", "Zürich") + let params = [ ("data-org-language", "C") + , ("tangle", "xxxx.c") + , ("city", "Zürich") ] - in codeBlockWith ( "", classes, params) "code body\n" + in codeBlockWith ( "", ["c"], params) "code body\n" ] , testGroup "Smart punctuation" |