From c4cf6d237f1017d36eeafad162570754506a6093 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 1 Jul 2016 22:44:29 +0200 Subject: Org reader: support archived trees export options Handling of archived trees can be modified using the `arch` option. Archived trees are either dropped, exported completely, or collapsed to include just the header when the `arch` option is nil, non-nil, or `headline`, respectively. --- tests/Tests/Readers/Org.hs | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'tests/Tests') diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 7612d88f1..f57858a55 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -587,6 +587,30 @@ tests = , ":END:" ] =?> divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5") + + , "Export option: don't include archive trees" =: + unlines [ "#+OPTIONS: arch:nil" + , "* old :ARCHIVE:" + ] =?> + (mempty ::Blocks) + + , "Export option: include complete archive trees" =: + unlines [ "#+OPTIONS: arch:t" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + , para "boring" + ] + + , "Export option: include archive tree header only" =: + unlines [ "#+OPTIONS: arch:headline" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") ] , testGroup "Basic Blocks" $ -- cgit v1.2.3 From 5ffa4abf727779cee317aab81c143e3e2d3cb7d6 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 2 Jul 2016 10:52:49 +0200 Subject: Org reader: support headline levels export setting The depths of headlines can be modified using the `H` option. Deeper headlines will be converted to lists. --- src/Text/Pandoc/Readers/Org/Blocks.hs | 33 ++++++++++++++++++++++----- src/Text/Pandoc/Readers/Org/ExportSettings.hs | 12 ++++++++-- src/Text/Pandoc/Readers/Org/ParserState.hs | 3 +++ tests/Tests/Readers/Org.hs | 12 ++++++++++ 4 files changed, 52 insertions(+), 8 deletions(-) (limited to 'tests/Tests') 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" $ -- cgit v1.2.3