git.iko.soy/typeable/pandoc
on master help sign in
Org reader: include tags in headlines
33a1e4aAlbert Krewinkel
src/Text/Pandoc/Readers/Org/DocumentTree.hs+16−6
compare with master
unifiedsplit
@@ -34,6 +34,7 @@ module Text.Pandoc.Readers.Org.DocumentTree
34
34
35import Control.Monad (guard, void)
35import Control.Monad (guard, void)
36import Data.Char (toLower, toUpper)
36import Data.Char (toLower, toUpper)
37+import Data.List ( intersperse )
37import Data.Maybe (fromMaybe)
38import Data.Maybe (fromMaybe)
38import Data.Monoid ((<>))
39import Data.Monoid ((<>))
39import Text.Pandoc.Builder (Blocks, Inlines)
40import Text.Pandoc.Builder (Blocks, Inlines)
@@ -224,7 +225,7 @@ headlineToHeader (Headline {..}) = do
224 Just kw -> todoKeywordToInlines kw <> B.space
225 Just kw -> todoKeywordToInlines kw <> B.space
225 Nothing -> mempty
226 Nothing -> mempty
226 else mempty
227 else mempty
227− let text = tagTitle (todoText <> headlineText) headlineTags
228+ let text = todoText <> headlineText <> tagsToInlines headlineTags
228 let propAttr = propertiesToAttr headlineProperties
229 let propAttr = propertiesToAttr headlineProperties
229 attr <- registerHeader propAttr headlineText
230 attr <- registerHeader propAttr headlineText
230 return $ B.headerWith attr headlineLevel text
231 return $ B.headerWith attr headlineLevel text
@@ -259,12 +260,21 @@ propertiesToAttr properties =
259 in
260 in
260 (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
261 (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
261
262
262−tagTitle :: Inlines -> [Tag] -> Inlines
263+tagsToInlines :: [Tag] -> Inlines
264+tagsToInlines [] = mempty
265+tagsToInlines tags =
263−tagTitle title tags = title <> (mconcat $ map tagToInline 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+
264
277
265−-- | Convert
266−tagToInline :: Tag -> Inlines
267−tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty
268
278
269-- | Read a :PROPERTIES: drawer and return the key/value pairs contained
279-- | Read a :PROPERTIES: drawer and return the key/value pairs contained
270-- within.
280-- within.
test/Tests/Readers/Org.hs+19−17
@@ -28,6 +28,10 @@ simpleTable' :: Int
28 -> Blocks
28 -> Blocks
29simpleTable' n = table "" (replicate n (AlignDefault, 0.0))
29simpleTable' n = table "" (replicate n (AlignDefault, 0.0))
30
30
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+
31tests :: [TestTree]
35tests :: [TestTree]
32tests =
36tests =
33 [ testGroup "Inlines" $
37 [ testGroup "Inlines" $
@@ -729,18 +733,17 @@ tests =
729 , "* old :ARCHIVE:"
733 , "* old :ARCHIVE:"
730 , " boring"
734 , " boring"
731 ] =?>
735 ] =?>
732− let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
733− in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
736+ mconcat [ headerWith ("old", [], mempty) 1
737+ ("old" <> space <> tagSpan "ARCHIVE")
734− , para "boring"
738+ , para "boring"
735− ]
739+ ]
736
740
737 , "include archive tree header only" =:
741 , "include archive tree header only" =:
738 unlines [ "#+OPTIONS: arch:headline"
742 unlines [ "#+OPTIONS: arch:headline"
739 , "* old :ARCHIVE:"
743 , "* old :ARCHIVE:"
740 , " boring"
744 , " boring"
741 ] =?>
745 ] =?>
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")
744
747
745 , "limit headline depth" =:
748 , "limit headline depth" =:
746 unlines [ "#+OPTIONS: H:2"
749 unlines [ "#+OPTIONS: H:2"
@@ -898,17 +901,16 @@ tests =
898 , "** Call Mom :@PHONE:"
901 , "** Call Mom :@PHONE:"
899 , "** Call John :@PHONE:JOHN: "
902 , "** Call John :@PHONE:JOHN: "
900 ] =?>
903 ] =?>
901− let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
902− in mconcat [ headerWith ("personal", [], [])
904+ mconcat [ headerWith ("personal", [], [])
903− 1
905+ 1
904− ("Personal" <> tagSpan "PERSONAL")
906+ ("Personal " <> tagSpan "PERSONAL")
905− , headerWith ("call-mom", [], [])
907+ , headerWith ("call-mom", [], [])
906− 2
908+ 2
907− ("Call Mom" <> tagSpan "@PHONE")
909+ ("Call Mom " <> tagSpan "@PHONE")
908− , headerWith ("call-john", [], [])
910+ , headerWith ("call-john", [], [])
909− 2
911+ 2
910− ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
912+ ("Call John " <> tagSpan "@PHONE" <> "\160" <> tagSpan "JOHN")
911− ]
913+ ]
912
914
913 , "Untagged header containing colons" =:
915 , "Untagged header containing colons" =:
914 "* This: is not: tagged" =?>
916 "* This: is not: tagged" =?>