Merge pull request #2934 from tarleb/org-properties-drawer
Org properties drawer
This commit is contained in:
John MacFarlane
commit
2e266b6a3a
4 changed files with 184 additions and 35 deletions
|
|
@ -284,7 +284,7 @@ block = choice [ mempty <$ blanklines
|
|||
, orgBlock
|
||||
, figure
|
||||
, example
|
||||
, drawer
|
||||
, genericDrawer
|
||||
, specialLine
|
||||
, header
|
||||
, return <$> hline
|
||||
|
|
@ -582,26 +582,55 @@ exampleCode = B.codeBlockWith ("", ["example"], [])
|
|||
exampleLine :: OrgParser String
|
||||
exampleLine = try $ skipSpaces *> string ": " *> anyLine
|
||||
|
||||
-- Drawers for properties or a logbook
|
||||
drawer :: OrgParser (F Blocks)
|
||||
drawer = try $ do
|
||||
|
||||
--
|
||||
-- Drawers
|
||||
--
|
||||
|
||||
-- | A generic drawer which has no special meaning for org-mode.
|
||||
genericDrawer :: OrgParser (F Blocks)
|
||||
genericDrawer = try $ do
|
||||
drawerStart
|
||||
manyTill drawerLine (try drawerEnd)
|
||||
return mempty
|
||||
|
||||
drawerStart :: OrgParser String
|
||||
drawerStart = try $
|
||||
skipSpaces *> drawerName <* skipSpaces <* P.newline
|
||||
where drawerName = try $ char ':' *> validDrawerName <* char ':'
|
||||
validDrawerName = stringAnyCase "PROPERTIES"
|
||||
<|> stringAnyCase "LOGBOOK"
|
||||
skipSpaces *> drawerName <* skipSpaces <* newline
|
||||
where drawerName = char ':' *> manyTill nonspaceChar (char ':')
|
||||
|
||||
drawerLine :: OrgParser String
|
||||
drawerLine = try anyLine
|
||||
drawerLine = anyLine
|
||||
|
||||
drawerEnd :: OrgParser String
|
||||
drawerEnd = try $
|
||||
skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* P.newline
|
||||
skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
|
||||
|
||||
-- | Read a :PROPERTIES: drawer and return the key/value pairs contained
|
||||
-- within.
|
||||
propertiesDrawer :: OrgParser [(String, String)]
|
||||
propertiesDrawer = try $ do
|
||||
drawerType <- drawerStart
|
||||
guard $ map toUpper drawerType == "PROPERTIES"
|
||||
manyTill property (try drawerEnd)
|
||||
where
|
||||
property :: OrgParser (String, String)
|
||||
property = try $ (,) <$> key <*> value
|
||||
|
||||
key :: OrgParser String
|
||||
key = try $ skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')
|
||||
|
||||
value :: OrgParser String
|
||||
value = try $ skipSpaces *> manyTill anyChar (try $ skipSpaces *> P.newline)
|
||||
|
||||
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
|
||||
in
|
||||
(id', words cls, kvs')
|
||||
|
||||
|
||||
--
|
||||
|
|
@ -700,29 +729,28 @@ parseFormat = try $ do
|
|||
-- | Headers
|
||||
header :: OrgParser (F Blocks)
|
||||
header = try $ do
|
||||
level <- headerStart
|
||||
title <- manyTill inline (lookAhead headerEnd)
|
||||
tags <- headerEnd
|
||||
let inlns = trimInlinesF . mconcat $ title <> map tagToInlineF tags
|
||||
st <- getState
|
||||
let inlines = runF inlns st
|
||||
attr <- registerHeader nullAttr inlines
|
||||
level <- headerStart
|
||||
title <- manyTill inline (lookAhead $ optional headerTags <* P.newline)
|
||||
tags <- option [] headerTags
|
||||
newline
|
||||
propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer)
|
||||
inlines <- runF (tagTitle title tags) <$> getState
|
||||
attr <- registerHeader propAttr inlines
|
||||
return $ pure (B.headerWith attr level inlines)
|
||||
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
|
||||
|
||||
headerEnd :: OrgParser [String]
|
||||
headerEnd = option [] headerTags <* newline
|
||||
|
||||
headerTags :: OrgParser [String]
|
||||
headerTags = try $
|
||||
skipSpaces
|
||||
*> char ':'
|
||||
*> many1 tag
|
||||
<* skipSpaces
|
||||
where tag = many1 (alphaNum <|> oneOf "@%#_")
|
||||
<* char ':'
|
||||
headerTags :: OrgParser [String]
|
||||
headerTags = try $
|
||||
let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'
|
||||
in skipSpaces
|
||||
*> char ':'
|
||||
*> many1 tag
|
||||
<* skipSpaces
|
||||
|
||||
headerStart :: OrgParser Int
|
||||
headerStart = try $
|
||||
|
|
|
|||
|
|
@ -137,10 +137,13 @@ blockToOrg (RawBlock f str) | isRawFormat f =
|
|||
return $ text str
|
||||
blockToOrg (RawBlock _ _) = return empty
|
||||
blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline
|
||||
blockToOrg (Header level _ inlines) = do
|
||||
blockToOrg (Header level attr inlines) = do
|
||||
contents <- inlineListToOrg inlines
|
||||
let headerStr = text $ if level > 999 then " " else replicate level '*'
|
||||
return $ headerStr <> " " <> contents <> blankline
|
||||
let drawerStr = if attr == nullAttr
|
||||
then empty
|
||||
else cr <> nest (level + 1) (propertiesDrawer attr)
|
||||
return $ headerStr <> " " <> contents <> drawerStr <> blankline
|
||||
blockToOrg (CodeBlock (_,classes,_) str) = do
|
||||
opts <- stOptions <$> get
|
||||
let tabstop = writerTabStop opts
|
||||
|
|
@ -230,6 +233,22 @@ definitionListItemToOrg (label, defs) = do
|
|||
contents <- liftM vcat $ mapM blockListToOrg defs
|
||||
return $ hang 3 "- " $ label' <> " :: " <> (contents <> cr)
|
||||
|
||||
-- | Convert list of key/value pairs to Org :PROPERTIES: drawer.
|
||||
propertiesDrawer :: Attr -> Doc
|
||||
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'
|
||||
properties = vcat $ map kvToOrgProperty kv''
|
||||
in
|
||||
drawerStart <> cr <> properties <> cr <> drawerEnd
|
||||
where
|
||||
kvToOrgProperty :: (String, String) -> Doc
|
||||
kvToOrgProperty (key, value) =
|
||||
text ":" <> text key <> text ": " <> text value <> cr
|
||||
|
||||
-- | Convert list of Pandoc block elements to Org.
|
||||
blockListToOrg :: [Block] -- ^ List of block elements
|
||||
-> State WriterState Doc
|
||||
|
|
|
|||
|
|
@ -412,17 +412,17 @@ tests =
|
|||
] =?>
|
||||
para "Before" <> para "After"
|
||||
|
||||
, "Drawer start is the only text in first line of a drawer" =:
|
||||
, "Drawer markers must be the only text in the line" =:
|
||||
unlines [ " :LOGBOOK: foo"
|
||||
, " :END:"
|
||||
, " :END: bar"
|
||||
] =?>
|
||||
para (":LOGBOOK:" <> space <> "foo" <> softbreak <> ":END:")
|
||||
para (":LOGBOOK: foo" <> softbreak <> ":END: bar")
|
||||
|
||||
, "Drawers with unknown names are just text" =:
|
||||
, "Drawers can be arbitrary" =:
|
||||
unlines [ ":FOO:"
|
||||
, ":END:"
|
||||
] =?>
|
||||
para (":FOO:" <> softbreak <> ":END:")
|
||||
(mempty::Blocks)
|
||||
|
||||
, "Anchor reference" =:
|
||||
unlines [ "<<link-here>> Target."
|
||||
|
|
@ -597,6 +597,15 @@ tests =
|
|||
, headerWith ("but-this-is", [], []) 2 "But this is"
|
||||
]
|
||||
|
||||
, "Preferences are treated as header attributes" =:
|
||||
unlines [ "* foo"
|
||||
, " :PROPERTIES:"
|
||||
, " :id: fubar"
|
||||
, " :bar: baz"
|
||||
, " :END:"
|
||||
] =?>
|
||||
headerWith ("fubar", [], [("bar", "baz")]) 1 "foo"
|
||||
|
||||
, "Paragraph starting with an asterisk" =:
|
||||
"*five" =?>
|
||||
para "*five"
|
||||
|
|
|
|||
|
|
@ -9,30 +9,60 @@ markdown test suite.
|
|||
--------------
|
||||
|
||||
* Headers
|
||||
:PROPERTIES:
|
||||
:id: headers
|
||||
:END:
|
||||
|
||||
** Level 2 with an [[/url][embedded link]]
|
||||
:PROPERTIES:
|
||||
:id: level-2-with-an-embedded-link
|
||||
:END:
|
||||
|
||||
*** Level 3 with /emphasis/
|
||||
:PROPERTIES:
|
||||
:id: level-3-with-emphasis
|
||||
:END:
|
||||
|
||||
**** Level 4
|
||||
:PROPERTIES:
|
||||
:id: level-4
|
||||
:END:
|
||||
|
||||
***** Level 5
|
||||
:PROPERTIES:
|
||||
:id: level-5
|
||||
:END:
|
||||
|
||||
* Level 1
|
||||
:PROPERTIES:
|
||||
:id: level-1
|
||||
:END:
|
||||
|
||||
** Level 2 with /emphasis/
|
||||
:PROPERTIES:
|
||||
:id: level-2-with-emphasis
|
||||
:END:
|
||||
|
||||
*** Level 3
|
||||
:PROPERTIES:
|
||||
:id: level-3
|
||||
:END:
|
||||
|
||||
with no blank line
|
||||
|
||||
** Level 2
|
||||
:PROPERTIES:
|
||||
:id: level-2
|
||||
:END:
|
||||
|
||||
with no blank line
|
||||
|
||||
--------------
|
||||
|
||||
* Paragraphs
|
||||
:PROPERTIES:
|
||||
:id: paragraphs
|
||||
:END:
|
||||
|
||||
Here's a regular paragraph.
|
||||
|
||||
|
|
@ -48,6 +78,9 @@ here.
|
|||
--------------
|
||||
|
||||
* Block Quotes
|
||||
:PROPERTIES:
|
||||
:id: block-quotes
|
||||
:END:
|
||||
|
||||
E-mail style:
|
||||
|
||||
|
|
@ -87,6 +120,9 @@ And a following paragraph.
|
|||
--------------
|
||||
|
||||
* Code Blocks
|
||||
:PROPERTIES:
|
||||
:id: code-blocks
|
||||
:END:
|
||||
|
||||
Code:
|
||||
|
||||
|
|
@ -111,8 +147,14 @@ And:
|
|||
--------------
|
||||
|
||||
* Lists
|
||||
:PROPERTIES:
|
||||
:id: lists
|
||||
:END:
|
||||
|
||||
** Unordered
|
||||
:PROPERTIES:
|
||||
:id: unordered
|
||||
:END:
|
||||
|
||||
Asterisks tight:
|
||||
|
||||
|
|
@ -157,6 +199,9 @@ Minuses loose:
|
|||
- Minus 3
|
||||
|
||||
** Ordered
|
||||
:PROPERTIES:
|
||||
:id: ordered
|
||||
:END:
|
||||
|
||||
Tight:
|
||||
|
||||
|
|
@ -197,6 +242,9 @@ Multiple paragraphs:
|
|||
3. Item 3.
|
||||
|
||||
** Nested
|
||||
:PROPERTIES:
|
||||
:id: nested
|
||||
:END:
|
||||
|
||||
- Tab
|
||||
|
||||
|
|
@ -228,6 +276,9 @@ Same thing but with paragraphs:
|
|||
3. Third
|
||||
|
||||
** Tabs and spaces
|
||||
:PROPERTIES:
|
||||
:id: tabs-and-spaces
|
||||
:END:
|
||||
|
||||
- this is a list item indented with tabs
|
||||
|
||||
|
|
@ -238,6 +289,9 @@ Same thing but with paragraphs:
|
|||
- this is an example list item indented with spaces
|
||||
|
||||
** Fancy list markers
|
||||
:PROPERTIES:
|
||||
:id: fancy-list-markers
|
||||
:END:
|
||||
|
||||
2) begins with 2
|
||||
3) and now 3
|
||||
|
|
@ -276,6 +330,9 @@ B. Williams
|
|||
--------------
|
||||
|
||||
* Definition Lists
|
||||
:PROPERTIES:
|
||||
:id: definition-lists
|
||||
:END:
|
||||
|
||||
Tight using spaces:
|
||||
|
||||
|
|
@ -342,6 +399,9 @@ Blank line after term, indented marker, alternate markers:
|
|||
2. sublist
|
||||
|
||||
* HTML Blocks
|
||||
:PROPERTIES:
|
||||
:id: html-blocks
|
||||
:END:
|
||||
|
||||
Simple block on one line:
|
||||
|
||||
|
|
@ -569,6 +629,9 @@ Hr's:
|
|||
--------------
|
||||
|
||||
* Inline Markup
|
||||
:PROPERTIES:
|
||||
:id: inline-markup
|
||||
:END:
|
||||
|
||||
This is /emphasized/, and so /is this/.
|
||||
|
||||
|
|
@ -598,6 +661,9 @@ spaces: a\^b c\^d, a~b c~d.
|
|||
--------------
|
||||
|
||||
* Smart quotes, ellipses, dashes
|
||||
:PROPERTIES:
|
||||
:id: smart-quotes-ellipses-dashes
|
||||
:END:
|
||||
|
||||
"Hello," said the spider. "'Shelob' is my name."
|
||||
|
||||
|
|
@ -619,6 +685,9 @@ Ellipses...and...and....
|
|||
--------------
|
||||
|
||||
* LaTeX
|
||||
:PROPERTIES:
|
||||
:id: latex
|
||||
:END:
|
||||
|
||||
- \cite[22-23]{smith.1899}
|
||||
- $2+2=4$
|
||||
|
|
@ -649,6 +718,9 @@ Cat & 1 \\ \hline
|
|||
--------------
|
||||
|
||||
* Special Characters
|
||||
:PROPERTIES:
|
||||
:id: special-characters
|
||||
:END:
|
||||
|
||||
Here is some unicode:
|
||||
|
||||
|
|
@ -703,8 +775,14 @@ Minus: -
|
|||
--------------
|
||||
|
||||
* Links
|
||||
:PROPERTIES:
|
||||
:id: links
|
||||
:END:
|
||||
|
||||
** Explicit
|
||||
:PROPERTIES:
|
||||
:id: explicit
|
||||
:END:
|
||||
|
||||
Just a [[/url/][URL]].
|
||||
|
||||
|
|
@ -725,6 +803,9 @@ Just a [[/url/][URL]].
|
|||
[[][Empty]].
|
||||
|
||||
** Reference
|
||||
:PROPERTIES:
|
||||
:id: reference
|
||||
:END:
|
||||
|
||||
Foo [[/url/][bar]].
|
||||
|
||||
|
|
@ -753,6 +834,9 @@ Foo [[/url/][bar]].
|
|||
Foo [[/url/][biz]].
|
||||
|
||||
** With ampersands
|
||||
:PROPERTIES:
|
||||
:id: with-ampersands
|
||||
:END:
|
||||
|
||||
Here's a [[http://example.com/?foo=1&bar=2][link with an ampersand in the
|
||||
URL]].
|
||||
|
|
@ -764,6 +848,9 @@ Here's an [[/script?foo=1&bar=2][inline link]].
|
|||
Here's an [[/script?foo=1&bar=2][inline link in pointy braces]].
|
||||
|
||||
** Autolinks
|
||||
:PROPERTIES:
|
||||
:id: autolinks
|
||||
:END:
|
||||
|
||||
With an ampersand: [[http://example.com/?foo=1&bar=2]]
|
||||
|
||||
|
|
@ -786,6 +873,9 @@ Auto-links should not occur here: =<http://example.com/>=
|
|||
--------------
|
||||
|
||||
* Images
|
||||
:PROPERTIES:
|
||||
:id: images
|
||||
:END:
|
||||
|
||||
From "Voyage dans la Lune" by Georges Melies (1902):
|
||||
|
||||
|
|
@ -797,6 +887,9 @@ Here is a movie [[movie.jpg]] icon.
|
|||
--------------
|
||||
|
||||
* Footnotes
|
||||
:PROPERTIES:
|
||||
:id: footnotes
|
||||
:END:
|
||||
|
||||
Here is a footnote reference, [1] and another. [2] This should /not/ be a
|
||||
footnote reference, because it contains a space.[\^my note] Here is an inline
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue