Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Merge pull request #2941 from tarleb/org-drawer-improvements

Browse source 
Org drawer improvements
This commit is contained in:
John MacFarlane 2016-05-23 10:39:08 -07:00
commit 654bdf72bf
5 changed files with 152 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

83
src/Text/Pandoc/Readers/Org.hs
View file

@ -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')

15
src/Text/Pandoc/Readers/Org/ParserState.hs
View file

@ -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 =

15
src/Text/Pandoc/Writers/Org.hs
View file

@ -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

27
tests/Tests/Readers/Org.hs
View file

@ -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:"
] =?>

62
tests/writer.org
View file

@ -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