Merge pull request #2037 from lierdakil/issue458

Docx Writer: support for --toc option

data/docx/word/styles.xml

@@ -340,4 +340,23 @@
       <w:color w:val="4F81BD" w:themeColor="accent1" />
     </w:rPr>
   </w:style>
+  <w:style w:type="paragraph" w:styleId="TOCHeading">
+    <w:name w:val="TOC Heading" />
+    <w:basedOn w:val="Heading1" />
+    <w:next w:val="BodyText" />
+    <w:uiPriority w:val="39" />
+    <w:unhideWhenUsed />
+    <w:qFormat />
+    <w:pPr>
+      <w:spacing w:before="240" w:line="259" w:lineRule="auto" />
+      <w:outlineLvl w:val="9" />
+    </w:pPr>
+    <w:rPr>
+      <w:rFonts w:asciiTheme="majorHAnsi" w:eastAsiaTheme="majorEastAsia" w:hAnsiTheme="majorHAnsi" w:cstheme="majorBidi" />
+      <w:b w:val="0" />
+      <w:bCs w:val="0" />
+      <w:color w:val="365F91" w:themeColor="accent1"
+      w:themeShade="BF" />
+    </w:rPr>
+  </w:style>
 </w:styles>

src/Text/Pandoc/Writers/Docx.hs

@@ -598,6 +598,33 @@ mkLvl marker lvl =
 getNumId :: WS Int
 getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists
 
+makeTOC :: WriterOptions -> WS [Element]
+makeTOC opts | writerTableOfContents opts = do
+  let depth = "1-"++(show (writerTOCDepth opts))
+  let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u"
+  title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para [Str "Table of Contents"]])
+  return $
+    [mknode "w:sdt" [] ([
+      mknode "w:sdtPr" [] (
+        mknode "w:docPartObj" [] (
+          [mknode "w:docPartGallery" [("w:val","Table of Contents")] (),
+          mknode "w:docPartUnique" [] ()]
+        ) -- w:docPartObj
+      ), -- w:sdtPr
+      mknode "w:sdtContent" [] (title++[
+        mknode "w:p" [] (
+          mknode "w:r" [] ([
+            mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),
+            mknode "w:instrText" [("xml:space","preserve")] tocCmd,
+            mknode "w:fldChar" [("w:fldCharType","separate")] (),
+            mknode "w:fldChar" [("w:fldCharType","end")] ()
+          ]) -- w:r
+        ) -- w:p
+      ])
+    ])] -- w:sdt
+makeTOC _ = return []
+
+
 -- | Convert Pandoc document to two lists of
 -- OpenXML elements (the main document and footnotes).
 writeOpenXML :: WriterOptions -> Pandoc -> WS ([Element], [Element])
@@ -630,7 +657,8 @@ writeOpenXML opts (Pandoc meta blocks) = do
   let blocks' = bottomUp convertSpace blocks
   doc' <- (setFirstPara >> blocksToOpenXML opts blocks')
   notes' <- reverse `fmap` gets stFootnotes
-  let meta' = title ++ subtitle ++ authors ++ date ++ abstract
+  toc <- makeTOC opts
+  let meta' = title ++ subtitle ++ authors ++ date ++ abstract ++ toc
   return (meta' ++ doc', notes')
 
 -- | Convert a list of Pandoc blocks to OpenXML.