From 2e43e27e5c6374c0cbc3ad690f04ec95bbac1f91 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 23 Apr 2017 12:56:11 +0200 Subject: Org reader: stop adding rundoc prefix to src params Source block parameter names are no longer prefixed with *rundoc*. This was intended to simplify working with the rundoc project, a babel runner. However, the rundoc project is unmaintained, and adding those markers is not the reader's job anyway. The original language that is specified for a source element is now retained as the `data-org-language` attribute and only added if it differs from the translated language. --- src/Text/Pandoc/Readers/Org/Blocks.hs | 32 ++++++++++---------------------- src/Text/Pandoc/Readers/Org/Inlines.hs | 7 +++---- src/Text/Pandoc/Readers/Org/Shared.hs | 24 +++++++++++------------- 3 files changed, 24 insertions(+), 39 deletions(-) (limited to 'src/Text/Pandoc/Readers') 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 -- cgit v1.2.3