Docx writer: write endnotes to endnotes.xml

jgm · Nov 14, 2017 · bac4cac · bac4cac
1 parent 886e796
commit bac4cac
Show file tree

Hide file tree

Showing 2 changed files with 68 additions and 13 deletions.
diff --git a/data/docx/word/styles.xml b/data/docx/word/styles.xml
@@ -337,6 +337,14 @@
     <w:unhideWhenUsed />
     <w:qFormat />
   </w:style>
+  <w:style w:type="paragraph" w:styleId="EndnoteText">
+    <w:name w:val="Endnote Text" />
+    <w:basedOn w:val="Normal" />
+    <w:next w:val="EndnoteText" />
+    <w:uiPriority w:val="9" />
+    <w:unhideWhenUsed />
+    <w:qFormat />
+  </w:style>
   <w:style w:type="character" w:default="1" w:styleId="DefaultParagraphFont">
     <w:name w:val="Default Paragraph Font" />
     <w:semiHidden />
@@ -428,6 +436,13 @@
       <w:vertAlign w:val="superscript" />
     </w:rPr>
   </w:style>
+  <w:style w:type="character" w:styleId="EndnoteReference">
+    <w:name w:val="Endnote Reference" />
+    <w:basedOn w:val="BodyTextChar" />
+    <w:rPr>
+      <w:vertAlign w:val="superscript" />
+    </w:rPr>
+  </w:style>
   <w:style w:type="character" w:styleId="Hyperlink">
     <w:name w:val="Hyperlink" />
     <w:basedOn w:val="BodyTextChar" />

diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
@@ -123,6 +123,7 @@ defaultWriterEnv = WriterEnv{ envTextProperties = []
 
 data WriterState = WriterState{
          stFootnotes      :: [Element]
+       , stEndnotes       :: [Element]
        , stComments       :: [([(String,String)], [Inline])]
        , stSectionIds     :: Set.Set String
        , stExternalLinks  :: M.Map String String
@@ -140,6 +141,7 @@ data WriterState = WriterState{
 defaultWriterState :: WriterState
 defaultWriterState = WriterState{
         stFootnotes      = defaultFootnotes
+      , stEndnotes       = []
       , stComments       = []
       , stSectionIds     = Set.empty
       , stExternalLinks  = M.empty
@@ -307,7 +309,7 @@ writeDocx opts doc@(Pandoc meta _) = do
         }
 
 
-  ((contents, footnotes, comments), st) <- runStateT
+  ((contents, footnotes, endnotes, comments), st) <- runStateT
                          (runReaderT
                           (writeOpenXML opts{writerWrapText = WrapNone} doc')
                           env)
@@ -376,6 +378,8 @@ writeDocx opts doc@(Pandoc meta _) = do
                     "application/vnd.openxmlformats-officedocument.wordprocessingml.comments+xml")
                   ,("/word/footnotes.xml",
                     "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")
+                  ,("/word/endnotes.xml",
+                    "application/vnd.openxmlformats-officedocument.wordprocessingml.endnotes+xml")
                   ] ++
                   map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) headers ++
@@ -420,8 +424,11 @@ writeDocx opts doc@(Pandoc meta _) = do
                     ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes",
                       "rId7",
                       "footnotes.xml")
-                    ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments",
+                    ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/endnotes",
                       "rId8",
+                      "endnotes.xml")
+                    ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments",
+                      "rId9",
                       "comments.xml")
                     ]
 
@@ -460,14 +467,23 @@ writeDocx opts doc@(Pandoc meta _) = do
                      $ renderXml docContents
 
   -- footnotes
-  let notes = mknode "w:footnotes" stdAttributes footnotes
-  let footnotesEntry = toEntry "word/footnotes.xml" epochtime $ renderXml notes
+  let footnotesNode = mknode "w:footnotes" stdAttributes footnotes
+  let footnotesEntry = toEntry "word/footnotes.xml" epochtime $ renderXml footnotesNode
 
   -- footnote rels
   let footnoteRelEntry = toEntry "word/_rels/footnotes.xml.rels" epochtime
         $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
         linkrels
 
+  -- endnotes
+  let endnotesNode = mknode "w:endnotes" stdAttributes endnotes
+  let endnotesEntry = toEntry "word/endnotes.xml" epochtime $ renderXml endnotesNode
+
+  -- endnote rels
+  let endnoteRelEntry = toEntry "word/_rels/endnotes.xml.rels" epochtime
+        $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
+        linkrels
+
   -- comments
   let commentsEntry = toEntry "word/comments.xml" epochtime
         $ renderXml $ mknode "w:comments" stdAttributes comments
@@ -568,15 +584,16 @@ writeDocx opts doc@(Pandoc meta _) = do
                        , "word/_rels/" `isPrefixOf` (eRelativePath e)
                        , ".xml.rels" `isSuffixOf` (eRelativePath e)
                        , eRelativePath e /= "word/_rels/document.xml.rels"
