summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Readers/Org.hs83
-rw-r--r--src/Text/Pandoc/Readers/Org/ParserState.hs15
-rw-r--r--src/Text/Pandoc/Writers/Org.hs15
-rw-r--r--tests/Tests/Readers/Org.hs27
-rw-r--r--tests/writer.org62
5 files changed, 152 insertions, 50 deletions
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index d7939c95a..621e7107f 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -138,7 +138,7 @@ exportSetting = choice
, ignoredSetting "author"
, ignoredSetting "c"
, ignoredSetting "creator"
- , ignoredSetting "d"
+ , complementableListSetting "d" setExportDrawers
, ignoredSetting "date"
, ignoredSetting "e"
, ignoredSetting "email"
@@ -164,15 +164,53 @@ booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser ()
booleanSetting settingIdentifier setter = try $ do
string settingIdentifier
char ':'
- value <- many nonspaceChar
- let boolValue = case value of
- "nil" -> False
- "{}" -> False
- _ -> True
- updateState $ modifyExportSettings setter boolValue
+ 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 ':' <* many nonspaceChar)
+ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)
--
-- Parser
@@ -588,11 +626,27 @@ exampleLine = try $ skipSpaces *> string ": " *> anyLine
--
-- | A generic drawer which has no special meaning for org-mode.
+-- Whether or not this drawer is included in the output depends on the drawers
+-- export setting.
genericDrawer :: OrgParser (F Blocks)
genericDrawer = try $ do
- drawerStart
- manyTill drawerLine (try drawerEnd)
- return mempty
+ name <- map toUpper <$> drawerStart
+ content <- manyTill drawerLine (try drawerEnd)
+ state <- getState
+ -- Include drawer if it is explicitly included in or not explicitly excluded
+ -- from the list of drawers that should be exported. PROPERTIES drawers are
+ -- never exported.
+ case (exportDrawers . orgStateExportSettings $ state) of
+ _ | name == "PROPERTIES" -> return mempty
+ Left names | name `elem` names -> return mempty
+ Right names | name `notElem` names -> return mempty
+ _ -> drawerDiv name <$> parseLines content
+ where
+ parseLines :: [String] -> OrgParser (F Blocks)
+ parseLines = parseFromString parseBlocks . (++ "\n") . unlines
+
+ drawerDiv :: String -> F Blocks -> F Blocks
+ drawerDiv drawerName = fmap $ B.divWith (mempty, [drawerName, "drawer"], mempty)
drawerStart :: OrgParser String
drawerStart = try $
@@ -626,9 +680,10 @@ propertiesDrawer = try $ do
keyValuesToAttr :: [(String, String)] -> Attr
keyValuesToAttr kvs =
let
- id' = fromMaybe mempty . lookup "id" $ kvs
- cls = fromMaybe mempty . lookup "class" $ kvs
- kvs' = filter (flip notElem ["id", "class"] . fst) kvs
+ 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')
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index f84e5e51b..6a902cd46 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -39,8 +39,9 @@ module Text.Pandoc.Readers.Org.ParserState
, runF
, returnF
, ExportSettingSetter
- , exportSubSuperscripts
+ , ExportSettings (..)
, setExportSubSuperscripts
+ , setExportDrawers
, modifyExportSettings
) where
@@ -76,6 +77,10 @@ type OrgLinkFormatters = M.Map String (String -> String)
-- These settings can be changed via OPTIONS statements.
data ExportSettings = ExportSettings
{ exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts
+ , 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.
}
-- | Org-mode parser state
@@ -155,6 +160,7 @@ defaultOrgParserState = OrgParserState
defaultExportSettings :: ExportSettings
defaultExportSettings = ExportSettings
{ exportSubSuperscripts = True
+ , exportDrawers = Left ["LOGBOOK"]
}
@@ -163,9 +169,16 @@ defaultExportSettings = ExportSettings
--
type ExportSettingSetter a = a -> ExportSettings -> ExportSettings
+-- | 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 }
+-- | Set export options for drawers. See the @exportDrawers@ in ADT
+-- @ExportSettings@ for details.
+setExportDrawers :: ExportSettingSetter (Either [String] [String])
+setExportDrawers val es = es { exportDrawers = val }
+
-- | Modify a parser state
modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState
modifyExportSettings setter val state =
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index bc400c998..f87aeca81 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -110,6 +110,17 @@ isRawFormat f =
blockToOrg :: Block -- ^ Block element
-> State WriterState Doc
blockToOrg Null = return empty
+blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do
+ contents <- blockListToOrg bs
+ let drawerNameTag = ":" <> text cls <> ":"
+ let keys = vcat $ map (\(k,v) ->
+ ":" <> text k <> ":"
+ <> space <> text v) kvs
+ let drawerEndTag = text ":END:"
+ return $ drawerNameTag $$ cr $$ keys $$
+ blankline $$ contents $$
+ blankline $$ drawerEndTag $$
+ blankline
blockToOrg (Div attrs bs) = do
contents <- blockListToOrg bs
let startTag = tagWithAttrs "div" attrs
@@ -239,8 +250,8 @@ propertiesDrawer (ident, classes, kv) =
let
drawerStart = text ":PROPERTIES:"
drawerEnd = text ":END:"
- kv' = if (classes == mempty) then kv else ("class", unwords classes):kv
- kv'' = if (ident == mempty) then kv' else ("id", ident):kv'
+ kv' = if (classes == mempty) then kv else ("CLASS", unwords classes):kv
+ kv'' = if (ident == mempty) then kv' else ("CUSTOM_ID", ident):kv'
properties = vcat $ map kvToOrgProperty kv''
in
drawerStart <> cr <> properties <> cr <> drawerEnd
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 6f5a1bd50..780053059 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -420,9 +420,10 @@ tests =
, "Drawers can be arbitrary" =:
unlines [ ":FOO:"
+ , "/bar/"
, ":END:"
] =?>
- (mempty::Blocks)
+ divWith (mempty, ["FOO", "drawer"], mempty) (para $ emph "bar")
, "Anchor reference" =:
unlines [ "<<link-here>> Target."
@@ -475,6 +476,28 @@ tests =
, "a^b"
] =?>
para "a^b"
+
+ , "Export option: directly select drawers to be exported" =:
+ unlines [ "#+OPTIONS: d:(\"IMPORTANT\")"
+ , ":IMPORTANT:"
+ , "23"
+ , ":END:"
+ , ":BORING:"
+ , "very boring"
+ , ":END:"
+ ] =?>
+ divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23")
+
+ , "Export option: exclude drawers from being exported" =:
+ unlines [ "#+OPTIONS: d:(not \"BORING\")"
+ , ":IMPORTANT:"
+ , "5"
+ , ":END:"
+ , ":BORING:"
+ , "very boring"
+ , ":END:"
+ ] =?>
+ divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5")
]
, testGroup "Basic Blocks" $
@@ -600,7 +623,7 @@ tests =
, "Preferences are treated as header attributes" =:
unlines [ "* foo"
, " :PROPERTIES:"
- , " :id: fubar"
+ , " :custom_id: fubar"
, " :bar: baz"
, " :END:"
] =?>
diff --git a/tests/writer.org b/tests/writer.org
index 58ea5d033..4c7f363a6 100644
--- a/tests/writer.org
+++ b/tests/writer.org
@@ -10,49 +10,49 @@ markdown test suite.
* Headers
:PROPERTIES:
- :id: headers
+ :CUSTOM_ID: headers
:END:
** Level 2 with an [[/url][embedded link]]
:PROPERTIES:
- :id: level-2-with-an-embedded-link
+ :CUSTOM_ID: level-2-with-an-embedded-link
:END:
*** Level 3 with /emphasis/
:PROPERTIES:
- :id: level-3-with-emphasis
+ :CUSTOM_ID: level-3-with-emphasis
:END:
**** Level 4
:PROPERTIES:
- :id: level-4
+ :CUSTOM_ID: level-4
:END:
***** Level 5
:PROPERTIES:
- :id: level-5
+ :CUSTOM_ID: level-5
:END:
* Level 1
:PROPERTIES:
- :id: level-1
+ :CUSTOM_ID: level-1
:END:
** Level 2 with /emphasis/
:PROPERTIES:
- :id: level-2-with-emphasis
+ :CUSTOM_ID: level-2-with-emphasis
:END:
*** Level 3
:PROPERTIES:
- :id: level-3
+ :CUSTOM_ID: level-3
:END:
with no blank line
** Level 2
:PROPERTIES:
- :id: level-2
+ :CUSTOM_ID: level-2
:END:
with no blank line
@@ -61,7 +61,7 @@ with no blank line
* Paragraphs
:PROPERTIES:
- :id: paragraphs
+ :CUSTOM_ID: paragraphs
:END:
Here's a regular paragraph.
@@ -79,7 +79,7 @@ here.
* Block Quotes
:PROPERTIES:
- :id: block-quotes
+ :CUSTOM_ID: block-quotes
:END:
E-mail style:
@@ -121,7 +121,7 @@ And a following paragraph.
* Code Blocks
:PROPERTIES:
- :id: code-blocks
+ :CUSTOM_ID: code-blocks
:END:
Code:
@@ -148,12 +148,12 @@ And:
* Lists
:PROPERTIES:
- :id: lists
+ :CUSTOM_ID: lists
:END:
** Unordered
:PROPERTIES:
- :id: unordered
+ :CUSTOM_ID: unordered
:END:
Asterisks tight:
@@ -200,7 +200,7 @@ Minuses loose:
** Ordered
:PROPERTIES:
- :id: ordered
+ :CUSTOM_ID: ordered
:END:
Tight:
@@ -243,7 +243,7 @@ Multiple paragraphs:
** Nested
:PROPERTIES:
- :id: nested
+ :CUSTOM_ID: nested
:END:
- Tab
@@ -277,7 +277,7 @@ Same thing but with paragraphs:
** Tabs and spaces
:PROPERTIES:
- :id: tabs-and-spaces
+ :CUSTOM_ID: tabs-and-spaces
:END:
- this is a list item indented with tabs
@@ -290,7 +290,7 @@ Same thing but with paragraphs:
** Fancy list markers
:PROPERTIES:
- :id: fancy-list-markers
+ :CUSTOM_ID: fancy-list-markers
:END:
2) begins with 2
@@ -331,7 +331,7 @@ B. Williams
* Definition Lists
:PROPERTIES:
- :id: definition-lists
+ :CUSTOM_ID: definition-lists
:END:
Tight using spaces:
@@ -400,7 +400,7 @@ Blank line after term, indented marker, alternate markers:
* HTML Blocks
:PROPERTIES:
- :id: html-blocks
+ :CUSTOM_ID: html-blocks
:END:
Simple block on one line:
@@ -630,7 +630,7 @@ Hr's:
* Inline Markup
:PROPERTIES:
- :id: inline-markup
+ :CUSTOM_ID: inline-markup
:END:
This is /emphasized/, and so /is this/.
@@ -662,7 +662,7 @@ spaces: a\^b c\^d, a~b c~d.
* Smart quotes, ellipses, dashes
:PROPERTIES:
- :id: smart-quotes-ellipses-dashes
+ :CUSTOM_ID: smart-quotes-ellipses-dashes
:END:
"Hello," said the spider. "'Shelob' is my name."
@@ -686,7 +686,7 @@ Ellipses...and...and....
* LaTeX
:PROPERTIES:
- :id: latex
+ :CUSTOM_ID: latex
:END:
- \cite[22-23]{smith.1899}
@@ -719,7 +719,7 @@ Cat & 1 \\ \hline
* Special Characters
:PROPERTIES:
- :id: special-characters
+ :CUSTOM_ID: special-characters
:END:
Here is some unicode:
@@ -776,12 +776,12 @@ Minus: -
* Links
:PROPERTIES:
- :id: links
+ :CUSTOM_ID: links
:END:
** Explicit
:PROPERTIES:
- :id: explicit
+ :CUSTOM_ID: explicit
:END:
Just a [[/url/][URL]].
@@ -804,7 +804,7 @@ Just a [[/url/][URL]].
** Reference
:PROPERTIES:
- :id: reference
+ :CUSTOM_ID: reference
:END:
Foo [[/url/][bar]].
@@ -835,7 +835,7 @@ Foo [[/url/][biz]].
** With ampersands
:PROPERTIES:
- :id: with-ampersands
+ :CUSTOM_ID: with-ampersands
:END:
Here's a [[http://example.com/?foo=1&bar=2][link with an ampersand in the
@@ -849,7 +849,7 @@ Here's an [[/script?foo=1&bar=2][inline link in pointy braces]].
** Autolinks
:PROPERTIES:
- :id: autolinks
+ :CUSTOM_ID: autolinks
:END:
With an ampersand: [[http://example.com/?foo=1&bar=2]]
@@ -874,7 +874,7 @@ Auto-links should not occur here: =<http://example.com/>=
* Images
:PROPERTIES:
- :id: images
+ :CUSTOM_ID: images
:END:
From "Voyage dans la Lune" by Georges Melies (1902):
@@ -888,7 +888,7 @@ Here is a movie [[movie.jpg]] icon.
* Footnotes
:PROPERTIES:
- :id: footnotes
+ :CUSTOM_ID: footnotes
:END:
Here is a footnote reference, [1] and another. [2] This should /not/ be a
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-25 04:36:56 +0000