git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #2169 from tarleb/org-header-tags

Org reader: put header tags into empty spans

commitfe66122b61f446aca112eeefcd090e33bf1a8f0c authorJohn MacFarlane <jgm@berkeley.edu> dateTue 26 May 2015, 17:14 (11 years ago) parentc3cb27f385dcf5
2 files changed+57−10
compare with master
unifiedsplit
src/Text/Pandoc/Readers/Org.hs+31−6 tests/Tests/Readers/Org.hs+26−4
src/Text/Pandoc/Readers/Org.hs+31−6
@@ -84,13 +84,21 @@ dropCommentTrees [] = []
8484dropCommentTrees blks@(b:bs) =
8585 maybe blks (flip dropUntilHeaderAboveLevel bs) $ commentHeaderLevel b
8686
87−-- | Return the level of a header starting a comment tree and Nothing
88−-- otherwise.
87+-- | Return the level of a header starting a comment or :noexport: tree and
88+-- Nothing otherwise.
8989commentHeaderLevel :: Block -> Maybe Int
9090commentHeaderLevel blk =
9191 case blk of
92− (Header level _ ((Str "COMMENT"):_)) -> Just level
93− _ -> Nothing
92+ (Header level _ ((Str "COMMENT"):_)) -> Just level
93+ (Header level _ title) | hasNoExportTag title -> Just level
94+ _ -> Nothing
95+ where
96+ hasNoExportTag :: [Inline] -> Bool
97+ hasNoExportTag = any isNoExportTag
98+
99+ isNoExportTag :: Inline -> Bool
100+ isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True
101+ isNoExportTag _ = False
94102
95103-- | Drop blocks until a header on or above the given level is seen
96104dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block]
@@ -652,8 +660,25 @@ parseFormat = try $ do
652660header :: OrgParser (F Blocks)
653661header = try $ do
654662 level <- headerStart
655− title <- inlinesTillNewline
656− return $ B.header level <$> title
663+ title <- manyTill inline (lookAhead headerEnd)
664+ tags <- headerEnd
665+ let inlns = trimInlinesF . mconcat $ title <> map tagToInlineF tags
666+ return $ B.header level <$> inlns
667+ where
668+ tagToInlineF :: String -> F Inlines
669+ tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
670+
671+headerEnd :: OrgParser [String]
672+headerEnd = option [] headerTags <* newline
673+
674+headerTags :: OrgParser [String]
675+headerTags = try $
676+ skipSpaces
677+ *> char ':'
678+ *> many1 tag
679+ <* skipSpaces
680+ where tag = many1 (alphaNum <|> oneOf "@%#_")
681+ <* char ':'
657682
658683headerStart :: OrgParser Int
659684headerStart = try $
tests/Tests/Readers/Org.hs+26−4
@@ -497,6 +497,21 @@ tests =
497497 , header 2 ("walk" <> space <> "dog")
498498 ]
499499
500+ , "Tagged headers" =:
501+ unlines [ "* Personal :PERSONAL:"
502+ , "** Call Mom :@PHONE:"
503+ , "** Call John :@PHONE:JOHN: "
504+ ] =?>
505+ let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
506+ in mconcat [ header 1 ("Personal" <> tagSpan "PERSONAL")
507+ , header 2 ("Call Mom" <> tagSpan "@PHONE")
508+ , header 2 ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
509+ ]
510+
511+ , "Untagged header containing colons" =:
512+ "* This: is not: tagged" =?>
513+ header 1 "This: is not: tagged"
514+
500515 , "Comment Trees" =:
501516 unlines [ "* COMMENT A comment tree"
502517 , " Not much going on here"
@@ -509,6 +524,13 @@ tests =
509524 "* COMMENT Test" =?>
510525 (mempty::Blocks)
511526
527+ , "Tree with :noexport:" =:
528+ unlines [ "* Should be ignored :archive:noexport:old:"
529+ , "** Old stuff"
530+ , " This is not going to be exported"
531+ ] =?>
532+ (mempty::Blocks)
533+
512534 , "Paragraph starting with an asterisk" =:
513535 "*five" =?>
514536 para "*five"
@@ -1164,19 +1186,19 @@ tests =
11641186 [ test orgSmart "quote before ellipses"
11651187 ("'...hi'"
11661188 =?> para (singleQuoted "…hi"))
1167−
1189+
11681190 , test orgSmart "apostrophe before emph"
11691191 ("D'oh! A l'/aide/!"
11701192 =?> para ("D’oh! A l’" <> emph "aide" <> "!"))
1171−
1193+
11721194 , test orgSmart "apostrophe in French"
11731195 ("À l'arrivée de la guerre, le thème de l'«impossibilité du socialisme»"
11741196 =?> para "À l’arrivée de la guerre, le thème de l’«impossibilité du socialisme»")
1175−
1197+
11761198 , test orgSmart "Quotes cannot occur at the end of emphasized text"
11771199 ("/say \"yes\"/" =?>
11781200 para ("/say" <> space <> doubleQuoted "yes" <> "/"))
1179−
1201+
11801202 , test orgSmart "Dashes are allowed at the borders of emphasis'"
11811203 ("/foo---/" =?>
11821204 para (emph "foo—"))