-                       , eRelativePath e /= "word/_rels/footnotes.xml.rels" ]
+                       , eRelativePath e /= "word/_rels/footnotes.xml.rels"
+                       , eRelativePath e /= "word/_rels/endnotes.xml.rels" ]
   let otherMediaEntries = [ e | e <- zEntries refArchive
                           , "word/media/" `isPrefixOf` eRelativePath e ]
 
   -- Create archive
   let archive = foldr addEntryToArchive emptyArchive $
                   contentTypesEntry : relsEntry : contentEntry : relEntry :
-                  footnoteRelEntry : numEntry : styleEntry : footnotesEntry :
-                  commentsEntry :
+                  footnoteRelEntry : endnoteRelEntry : numEntry : styleEntry :
+                  footnotesEntry : endnotesEntry : commentsEntry :
                   docPropsEntry : docPropsAppEntry : themeEntry :
                   fontTableEntry : settingsEntry : webSettingsEntry :
                   imageEntries ++ headerFooterEntries ++
@@ -775,7 +792,7 @@ makeTOC _ = return []
 
 -- | Convert Pandoc document to two lists of
 -- OpenXML elements (the main document and footnotes).
-writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element],[Element])
+writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element], [Element], [Element])
 writeOpenXML opts (Pandoc meta blocks) = do
   let tit = docTitle meta ++ case lookupMeta "subtitle" meta of
                                   Just (MetaBlocks [Plain xs]) -> LineBreak : xs
@@ -804,7 +821,8 @@ writeOpenXML opts (Pandoc meta blocks) = do
       convertSpace xs                           = xs
   let blocks' = bottomUp convertSpace blocks
   doc' <- setFirstPara >> blocksToOpenXML opts blocks'
-  notes' <- reverse <$> gets stFootnotes
+  footnotes' <- reverse <$> gets stFootnotes
+  endnotes' <- reverse <$> gets stEndnotes
   comments <- reverse <$> gets stComments
   let toComment (kvs, ils) = do
         annotation <- inlinesToOpenXML opts ils
@@ -824,7 +842,7 @@ writeOpenXML opts (Pandoc meta blocks) = do
   comments' <- mapM toComment comments
   toc <- makeTOC opts
   let meta' = title ++ subtitle ++ authors ++ date ++ abstract ++ toc
-  return (meta' ++ doc', notes', comments')
+  return (meta' ++ doc', footnotes', endnotes', comments')
 
 -- | Convert a list of Pandoc blocks to OpenXML.
 blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Element]
@@ -1250,8 +1268,8 @@ inlineToOpenXML' opts (Code attrs str) = do
                     Left msg -> do
                       unless (null msg) $ report $ CouldNotHighlight msg
                       unhighlighted
-inlineToOpenXML' opts (Note _ bs) = do
-  notes <- gets stFootnotes
+inlineToOpenXML' opts (Note FootNote bs) = do
+  footnotes <- gets stFootnotes
   notenum <- (lift . lift) getUniqueId
   footnoteStyle <- rStyleM "Footnote Reference"
   let notemarker = mknode "w:r" []
@@ -1268,10 +1286,32 @@ inlineToOpenXML' opts (Note _ bs) = do
               (withParaPropM (pStyleM "Footnote Text") $ blocksToOpenXML opts
                 $ insertNoteRef bs)
   let newnote = mknode "w:footnote" [("w:id", notenum)] contents
-  modify $ \s -> s{ stFootnotes = newnote : notes }
+  modify $ \s -> s{ stFootnotes = newnote : footnotes }
   return [ mknode "w:r" []
            [ mknode "w:rPr" [] footnoteStyle
            , mknode "w:footnoteReference" [("w:id", notenum)] () ] ]
+inlineToOpenXML' opts (Note EndNote bs) = do
+  endnotes <- gets stEndnotes
+  notenum <- (lift . lift) getUniqueId
+  endnoteStyle <- rStyleM "Endnote Reference"
+  let notemarker = mknode "w:r" []
+                   [ mknode "w:rPr" [] endnoteStyle
+                   , mknode "w:endnoteRef" [] () ]
+  let notemarkerXml = RawInline (Format "openxml") $ ppElement notemarker
+  let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : Space : ils) : xs
+      insertNoteRef (Para ils  : xs) = Para  (notemarkerXml : Space : ils) : xs
+      insertNoteRef xs               = Para [notemarkerXml] : xs
+
+  contents <- local (\env -> env{ envListLevel = -1
+                                , envParaProperties = []
+                                , envTextProperties = [] })
+              (withParaPropM (pStyleM "Endnote Text") $ blocksToOpenXML opts
+                $ insertNoteRef bs)
+  let newnote = mknode "w:endnote" [("w:id", notenum)] contents
+  modify $ \s -> s{ stEndnotes = newnote : endnotes }
+  return [ mknode "w:r" []
+           [ mknode "w:rPr" [] endnoteStyle
+           , mknode "w:endnoteReference" [("w:id", notenum)] () ] ]
 -- internal link:
 inlineToOpenXML' opts (Link _ txt ('#':xs,_)) = do
   contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt