Put id attributes on TOC entries #7907 (#7913)

Naming scheme of id is "toc-" + id of linked to header/section.
In Shared, will effect HTML, Markdown, Powerpoint, and RTF.

src/Text/Pandoc/Writers/Shared.hs

@@ -446,7 +446,7 @@ sectionToListItem opts (Div (ident,_,_)
    headerText' = addNumber $ walk (deLink . deNote) ils
    headerLink = if T.null ident
                    then headerText'
-                   else [Link nullAttr headerText' ("#" <> ident, "")]
+                   else [Link ("toc-" <> ident, [], []) headerText' ("#" <> ident, "")]
    listContents = filter (not . null) $ map (sectionToListItem opts) subsecs
 sectionToListItem _ _ = []
 

test/Tests/Helpers.hs

@@ -36,6 +36,7 @@ import Test.Tasty
 import Test.Tasty.Golden.Advanced (goldenTest)
 import Test.Tasty.HUnit
 import Text.Pandoc.Builder (Blocks, Inlines, doc, plain)
+import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Class
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
@@ -150,6 +151,12 @@ instance ToString Pandoc where
 instance ToString Blocks where
   toString = unpack . purely (writeNative def) . toPandoc
 
+instance ToString [Block] where
+  toString = toString . B.fromList
+
+instance ToString Block where
+  toString = toString . B.singleton 
+
 instance ToString Inlines where
   toString = unpack . trimr . purely (writeNative def) . toPandoc
 

test/Tests/Shared.hs

@@ -14,11 +14,14 @@ module Tests.Shared (tests) where
 
 import System.FilePath.Posix (joinPath)
 import Test.Tasty
-import Test.Tasty.HUnit (assertBool, testCase, (@?=))
 import Text.Pandoc.Arbitrary ()
 import Text.Pandoc.Builder
 import Text.Pandoc.Shared
-import Text.Pandoc.Writers.Shared (toLegacyTable)
+import Test.Tasty.HUnit
+import Tests.Helpers
+import Text.Pandoc
+import Text.Pandoc.Writers.Shared
+import qualified Data.Text as T
 
 tests :: [TestTree]
 tests = [ testGroup "compactifyDL"
@@ -29,8 +32,39 @@ tests = [ testGroup "compactifyDL"
           ]
         , testGroup "collapseFilePath" testCollapse
         , testGroup "toLegacyTable" testLegacyTable
+        , testGroup "table of contents" testTOC
         ] 
 
+givesTOC :: String -> (Blocks, Blocks) -> TestTree
+givesTOC desc (blocks, toc) = test (toTableOfContents def) desc (toList blocks, head . toList $ toc)
+
+linkId :: T.Text -> T.Text -> T.Text -> Inlines -> Inlines
+linkId lId = linkWith (lId,[],[])
+
+headerId :: T.Text -> Int -> Inlines -> Blocks
+headerId hId = headerWith (hId,[],[])
+
+testTOC :: [TestTree]
+testTOC = [ givesTOC "empty case" $ mempty =?> bulletList []
+          , givesTOC "no headers" $ horizontalRule =?> bulletList []
+          , givesTOC "unlinked header" $
+              header 1 "H1" =?>
+              bulletList [plain "H1"]
+          , givesTOC "linked header" $
+              headerId "h1" 1 "H1" =?>
+              bulletList [plain $ linkId "toc-h1" "#h1" "" "H1"]
+          , givesTOC "nested headlines" $
+              header 1 "H1a" <> header 2 "H2" =?>
+              bulletList [plain "H1a" <> bulletList [plain "H2"]]
+          , givesTOC "only referenced headers" $
+              header 1 "H1a" <> headerId "h2" 2 "H2" =?>
+              bulletList [plain "H1a" <> 
+                          bulletList [plain $ linkId "toc-h2" "#h2" "" "H2"]]
+          , givesTOC "section id used as backup" $
+              divWith ("sec",["section"],[]) (header 1 "H1") =?>
+              bulletList [plain $ linkId "toc-sec" "#sec" "" "H1"]             
+          ]
+
 testCollapse :: [TestTree]
 testCollapse = map (testCase "collapse")
  [  collapseFilePath (joinPath [ ""]) @?= joinPath [ ""]

test/command/toc.md

@@ -16,12 +16,12 @@
 ## e
 :::
 ^D
--   [A](#a)
-    -   [b](#b)
--   [B](#b-1)
-    -   [b](#b-2)
--   [E](#e)
-    -   [e](#e-1)
+-   [A](#a){#toc-a}
+    -   [b](#b){#toc-b}
+-   [B](#b-1){#toc-b-1}
+    -   [b](#b-2){#toc-b-2}
+-   [E](#e){#toc-e}
+    -   [e](#e-1){#toc-e-1}
 
 # A