From d8e4a8bc10bfd97d81ec0166fd786742fe3a2370 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Wed, 20 May 2015 18:01:03 +0200
Subject: Org reader: put header tags into empty spans
Org mode allows headers to be tagged:
``` org-mode
* Headline :TAG1:TAG2:
```
Instead of being interpreted as part of the headline, the tags are now
put into the attributes of empty spans. Spans without textual content
won't be visible by default, but they are detectable by filters. They
can also be styled using CSS when written as HTML.
This fixes #2160.
---
src/Text/Pandoc/Readers/Org.hs | 21 +++++++++++++++++++--
1 file changed, 19 insertions(+), 2 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 83fb48764..dd8da30c2 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -652,8 +652,25 @@ parseFormat = try $ do
header :: OrgParser (F Blocks)
header = try $ do
level <- headerStart
- title <- inlinesTillNewline
- return $ B.header level <$> title
+ title <- manyTill inline (lookAhead headerEnd)
+ tags <- headerEnd
+ let inlns = trimInlinesF . mconcat $ title <> map tagToInlineF tags
+ return $ B.header level <$> inlns
+ where
+ 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 ':'
headerStart :: OrgParser Int
headerStart = try $
--
cgit v1.2.3
From 385dcf5b99331d392422062586d936af87ee0e46 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sat, 23 May 2015 14:20:17 +0200
Subject: Org reader: drop trees with a :noexport: tag
Trees having a `:noexport:` tag set are not exported. This mirrors
default Emacs Org-Mode behavior.
---
src/Text/Pandoc/Readers/Org.hs | 16 ++++++++++++----
tests/Tests/Readers/Org.hs | 7 +++++++
2 files changed, 19 insertions(+), 4 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index dd8da30c2..65b8d972c 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -84,13 +84,21 @@ dropCommentTrees [] = []
dropCommentTrees blks@(b:bs) =
maybe blks (flip dropUntilHeaderAboveLevel bs) $ commentHeaderLevel b
--- | Return the level of a header starting a comment tree and Nothing
--- otherwise.
+-- | 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
- _ -> Nothing
+ (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]
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 7b6773bf5..92e6993df 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -524,6 +524,13 @@ tests =
"* COMMENT Test" =?>
(mempty::Blocks)
+ , "Tree with :noexport:" =:
+ unlines [ "* Should be ignored :archive:noexport:old:"
+ , "** Old stuff"
+ , " This is not going to be exported"
+ ] =?>
+ (mempty::Blocks)
+
, "Paragraph starting with an asterisk" =:
"*five" =?>
para "*five"
--
cgit v1.2.3