From f3d27e4c80a8b33493cfdef9fda8247aaa14c801 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 21 May 2016 15:40:05 +0200 Subject: Org reader/writer: use CUSTOM_ID in properties The `ID` property is reserved for internal use by Org-mode and should not be used. The `CUSTOM_ID` property is to be used instead, it is converted to the `ID` property for certain export format. The reader and writer erroneously used `ID`. This is corrected by using `CUSTOM_ID` where appropriate. --- src/Text/Pandoc/Readers/Org.hs | 7 +++-- src/Text/Pandoc/Writers/Org.hs | 4 +-- tests/Tests/Readers/Org.hs | 2 +- tests/writer.org | 62 +++++++++++++++++++++--------------------- 4 files changed, 38 insertions(+), 37 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index d7939c95a..0ccaa8782 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -626,9 +626,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/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index bc400c998..e2196dcc7 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -239,8 +239,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..c478fedd6 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -600,7 +600,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: == * 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 -- cgit v1.2.3 From a4717c2fc5d82bc4740b21927ca7db3115a8b1af Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 22 May 2016 22:26:38 +0200 Subject: Org reader: respect drawer export setting The `d` export option can be used to control which drawers are exported and which are discarded. Basic support for this option is added here. --- src/Text/Pandoc/Readers/Org.hs | 76 +++++++++++++++++++++++++----- src/Text/Pandoc/Readers/Org/ParserState.hs | 15 +++++- tests/Tests/Readers/Org.hs | 25 +++++++++- 3 files changed, 103 insertions(+), 13 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 0ccaa8782..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 $ 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/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index c478fedd6..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 [ "<> 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" $ -- cgit v1.2.3 From 5667e0959a09035e155beaa1432c48828c4e9396 Mon Sep 17 00:00:00 2001 From: Carlos Sosa Date: Sun, 1 Mar 2015 23:23:21 -0800 Subject: Org writer: add drawer capability For the implementation of the Drawer element in the Org Writer, we make use of a generic Block container with attributes. The presence of a `drawer` class defines that the `Div` constructor is a drawer. The first class defines the drawer name to use. The key-value list in the attributes defines the keys to add inside the Drawer. Lastly, the list of Block elements contains miscellaneous blocks elements to add inside of the Drawer. Signed-off-by: Albert Krewinkel --- src/Text/Pandoc/Writers/Org.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index e2196dcc7..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 -- cgit v1.2.3