diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/Blocks.hs | 33 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/ExportSettings.hs | 12 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/ParserState.hs | 3 | ||||
| -rw-r--r-- | tests/Tests/Readers/Org.hs | 12 |
4 files changed, 52 insertions, 8 deletions
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index af178d400..023afe6e1 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -111,7 +111,7 @@ headline lvl = try $ do newline properties <- option mempty propertiesDrawer contents <- blocks - children <- many (headline (lvl + 1)) + children <- many (headline (level + 1)) return $ do title' <- title contents' <- contents @@ -135,12 +135,14 @@ headline lvl = try $ do -- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks headlineToBlocks :: Headline -> OrgParser Blocks -headlineToBlocks hdln@(Headline {..}) = +headlineToBlocks hdln@(Headline {..}) = do + maxHeadlineLevels <- getExportSetting exportHeadlineLevels case () of - _ | any isNoExportTag headlineTags -> return mempty - _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln - _ | isCommentTitle headlineText -> return mempty - _ -> headlineToHeaderWithContents hdln + _ | any isNoExportTag headlineTags -> return mempty + _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln + _ | isCommentTitle headlineText -> return mempty + _ | headlineLevel >= maxHeadlineLevels -> headlineToHeaderWithList hdln + _ -> headlineToHeaderWithContents hdln isNoExportTag :: Tag -> Bool isNoExportTag = (== toTag "noexport") @@ -163,6 +165,25 @@ archivedHeadlineToBlocks hdln = do ArchivedTreesExport -> headlineToHeaderWithContents hdln ArchivedTreesHeadlineOnly -> headlineToHeader hdln +headlineToHeaderWithList :: Headline -> OrgParser Blocks +headlineToHeaderWithList hdln@(Headline {..}) = do + maxHeadlineLevels <- getExportSetting exportHeadlineLevels + header <- headlineToHeader hdln + listElements <- sequence (map headlineToBlocks headlineChildren) + let listBlock = if null listElements + then mempty + else B.orderedList listElements + let headerText = if maxHeadlineLevels == headlineLevel + then header + else flattenHeader header + return $ headerText <> headlineContents <> listBlock + where + flattenHeader :: Blocks -> Blocks + flattenHeader blks = + case B.toList blks of + (Header _ _ inlns:_) -> B.para (B.fromList inlns) + _ -> mempty + headlineToHeaderWithContents :: Headline -> OrgParser Blocks headlineToHeaderWithContents hdln@(Headline {..}) = do header <- headlineToHeader hdln diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs index 9f844c8dd..b48acc9c4 100644 --- a/src/Text/Pandoc/Readers/Org/ExportSettings.hs +++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs @@ -32,8 +32,9 @@ module Text.Pandoc.Readers.Org.ExportSettings import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing -import Control.Monad ( void ) +import Control.Monad ( mzero, void ) import Data.Char ( toLower ) +import Data.Maybe ( listToMaybe ) -- | Read and handle space separated org-mode export settings. exportSettings :: OrgParser () @@ -61,7 +62,7 @@ exportSetting = choice , ignoredSetting "e" , ignoredSetting "email" , ignoredSetting "f" - , ignoredSetting "H" + , integerSetting "H" (\val es -> es { exportHeadlineLevels = val }) , ignoredSetting "inline" , ignoredSetting "num" , ignoredSetting "p" @@ -94,6 +95,13 @@ genericExportSetting optionParser settingIdentifier setter = try $ do booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser () booleanSetting = genericExportSetting elispBoolean +-- | An integer-valued option. +integerSetting :: String -> ExportSettingSetter Int -> OrgParser () +integerSetting = genericExportSetting parseInt + where + parseInt = try $ + many1 digit >>= maybe mzero (return . fst) . listToMaybe . reads + -- | Either the string "headline" or an elisp boolean and treated as an -- @ArchivedTreesOption@. archivedTreeSetting :: String diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 19524960b..48e7717cd 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -158,6 +158,8 @@ data ExportSettings = ExportSettings -- explicitly excluded from the resulting output while @Right@ means that -- only the listed drawer names should be included. , exportEmphasizedText :: Bool -- ^ Parse emphasized text + , exportHeadlineLevels :: Int + -- ^ Maximum depth of headlines, deeper headlines are convert to list , exportSmartQuotes :: Bool -- ^ Parse quotes smartly , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts @@ -171,6 +173,7 @@ defaultExportSettings = ExportSettings { exportArchivedTrees = ArchivedTreesHeadlineOnly , exportDrawers = Left ["LOGBOOK"] , exportEmphasizedText = True + , exportHeadlineLevels = 3 , exportSmartQuotes = True , exportSpecialStrings = True , exportSubSuperscripts = True diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index f57858a55..fdd9bc6bf 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -611,6 +611,18 @@ tests = ] =?> let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + + , "Export option: limit headline depth" =: + unlines [ "#+OPTIONS: H:2" + , "* section" + , "** subsection" + , "*** list item 1" + , "*** list item 2" + ] =?> + mconcat [ headerWith ("section", [], []) 1 "section" + , headerWith ("subsection", [], []) 2 "subsection" + , orderedList [ para "list item 1", para "list item 2" ] + ] ] , testGroup "Basic Blocks" $ |