@@ -137,27 +137,43 @@ headlineToBlocks :: Headline -> OrgParser Blocks
137137headlineToBlocks hdln@(Headline {..}) =
138138 case () of
139139 _ | any isNoExportTag headlineTags -> return mempty
140+ _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln
140141 _ | isCommentTitle headlineText -> return mempty
141− _ -> headlineToHeader hdln
142+ _ -> headlineToHeaderWithContents hdln
142143
143144isNoExportTag :: Tag -> Bool
144145isNoExportTag = (== toTag "noexport")
145146
147+isArchiveTag :: Tag -> Bool
148+isArchiveTag = (== toTag "ARCHIVE")
149+
146150-- | Check if the title starts with COMMENT.
147151-- FIXME: This accesses builder internals not intended for use in situations
148−-- as these. Replace once keyword parsing is supported.
152+-- like these. Replace once keyword parsing is supported.
149153isCommentTitle :: Inlines -> Bool
150154isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT"
151155isCommentTitle _ = False
152156
157+archivedHeadlineToBlocks :: Headline -> OrgParser Blocks
158+archivedHeadlineToBlocks hdln = do
159+ archivedTreesOption <- getExportSetting exportArchivedTrees
160+ case archivedTreesOption of
161+ ArchivedTreesNoExport -> return mempty
162+ ArchivedTreesExport -> headlineToHeaderWithContents hdln
163+ ArchivedTreesHeadlineOnly -> headlineToHeader hdln
164+
165+headlineToHeaderWithContents :: Headline -> OrgParser Blocks
166+headlineToHeaderWithContents hdln@(Headline {..}) = do
167+ header <- headlineToHeader hdln
168+ childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)
169+ return $ header <> headlineContents <> childrenBlocks
170+
153171headlineToHeader :: Headline -> OrgParser Blocks
154172headlineToHeader (Headline {..}) = do
155173 let text = tagTitle headlineText headlineTags
156174 let propAttr = propertiesToAttr headlineProperties
157175 attr <- registerHeader propAttr headlineText
158− let header = B.headerWith attr headlineLevel text
159− childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)
160− return $ header <> headlineContents <> childrenBlocks
176+ return $ B.headerWith attr headlineLevel text
161177
162178propertiesToAttr :: Properties -> Attr
163179propertiesToAttr properties =
@@ -629,7 +645,7 @@ exportSetting = choice
629645 , ignoredSetting ":"
630646 , ignoredSetting "<"
631647 , ignoredSetting "\\n"
632− , ignoredSetting "arch"
648+ , archivedTreeSetting "arch" setExportArchivedTrees
633649 , ignoredSetting "author"
634650 , ignoredSetting "c"
635651 , ignoredSetting "creator"
@@ -673,6 +689,27 @@ elispBoolean = try $ do
673689 "()" -> False
674690 _ -> True
675691
692+archivedTreeSetting :: String
693+ -> ExportSettingSetter ArchivedTreesOption
694+ -> OrgParser ()
695+archivedTreeSetting settingIdentifier setter = try $ do
696+ string settingIdentifier
697+ char ':'
698+ value <- archivedTreesHeadlineSetting <|> archivedTreesBoolean
699+ updateState $ modifyExportSettings setter value
700+ where
701+ archivedTreesHeadlineSetting = try $ do
702+ string "headline"
703+ lookAhead (newline <|> spaceChar)
704+ return ArchivedTreesHeadlineOnly
705+
706+ archivedTreesBoolean = try $ do
707+ exportBool <- elispBoolean
708+ return $
709+ if exportBool
710+ then ArchivedTreesExport
711+ else ArchivedTreesNoExport
712+
676713-- | A list or a complement list (i.e. a list starting with `not`).
677714complementableListSetting :: String
678715 -> ExportSettingSetter (Either [String] [String])