Merge pull request #2169 from tarleb/org-header-tags

Org reader: put header tags into empty spans

2 files changed, 57 insertions, 10 deletions

diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 83fb48764..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]
@@ -652,8 +660,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 $
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 4cec54a68..92e6993df 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -497,6 +497,21 @@ tests =
                   , header 2 ("walk" <> space <> "dog")
                   ]
 
+      , "Tagged headers" =:
+          unlines [ "* Personal       :PERSONAL:"
+                  , "** Call Mom      :@PHONE:"
+                  , "** Call John     :@PHONE:JOHN: "
+                  ] =?>
+          let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
+          in mconcat [ header 1 ("Personal" <> tagSpan "PERSONAL")
+                     , header 2 ("Call Mom" <> tagSpan "@PHONE")
+                     , header 2 ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
+                     ]
+
+      , "Untagged header containing colons" =:
+          "* This: is not: tagged" =?>
+          header 1 "This: is not: tagged"
+
       , "Comment Trees" =:
           unlines [ "* COMMENT A comment tree"
                   , "  Not much going on here"
@@ -509,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"
@@ -1164,19 +1186,19 @@ tests =
       [ test orgSmart "quote before ellipses"
         ("'...hi'"
          =?> para (singleQuoted "…hi"))
-        
+
       , test orgSmart "apostrophe before emph"
         ("D'oh! A l'/aide/!"
          =?> para ("D’oh! A l’" <> emph "aide" <> "!"))
-        
+
       , test orgSmart "apostrophe in French"
         ("À l'arrivée de la guerre, le thème de l'«impossibilité du socialisme»"
          =?> para "À l’arrivée de la guerre, le thème de l’«impossibilité du socialisme»")
-        
+
       , test orgSmart "Quotes cannot occur at the end of emphasized text"
         ("/say \"yes\"/" =?>
          para ("/say" <> space <> doubleQuoted "yes" <> "/"))
-        
+
       , test orgSmart "Dashes are allowed at the borders of emphasis'"
         ("/foo---/" =?>
          para (emph "foo—"))