aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/Org.hs39
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs328
-rw-r--r--src/Text/Pandoc/Readers/Org/ExportSettings.hs167
-rw-r--r--src/Text/Pandoc/Readers/Org/ParserState.hs99
4 files changed, 386 insertions, 247 deletions
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index d593f856d..4e1c926da 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -52,41 +52,4 @@ parseOrg :: OrgParser Pandoc
parseOrg = do
blocks' <- blockList
meta' <- meta
- return . Pandoc meta' $ removeUnwantedBlocks blocks'
- where
- removeUnwantedBlocks :: [Block] -> [Block]
- removeUnwantedBlocks = dropCommentTrees . filter (/= Null)
-
--- | Drop COMMENT headers and the document tree below those headers.
-dropCommentTrees :: [Block] -> [Block]
-dropCommentTrees [] = []
-dropCommentTrees (b:bs) =
- maybe (b:dropCommentTrees bs)
- (dropCommentTrees . flip dropUntilHeaderAboveLevel bs)
- (commentHeaderLevel b)
-
--- | Return the level of a header starting a comment or :noexport: tree and
--- Nothing otherwise.
-commentHeaderLevel :: Block -> Maybe Int
-commentHeaderLevel blk =
- case blk of
- (Header level _ ((Str "COMMENT"):_)) -> Just level
- (Header level _ title) | hasNoExportTag title -> Just level
- _ -> Nothing
- where
- hasNoExportTag :: [Inline] -> Bool
- hasNoExportTag = any isNoExportTag
-
- isNoExportTag :: Inline -> Bool
- isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True
- isNoExportTag _ = False
-
--- | Drop blocks until a header on or above the given level is seen
-dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block]
-dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n)
-
-isHeaderLevelLowerEq :: Int -> Block -> Bool
-isHeaderLevelLowerEq n blk =
- case blk of
- (Header level _ _) -> n >= level
- _ -> False
+ return $ Pandoc meta' blocks'
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 32deb1fc8..023afe6e1 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -1,4 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
{-
Copyright (C) 2014-2016 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
@@ -32,6 +34,7 @@ module Text.Pandoc.Readers.Org.Blocks
) where
import Text.Pandoc.Readers.Org.BlockStarts
+import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )
import Text.Pandoc.Readers.Org.Inlines
import Text.Pandoc.Readers.Org.ParserState
import Text.Pandoc.Readers.Org.Parsing
@@ -46,13 +49,173 @@ import Text.Pandoc.Compat.Monoid ((<>))
import Text.Pandoc.Options
import Text.Pandoc.Shared ( compactify', compactify'DL )
-import Control.Monad ( foldM, guard, mzero )
+import Control.Monad ( foldM, guard, mzero, void )
import Data.Char ( isSpace, toLower, toUpper)
import Data.List ( foldl', intersperse, isPrefixOf )
import qualified Data.Map as M
import Data.Maybe ( fromMaybe, isNothing )
+import qualified Data.Sequence as S
import Network.HTTP ( urlEncode )
+--
+-- Org headers
+--
+newtype Tag = Tag { fromTag :: String }
+ deriving (Show, Eq)
+
+-- | Create a tag containing the given string.
+toTag :: String -> Tag
+toTag = Tag
+
+-- | The key (also called name or type) of a property.
+newtype PropertyKey = PropertyKey { fromKey :: String }
+ deriving (Show, Eq, Ord)
+
+-- | Create a property key containing the given string. Org mode keys are
+-- case insensitive and are hence converted to lower case.
+toPropertyKey :: String -> PropertyKey
+toPropertyKey = PropertyKey . map toLower
+
+-- | The value assigned to a property.
+newtype PropertyValue = PropertyValue { fromValue :: String }
+
+-- | Create a property value containing the given string.
+toPropertyValue :: String -> PropertyValue
+toPropertyValue = PropertyValue
+
+-- | Key/value pairs from a PROPERTIES drawer
+type Properties = [(PropertyKey, PropertyValue)]
+
+-- | Org mode headline (i.e. a document subtree).
+data Headline = Headline
+ { headlineLevel :: Int
+ , headlineText :: Inlines
+ , headlineTags :: [Tag]
+ , headlineProperties :: Properties
+ , headlineContents :: Blocks
+ , headlineChildren :: [Headline]
+ }
+
+--
+-- Parsing headlines and subtrees
+--
+
+-- | Read an Org mode headline and its contents (i.e. a document subtree).
+-- @lvl@ gives the minimum acceptable level of the tree.
+headline :: Int -> OrgParser (F Headline)
+headline lvl = try $ do
+ level <- headerStart
+ guard (lvl <= level)
+ title <- trimInlinesF . mconcat <$> manyTill inline endOfTitle
+ tags <- option [] headerTags
+ newline
+ properties <- option mempty propertiesDrawer
+ contents <- blocks
+ children <- many (headline (level + 1))
+ return $ do
+ title' <- title
+ contents' <- contents
+ children' <- sequence children
+ return $ Headline
+ { headlineLevel = level
+ , headlineText = title'
+ , headlineTags = tags
+ , headlineProperties = properties
+ , headlineContents = contents'
+ , headlineChildren = children'
+ }
+ where
+ endOfTitle :: OrgParser ()
+ endOfTitle = void . lookAhead $ optional headerTags *> newline
+
+ headerTags :: OrgParser [Tag]
+ headerTags = try $
+ let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'
+ in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces)
+
+-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
+headlineToBlocks :: Headline -> OrgParser Blocks
+headlineToBlocks hdln@(Headline {..}) = do
+ maxHeadlineLevels <- getExportSetting exportHeadlineLevels
+ case () of
+ _ | 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")
+
+isArchiveTag :: Tag -> Bool
+isArchiveTag = (== toTag "ARCHIVE")
+
+-- | Check if the title starts with COMMENT.
+-- FIXME: This accesses builder internals not intended for use in situations
+-- like these. Replace once keyword parsing is supported.
+isCommentTitle :: Inlines -> Bool
+isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT"
+isCommentTitle _ = False
+
+archivedHeadlineToBlocks :: Headline -> OrgParser Blocks
+archivedHeadlineToBlocks hdln = do
+ archivedTreesOption <- getExportSetting exportArchivedTrees
+ case archivedTreesOption of
+ ArchivedTreesNoExport -> return mempty
+ 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
+ childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)
+ return $ header <> headlineContents <> childrenBlocks
+
+headlineToHeader :: Headline -> OrgParser Blocks
+headlineToHeader (Headline {..}) = do
+ let text = tagTitle headlineText headlineTags
+ let propAttr = propertiesToAttr headlineProperties
+ attr <- registerHeader propAttr headlineText
+ return $ B.headerWith attr headlineLevel text
+
+propertiesToAttr :: Properties -> Attr
+propertiesToAttr properties =
+ let
+ toStringPair prop = (fromKey (fst prop), fromValue (snd prop))
+ customIdKey = toPropertyKey "custom_id"
+ classKey = toPropertyKey "class"
+ id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties
+ cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties
+ kvs' = map toStringPair . filter ((`notElem` [customIdKey, classKey]) . fst)
+ $ properties
+ in
+ (id', words cls, kvs')
+
+tagTitle :: Inlines -> [Tag] -> Inlines
+tagTitle title tags = title <> (mconcat $ map tagToInline tags)
+
+tagToInline :: Tag -> Inlines
+tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty
+
--
-- parsing blocks
@@ -61,9 +224,11 @@ import Network.HTTP ( urlEncode )
-- | Get a list of blocks.
blockList :: OrgParser [Block]
blockList = do
- blocks' <- blocks
- st <- getState
- return . B.toList $ runF blocks' st
+ initialBlocks <- blocks
+ headlines <- sequence <$> manyTill (headline 1) eof
+ st <- getState
+ headlineBlocks <- fmap mconcat . sequence . map headlineToBlocks $ runF headlines st
+ return . B.toList $ (runF initialBlocks st) <> headlineBlocks
-- | Get the meta information safed in the state.
meta :: OrgParser Meta
@@ -72,7 +237,7 @@ meta = do
return $ runF (orgStateMeta st) st
blocks :: OrgParser (F Blocks)
-blocks = mconcat <$> manyTill block eof
+blocks = mconcat <$> manyTill block (void (lookAhead headerStart) <|> eof)
block :: OrgParser (F Blocks)
block = choice [ mempty <$ blanklines
@@ -82,7 +247,6 @@ block = choice [ mempty <$ blanklines
, example
, genericDrawer
, specialLine
- , header
, horizontalRule
, list
, latexFragment
@@ -381,30 +545,22 @@ drawerEnd = try $
-- | Read a :PROPERTIES: drawer and return the key/value pairs contained
-- within.
-propertiesDrawer :: OrgParser [(String, String)]
+propertiesDrawer :: OrgParser Properties
propertiesDrawer = try $ do
drawerType <- drawerStart
guard $ map toUpper drawerType == "PROPERTIES"
manyTill property (try drawerEnd)
where
- property :: OrgParser (String, String)
+ property :: OrgParser (PropertyKey, PropertyValue)
property = try $ (,) <$> key <*> value
- key :: OrgParser String
- key = try $ skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')
+ key :: OrgParser PropertyKey
+ key = fmap toPropertyKey . try $
+ skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')
- value :: OrgParser String
- value = try $ skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline)
-
-keyValuesToAttr :: [(String, String)] -> Attr
-keyValuesToAttr kvs =
- let
- lowerKvs = map (\(k, v) -> (map toLower k, v)) kvs
- id' = fromMaybe mempty . lookup "custom_id" $ lowerKvs
- cls = fromMaybe mempty . lookup "class" $ lowerKvs
- kvs' = filter (flip notElem ["custom_id", "class"] . fst) lowerKvs
- in
- (id', words cls, kvs')
+ value :: OrgParser PropertyValue
+ value = fmap toPropertyValue . try $
+ skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline)
--
@@ -486,7 +642,7 @@ optionLine = try $ do
key <- metaKey
case key of
"link" -> parseLinkFormat >>= uncurry addLinkFormat
- "options" -> () <$ sepBy spaces exportSetting
+ "options" -> exportSettings
_ -> mzero
addLinkFormat :: String
@@ -496,100 +652,6 @@ addLinkFormat key formatter = updateState $ \s ->
let fs = orgStateLinkFormatters s
in s{ orgStateLinkFormatters = M.insert key formatter fs }
-
---
--- Export Settings
---
-
--- | Read and process org-mode specific export options.
-exportSetting :: OrgParser ()
-exportSetting = choice
- [ booleanSetting "^" setExportSubSuperscripts
- , booleanSetting "'" setExportSmartQuotes
- , booleanSetting "*" setExportEmphasizedText
- , booleanSetting "-" setExportSpecialStrings
- , ignoredSetting ":"
- , ignoredSetting "<"
- , ignoredSetting "\\n"
- , ignoredSetting "arch"
- , ignoredSetting "author"
- , ignoredSetting "c"
- , ignoredSetting "creator"
- , complementableListSetting "d" setExportDrawers
- , ignoredSetting "date"
- , ignoredSetting "e"
- , ignoredSetting "email"
- , ignoredSetting "f"
- , ignoredSetting "H"
- , ignoredSetting "inline"
- , ignoredSetting "num"
- , ignoredSetting "p"
- , ignoredSetting "pri"
- , ignoredSetting "prop"
- , ignoredSetting "stat"
- , ignoredSetting "tags"
- , ignoredSetting "tasks"
- , ignoredSetting "tex"
- , ignoredSetting "timestamp"
- , ignoredSetting "title"
- , ignoredSetting "toc"
- , ignoredSetting "todo"
- , ignoredSetting "|"
- ] <?> "export setting"
-
-booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser ()
-booleanSetting settingIdentifier setter = try $ do
- string settingIdentifier
- char ':'
- value <- elispBoolean
- updateState $ modifyExportSettings setter value
-
--- | Read an elisp boolean. Only NIL is treated as false, non-NIL values are
--- interpreted as true.
-elispBoolean :: OrgParser Bool
-elispBoolean = try $ do
- value <- many1 nonspaceChar
- return $ case map toLower value of
- "nil" -> False
- "{}" -> False
- "()" -> False
- _ -> True
-
--- | A list or a complement list (i.e. a list starting with `not`).
-complementableListSetting :: String
- -> ExportSettingSetter (Either [String] [String])
- -> OrgParser ()
-complementableListSetting settingIdentifier setter = try $ do
- _ <- string settingIdentifier <* char ':'
- value <- choice [ Left <$> complementStringList
- , Right <$> stringList
- , (\b -> if b then Left [] else Right []) <$> elispBoolean
- ]
- updateState $ modifyExportSettings setter value
- where
- -- Read a plain list of strings.
- stringList :: OrgParser [String]
- stringList = try $
- char '('
- *> sepBy elispString spaces
- <* char ')'
-
- -- Read an emacs lisp list specifying a complement set.
- complementStringList :: OrgParser [String]
- complementStringList = try $
- string "(not "
- *> sepBy elispString spaces
- <* char ')'
-
- elispString :: OrgParser String
- elispString = try $
- char '"'
- *> manyTill alphaNum (char '"')
-
-ignoredSetting :: String -> OrgParser ()
-ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)
-
-
parseLinkFormat :: OrgParser ((String, String -> String))
parseLinkFormat = try $ do
linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
@@ -612,36 +674,6 @@ parseFormat = try $ do
rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
---
--- Headers
---
-
--- | Headers
-header :: OrgParser (F Blocks)
-header = try $ do
- level <- headerStart
- title <- manyTill inline (lookAhead $ optional headerTags <* newline)
- tags <- option [] headerTags
- newline
- let text = tagTitle title tags
- propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer)
- attr <- registerHeader propAttr (runF text def)
- return (B.headerWith attr level <$> text)
- where
- tagTitle :: [F Inlines] -> [String] -> F Inlines
- tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags
-
- tagToInlineF :: String -> F Inlines
- tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
-
- headerTags :: OrgParser [String]
- headerTags = try $
- let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'
- in skipSpaces
- *> char ':'
- *> many1 tag
- <* skipSpaces
-
--
-- Tables
@@ -806,6 +838,8 @@ noteBlock = try $ do
-- Paragraphs or Plain text
paraOrPlain :: OrgParser (F Blocks)
paraOrPlain = try $ do
+ -- Make sure we are not looking at a headline
+ notFollowedBy' (char '*' *> (oneOf " *"))
ils <- inlines
nl <- option False (newline *> return True)
-- Read block as paragraph, except if we are in a list context and the block
diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs
new file mode 100644
index 000000000..b48acc9c4
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs
@@ -0,0 +1,167 @@
+{-
+Copyright (C) 2014-2016 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : Text.Pandoc.Readers.Org.Options
+ Copyright : Copyright (C) 2016 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+Parsers for Org-mode export options.
+-}
+module Text.Pandoc.Readers.Org.ExportSettings
+ ( exportSettings
+ ) where
+
+import Text.Pandoc.Readers.Org.ParserState
+import Text.Pandoc.Readers.Org.Parsing
+
+import Control.Monad ( mzero, void )
+import Data.Char ( toLower )
+import Data.Maybe ( listToMaybe )
+
+-- | Read and handle space separated org-mode export settings.
+exportSettings :: OrgParser ()
+exportSettings = void $ sepBy spaces exportSetting
+
+-- | Setter function for export settings.
+type ExportSettingSetter a = a -> ExportSettings -> ExportSettings
+
+-- | Read and process a single org-mode export option.
+exportSetting :: OrgParser ()
+exportSetting = choice
+ [ booleanSetting "^" (\val es -> es { exportSubSuperscripts = val })
+ , booleanSetting "'" (\val es -> es { exportSmartQuotes = val })
+ , booleanSetting "*" (\val es -> es { exportEmphasizedText = val })
+ , booleanSetting "-" (\val es -> es { exportSpecialStrings = val })
+ , ignoredSetting ":"
+ , ignoredSetting "<"
+ , ignoredSetting "\\n"
+ , archivedTreeSetting "arch" (\val es -> es { exportArchivedTrees = val })
+ , ignoredSetting "author"
+ , ignoredSetting "c"
+ , ignoredSetting "creator"
+ , complementableListSetting "d" (\val es -> es { exportDrawers = val })
+ , ignoredSetting "date"
+ , ignoredSetting "e"
+ , ignoredSetting "email"
+ , ignoredSetting "f"
+ , integerSetting "H" (\val es -> es { exportHeadlineLevels = val })
+ , ignoredSetting "inline"
+ , ignoredSetting "num"
+ , ignoredSetting "p"
+ , ignoredSetting "pri"
+ , ignoredSetting "prop"
+ , ignoredSetting "stat"
+ , ignoredSetting "tags"
+ , ignoredSetting "tasks"
+ , ignoredSetting "tex"
+ , ignoredSetting "timestamp"
+ , ignoredSetting "title"
+ , ignoredSetting "toc"
+ , ignoredSetting "todo"
+ , ignoredSetting "|"
+ ] <?> "export setting"
+
+genericExportSetting :: OrgParser a
+ -> String
+ -> ExportSettingSetter a
+ -> OrgParser ()
+genericExportSetting optionParser settingIdentifier setter = try $ do
+ _ <- string settingIdentifier *> char ':'
+ value <- optionParser
+ updateState $ modifyExportSettings value
+ where
+ modifyExportSettings val st =
+ st { orgStateExportSettings = setter val . orgStateExportSettings $ st }
+
+-- | A boolean option, either nil (False) or non-nil (True).
+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
+ -> ExportSettingSetter ArchivedTreesOption
+ -> OrgParser ()
+archivedTreeSetting =
+ genericExportSetting $ archivedTreesHeadlineSetting <|> archivedTreesBoolean
+ where
+ archivedTreesHeadlineSetting = try $ do
+ _ <- string "headline"
+ lookAhead (newline <|> spaceChar)
+ return ArchivedTreesHeadlineOnly
+
+ archivedTreesBoolean = try $ do
+ exportBool <- elispBoolean
+ return $
+ if exportBool
+ then ArchivedTreesExport
+ else ArchivedTreesNoExport
+
+-- | A list or a complement list (i.e. a list starting with `not`).
+complementableListSetting :: String
+ -> ExportSettingSetter (Either [String] [String])
+ -> OrgParser ()
+complementableListSetting = genericExportSetting $ choice
+ [ Left <$> complementStringList
+ , Right <$> stringList
+ , (\b -> if b then Left [] else Right []) <$> elispBoolean
+ ]
+ where
+ -- Read a plain list of strings.
+ stringList :: OrgParser [String]
+ stringList = try $
+ char '('
+ *> sepBy elispString spaces
+ <* char ')'
+
+ -- Read an emacs lisp list specifying a complement set.
+ complementStringList :: OrgParser [String]
+ complementStringList = try $
+ string "(not "
+ *> sepBy elispString spaces
+ <* char ')'
+
+ elispString :: OrgParser String
+ elispString = try $
+ char '"'
+ *> manyTill alphaNum (char '"')
+
+-- | Read but ignore the export setting.
+ignoredSetting :: String -> OrgParser ()
+ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)
+
+-- | Read an elisp boolean. Only NIL is treated as false, non-NIL values are
+-- interpreted as true.
+elispBoolean :: OrgParser Bool
+elispBoolean = try $ do
+ value <- many1 nonspaceChar
+ return $ case map toLower value of
+ "nil" -> False
+ "{}" -> False
+ "()" -> False
+ _ -> True
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index 0c58183f9..48e7717cd 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -40,14 +40,8 @@ module Text.Pandoc.Readers.Org.ParserState
, trimInlinesF
, runF
, returnF
- , ExportSettingSetter
, ExportSettings (..)
- , setExportDrawers
- , setExportEmphasizedText
- , setExportSmartQuotes
- , setExportSpecialStrings
- , setExportSubSuperscripts
- , modifyExportSettings
+ , ArchivedTreesOption (..)
, optionsToParserState
) where
@@ -78,19 +72,6 @@ type OrgNoteTable = [OrgNoteRecord]
-- link-type, the corresponding function transforms the given link string.
type OrgLinkFormatters = M.Map String (String -> String)
--- | Export settings <http://orgmode.org/manual/Export-settings.html>
--- These settings can be changed via OPTIONS statements.
-data ExportSettings = ExportSettings
- { exportDrawers :: Either [String] [String]
- -- ^ Specify drawer names which should be exported. @Left@ names are
- -- explicitly excluded from the resulting output while @Right@ means that
- -- only the listed drawer names should be included.
- , exportEmphasizedText :: Bool -- ^ Parse emphasized text
- , exportSmartQuotes :: Bool -- ^ Parse quotes smartly
- , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly
- , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts
- }
-
-- | Org-mode parser state
data OrgParserState = OrgParserState
{ orgStateAnchorIds :: [String]
@@ -133,9 +114,6 @@ instance HasHeaderMap OrgParserState where
extractHeaderMap = orgStateHeaderMap
updateHeaderMap f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) }
-instance Default ExportSettings where
- def = defaultExportSettings
-
instance Default OrgParserState where
def = defaultOrgParserState
@@ -157,53 +135,50 @@ defaultOrgParserState = OrgParserState
, orgStateParserContext = NullState
}
+optionsToParserState :: ReaderOptions -> OrgParserState
+optionsToParserState opts =
+ def { orgStateOptions = opts }
+
+--
+-- Export Settings
+--
+
+-- | Options for the way archived trees are handled.
+data ArchivedTreesOption =
+ ArchivedTreesExport -- ^ Export the complete tree
+ | ArchivedTreesNoExport -- ^ Exclude archived trees from exporting
+ | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents
+
+-- | Export settings <http://orgmode.org/manual/Export-settings.html>
+-- These settings can be changed via OPTIONS statements.
+data ExportSettings = ExportSettings
+ { exportArchivedTrees :: ArchivedTreesOption -- ^ How to treat archived trees
+ , exportDrawers :: Either [String] [String]
+ -- ^ Specify drawer names which should be exported. @Left@ names are
+ -- 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
+ }
+
+instance Default ExportSettings where
+ def = defaultExportSettings
+
defaultExportSettings :: ExportSettings
defaultExportSettings = ExportSettings
- { exportDrawers = Left ["LOGBOOK"]
+ { exportArchivedTrees = ArchivedTreesHeadlineOnly
+ , exportDrawers = Left ["LOGBOOK"]
, exportEmphasizedText = True
+ , exportHeadlineLevels = 3
, exportSmartQuotes = True
, exportSpecialStrings = True
, exportSubSuperscripts = True
}
-optionsToParserState :: ReaderOptions -> OrgParserState
-optionsToParserState opts =
- def { orgStateOptions = opts }
-
-
---
--- Setter for exporting options
---
-type ExportSettingSetter a = a -> ExportSettings -> ExportSettings
-
--- | Set export options for drawers. See the @exportDrawers@ in ADT
--- @ExportSettings@ for details.
-setExportDrawers :: ExportSettingSetter (Either [String] [String])
-setExportDrawers val es = es { exportDrawers = val }
-
--- | Set export options for emphasis parsing.
-setExportEmphasizedText :: ExportSettingSetter Bool
-setExportEmphasizedText val es = es { exportEmphasizedText = val }
-
--- | Set export options for parsing of smart quotes.
-setExportSmartQuotes :: ExportSettingSetter Bool
-setExportSmartQuotes val es = es { exportSmartQuotes = val }
-
--- | Set export options for parsing of special strings (like em/en dashes or
--- ellipses).
-setExportSpecialStrings :: ExportSettingSetter Bool
-setExportSpecialStrings val es = es { exportSpecialStrings = val }
-
--- | Set export options for sub/superscript parsing. The short syntax will
--- not be parsed if this is set set to @False@.
-setExportSubSuperscripts :: ExportSettingSetter Bool
-setExportSubSuperscripts val es = es { exportSubSuperscripts = val }
-
--- | Modify a parser state
-modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState
-modifyExportSettings setter val state =
- state { orgStateExportSettings = setter val . orgStateExportSettings $ state }
-
--
-- Parser state reader
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-30 00:00:48 +0000