From e5c8b650041a270b58e2f72e18eb28a32f153954 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Mon, 25 Dec 2017 23:31:05 +0100
Subject: Org reader: support minlevel option for includes
The level of headers in included files can be shifted to a higher level
by specifying a minimum header level via the `:minlevel` parameter. E.g.
`#+include: "tour.org" :minlevel 1` will shift the headers in tour.org
such that the topmost headers become level 1 headers.
Fixes: #4154
---
src/Text/Pandoc/Readers/Org/Blocks.hs | 51 +++++++++++++++++++++++++----------
1 file changed, 37 insertions(+), 14 deletions(-)
(limited to 'src/Text/Pandoc/Readers/Org')
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index cc6abbfa5..a930652af 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -41,7 +41,6 @@ import Text.Pandoc.Readers.Org.Shared (cleanLinkString, isImageFilename,
originalLang, translateLang)
import Text.Pandoc.Builder (Blocks, Inlines)
-import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options
@@ -54,6 +53,9 @@ import Data.List (foldl', isPrefixOf)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Monoid ((<>))
+import qualified Text.Pandoc.Builder as B
+import qualified Text.Pandoc.Walk as Walk
+
--
-- parsing blocks
--
@@ -509,19 +511,18 @@ include :: PandocMonad m => OrgParser m (F Blocks)
include = try $ do
metaLineStart <* stringAnyCase "include:" <* skipSpaces
filename <- includeTarget
- blockType <- optionMaybe $ skipSpaces *> many1 alphaNum
- blocksParser <- case blockType of
- Just "example" ->
- return $ pure . B.codeBlock <$> parseRaw
- Just "export" -> do
- format <- skipSpaces *> many (noneOf "\n\r\t ")
- return $ pure . B.rawBlock format <$> parseRaw
- Just "src" -> do
- language <- skipSpaces *> many (noneOf "\n\r\t ")
- let attr = (mempty, [language], mempty)
- return $ pure . B.codeBlockWith attr <$> parseRaw
- _ -> return $ pure . B.fromList <$> blockList
- anyLine
+ includeArgs <- many (try $ skipSpaces *> many1 alphaNum)
+ params <- keyValues
+ blocksParser <- case includeArgs of
+ ("example" : _) -> return $ pure . B.codeBlock <$> parseRaw
+ ["export"] -> return . returnF $ B.fromList []
+ ("export" : format : []) -> return $ pure . B.rawBlock format <$> parseRaw
+ ("src" : rest) -> do
+ let attr = case rest of
+ [lang] -> (mempty, [lang], mempty)
+ _ -> nullAttr
+ return $ pure . B.codeBlockWith attr <$> parseRaw
+ _ -> return $ return . B.fromList . blockFilter params <$> blockList
insertIncludedFileF blocksParser ["."] filename
where
includeTarget :: PandocMonad m => OrgParser m FilePath
@@ -532,6 +533,28 @@ include = try $ do
parseRaw :: PandocMonad m => OrgParser m String
parseRaw = many anyChar
+ blockFilter :: [(String, String)] -> [Block] -> [Block]
+ blockFilter params blks =
+ let minlvl = lookup "minlevel" params
+ in case (minlvl >>= safeRead :: Maybe Int) of
+ Nothing -> blks
+ Just lvl -> let levels = Walk.query headerLevel blks
+ -- CAVE: partial function in else
+ curMin = if null levels then 0 else minimum levels
+ in Walk.walk (shiftHeader (curMin - lvl)) blks
+
+ headerLevel :: Block -> [Int]
+ headerLevel (Header lvl _attr _content) = [lvl]
+ headerLevel _ = []
+
+ shiftHeader :: Int -> Block -> Block
+ shiftHeader shift blk =
+ if shift <= 0
+ then blk
+ else case blk of
+ (Header lvl attr content) -> Header (lvl - shift) attr content
+ _ -> blk
+
rawExportLine :: PandocMonad m => OrgParser m Blocks
rawExportLine = try $ do
metaLineStart
--
cgit v1.2.3