Docx writer: support figure numbers.

These are set up in such a way that they will work with Word's
automatic table of figures.

Closes #7392.

3 files changed, 21 insertions, 3 deletions

diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index d1065eb7d..b3e008b8a 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -36,7 +36,8 @@ import Data.Time.Clock.POSIX
 import Data.Digest.Pure.SHA (sha1, showDigest)
 import Skylighting
 import Text.Collate.Lang (renderLang)
-import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
+import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang, translateTerm)
+import qualified Text.Pandoc.Translations as Term
 import qualified Text.Pandoc.Class.PandocMonad as P
 import Data.Time
 import Text.Pandoc.UTF8 (fromTextLazy)
@@ -854,14 +855,29 @@ blockToOpenXML' opts (Plain lst) = do
 -- title beginning with fig: indicates that the image is a figure
 blockToOpenXML' opts (Para [Image attr alt (src,T.stripPrefix "fig:" -> Just tit)]) = do
   setFirstPara
+  fignum <- gets stNextFigureNum
+  modify $ \st -> st{ stNextFigureNum = fignum + 1 }
+  let figid = "fig" <> tshow fignum
+  figname <- translateTerm Term.Figure
   prop <- pStyleM $
         if null alt
         then "Figure"
         else "Captioned Figure"
   paraProps <- local (\env -> env { envParaProperties = EnvProps (Just prop) [] <> envParaProperties env }) (getParaProps False)
   contents <- inlinesToOpenXML opts [Image attr alt (src,tit)]
-  captionNode <- withParaPropM (pStyleM "Image Caption")
-                 $ blockToOpenXML opts (Para alt)
+  captionNode <- if null alt
+                    then return []
+                    else withParaPropM (pStyleM "Image Caption")
+                         $ blockToOpenXML opts
+                            (Para $ Span (figid,[],[])
+                               [Str "Figure\160",
+                                RawInline (Format "openxml")
+                                ("<w:fldSimple w:instr=\"SEQ "
+                                <> figname
+                                <> " \\* ARABIC \"><w:r><w:t>"
+                                <> tshow fignum
+                                <> "</w:t></w:r></w:fldSimple>"),
+                                Str ":", Space] : alt)
   return $
     Elem (mknode "w:p" [] (map Elem paraProps ++ contents))
     : captionNode
diff --git a/src/Text/Pandoc/Writers/Docx/Types.hs b/src/Text/Pandoc/Writers/Docx/Types.hs
index 006584c30..36ac45ad2 100644
--- a/src/Text/Pandoc/Writers/Docx/Types.hs
+++ b/src/Text/Pandoc/Writers/Docx/Types.hs
@@ -117,6 +117,7 @@ data WriterState = WriterState{
        , stDynamicParaProps :: Set.Set ParaStyleName
        , stDynamicTextProps :: Set.Set CharStyleName
        , stCurId          :: Int
+       , stNextFigureNum  :: Int
        }
 
 defaultWriterState :: WriterState
@@ -137,6 +138,7 @@ defaultWriterState = WriterState{
       , stDynamicParaProps = Set.empty
       , stDynamicTextProps = Set.empty
       , stCurId          = 20
+      , stNextFigureNum  = 1
       }
 
 setFirstPara :: PandocMonad m => WS m ()
diff --git a/test/docx/golden/image.docx b/test/docx/golden/image.docx
index 48b72e283..9fe65326f 100644
--- a/test/docx/golden/image.docx
+++ b/test/docx/golden/image.docx