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.
This commit is contained in:
parent
d5f367d04b
commit
d8e4a8bc10
2 changed files with 38 additions and 6 deletions
|
@ -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 $
|
||||
|
|
|
@ -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"
|
||||
|
@ -1164,19 +1179,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—"))
|
||||
|
|
Loading…
Add table
Reference in a new issue