git.iko.soy/typeable/pandoc
on master help sign in
Org reader: include tags in headlines

The Emacs default is to include tags in the headline when exporting. Instead of just empty spans, which contain the tag name as attribute, tags are rendered as small caps and wrapped in those spans. Non-breaking spaces serve as separators for multiple tags.

commit33a1e4ae1af769eb45b671794da4984bcba25340 authorAlbert Krewinkel <albert@zeitkraut.de> dateWed 31 May 2017, 20:43 (9 years ago) parent7852cd5
2 files changed+35−23
compare with master
unifiedsplit
src/Text/Pandoc/Readers/Org/DocumentTree.hs+16−6 test/Tests/Readers/Org.hs+19−17
src/Text/Pandoc/Readers/Org/DocumentTree.hs+16−6
@@ -34,6 +34,7 @@ module Text.Pandoc.Readers.Org.DocumentTree
3434
3535import Control.Monad (guard, void)
3636import Data.Char (toLower, toUpper)
37+import Data.List ( intersperse )
3738import Data.Maybe (fromMaybe)
3839import Data.Monoid ((<>))
3940import Text.Pandoc.Builder (Blocks, Inlines)
@@ -224,7 +225,7 @@ headlineToHeader (Headline {..}) = do
224225 Just kw -> todoKeywordToInlines kw <> B.space
225226 Nothing -> mempty
226227 else mempty
227− let text = tagTitle (todoText <> headlineText) headlineTags
228+ let text = todoText <> headlineText <> tagsToInlines headlineTags
228229 let propAttr = propertiesToAttr headlineProperties
229230 attr <- registerHeader propAttr headlineText
230231 return $ B.headerWith attr headlineLevel text
@@ -259,12 +260,21 @@ propertiesToAttr properties =
259260 in
260261 (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
261262
262−tagTitle :: Inlines -> [Tag] -> Inlines
263−tagTitle title tags = title <> (mconcat $ map tagToInline tags)
263+tagsToInlines :: [Tag] -> Inlines
264+tagsToInlines [] = mempty
265+tagsToInlines tags =
266+ (B.space <>) . mconcat . intersperse (B.str "\160") . map tagToInline $ tags
267+ where
268+ tagToInline :: Tag -> Inlines
269+ tagToInline t = tagSpan t . B.smallcaps . B.str $ fromTag t
270+
271+-- | Wrap the given inline in a span, marking it as a tag.
272+tagSpan :: Tag -> Inlines -> Inlines
273+tagSpan t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)])
274+
275+
276+
264277
265−-- | Convert
266−tagToInline :: Tag -> Inlines
267−tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty
268278
269279-- | Read a :PROPERTIES: drawer and return the key/value pairs contained
270280-- within.
test/Tests/Readers/Org.hs+19−17
@@ -28,6 +28,10 @@ simpleTable' :: Int
2828 -> Blocks
2929simpleTable' n = table "" (replicate n (AlignDefault, 0.0))
3030
31+-- | Create a span for the given tag.
32+tagSpan :: String -> Inlines
33+tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) . smallcaps $ str t
34+
3135tests :: [TestTree]
3236tests =
3337 [ testGroup "Inlines" $
@@ -729,18 +733,17 @@ tests =
729733 , "* old :ARCHIVE:"
730734 , " boring"
731735 ] =?>
732− let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
733− in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
734− , para "boring"
735− ]
736+ mconcat [ headerWith ("old", [], mempty) 1
737+ ("old" <> space <> tagSpan "ARCHIVE")
738+ , para "boring"
739+ ]
736740
737741 , "include archive tree header only" =:
738742 unlines [ "#+OPTIONS: arch:headline"
739743 , "* old :ARCHIVE:"
740744 , " boring"
741745 ] =?>
742− let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
743− in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
746+ headerWith ("old", [], mempty) 1 ("old" <> space <> tagSpan "ARCHIVE")
744747
745748 , "limit headline depth" =:
746749 unlines [ "#+OPTIONS: H:2"
@@ -898,17 +901,16 @@ tests =
898901 , "** Call Mom :@PHONE:"
899902 , "** Call John :@PHONE:JOHN: "
900903 ] =?>
901− let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
902− in mconcat [ headerWith ("personal", [], [])
903− 1
904− ("Personal" <> tagSpan "PERSONAL")
905− , headerWith ("call-mom", [], [])
906− 2
907− ("Call Mom" <> tagSpan "@PHONE")
908− , headerWith ("call-john", [], [])
909− 2
910− ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
911− ]
904+ mconcat [ headerWith ("personal", [], [])
905+ 1
906+ ("Personal " <> tagSpan "PERSONAL")
907+ , headerWith ("call-mom", [], [])
908+ 2
909+ ("Call Mom " <> tagSpan "@PHONE")
910+ , headerWith ("call-john", [], [])
911+ 2
912+ ("Call John " <> tagSpan "@PHONE" <> "\160" <> tagSpan "JOHN")
913+ ]
912914
913915 , "Untagged header containing colons" =:
914916 "* This: is not: tagged" =?>