Add options to change table/figure caption positions.

+ Add command line options `--table-caption-position` and `--figure-caption-position`. These allow the user to specify whether to put captions above or below tables and figures, respectively. The following output formats are supported: HTML (and related such as EPUB), LaTeX (and Beamer), Docx, ODT/OpenDocument, Typst. + Text.Pandoc.Options: add `CaptionPosition` and new `WriterOptions` fields `writerFigureCaptionPosition` and `writerTableCaptionPosition` [API change]. + Text.Pandoc.Opt: add `Opt` fields `optFigureCaptionPosition` and `optTableCaptionPosition` [API change]. + Docx writer: make table/figure rendering sensitive to caption position settings. + OpenDocument writer: make table/figure rendering sensitive to caption position settings. + Typst writer/template: implement figure caption positions by triggering a show rule in the default template, which determines caption positions for figures and tables globally. + LaTeX writer: make table/figure rendering sensitive to caption position settings. Closes #5116. + HTML writer/template: make `<figcaption>` placement sensitive to caption position settings. For tables, `<caption>` must be the first element, and positioning is determined by CSS, for here we set a variable which the default template is sensitive to.
jgm · Sep 8, 2024 · a27dad6 · a27dad6
1 parent 74221a0
commit a27dad6
Show file tree

Hide file tree

Showing 16 changed files with 278 additions and 40 deletions.
diff --git a/MANUAL.txt b/MANUAL.txt
@@ -1058,6 +1058,18 @@ header when requesting a document from a URL:
     specifying `--reference-location=section` will cause notes
     to be rendered at the bottom of a slide.
 
+`--figure-caption-position=above`|`below`
+
+:   Specify whether figure captions go above or below figures
+    (default is `below`).  This option only affects HTML,
+    LaTeX, Docx, ODT, and Typst output.
+
+`--table-caption-position=above`|`below`
+
+:   Specify whether table captions go above or below tables
+    (default is `above`).  This option only affects HTML,
+    LaTeX, Docx, ODT, and Typst output.
+
 `--markdown-headings=setext`|`atx`
 
 :   Specify whether to use ATX-style (`#`-prefixed) or

diff --git a/data/templates/default.typst b/data/templates/default.typst
@@ -14,6 +14,14 @@ $definitions.typst()$
   stroke: none
 )
 
+#show figure.where(
+  kind: table
+): set figure.caption(position: $if(table-caption-position)$$table-caption-position$$else$top$endif$)
+
+#show figure.where(
+  kind: image
+): set figure.caption(position: $if(figure-caption-position)$$figure-caption-position$$else$bottom$endif$)
+
 $if(template)$
 #import "$template$": conf
 $else$

diff --git a/data/templates/styles.html b/data/templates/styles.html
@@ -144,7 +144,12 @@
   font-variant-numeric: lining-nums tabular-nums;
 }
 table caption {
+$if(table-caption-below)$
+  caption-side: bottom;
+  margin-top: 0.75em;
+$else$
   margin-bottom: 0.75em;
+$endif$
 }
 tbody {
   margin-top: 0.5em;

diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs
@@ -728,7 +728,31 @@ options =
                                "Argument of --reference-location must be block, section, or document"
                      return opt { optReferenceLocation = action })
                   "block|section|document")
-                 "" -- "Accepting or reject MS Word track-changes.""
+                 "" -- "Specify where reference links and footnotes go"
+
+    , Option "" ["figure-caption-position"]
+                 (ReqArg
+                  (\arg opt -> do
+                     pos <- case arg of
+                            "above"  -> return CaptionAbove
+                            "below"  -> return CaptionBelow
+                            _        -> optError $ PandocOptionError $ T.pack
+                               "Argument of --figure-caption-position must be above or below"
+                     return opt { optFigureCaptionPosition = pos })
+                  "above|below")
+                 "" -- "Specify where figure captions go"
+
+    , Option "" ["table-caption-position"]
+                 (ReqArg
+                  (\arg opt -> do
+                     pos <- case arg of
+                            "above"  -> return CaptionAbove
+                            "below"  -> return CaptionBelow
+                            _        -> optError $ PandocOptionError $ T.pack
+                               "Argument of --table-caption-position must be above or below"
+                     return opt { optTableCaptionPosition = pos })
+                  "above|below")
+                 "" -- "Specify where table captions go"
 
     , Option "" ["markdown-headings"]
                   (ReqArg

diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs
@@ -41,6 +41,7 @@ import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault),
                             TrackChanges (AcceptChanges),
                             WrapOption (WrapAuto), HTMLMathMethod (PlainMath),
                             ReferenceLocation (EndOfDocument),
+                            CaptionPosition (..),
                             ObfuscationMethod (NoObfuscation),
                             CiteMethod (Citeproc))
 import Text.Pandoc.Class (readFileStrict, fileExists, setVerbosity, report,
@@ -143,6 +144,8 @@ data Opt = Opt
     , optFailIfWarnings        :: Bool    -- ^ Fail on warnings
     , optReferenceLinks        :: Bool    -- ^ Use reference links in writing markdown, rst
     , optReferenceLocation     :: ReferenceLocation -- ^ location for footnotes and link references in markdown output
+    , optFigureCaptionPosition :: CaptionPosition -- ^ position for figure caption
+    , optTableCaptionPosition  :: CaptionPosition -- ^ position for table caption
     , optDpi                   :: Int     -- ^ Dpi
     , optWrap                  :: WrapOption  -- ^ Options for wrapping text
     , optColumns               :: Int     -- ^ Line length in characters
@@ -227,6 +230,8 @@ instance FromJSON Opt where
        <*> o .:? "fail-if-warnings" .!= optFailIfWarnings defaultOpts
        <*> o .:? "reference-links" .!= optReferenceLinks defaultOpts
        <*> o .:? "reference-location" .!= optReferenceLocation defaultOpts
+       <*> o .:? "figure-caption-position" .!= optFigureCaptionPosition defaultOpts
+       <*> o .:? "table-caption-position" .!= optTableCaptionPosition defaultOpts
        <*> o .:? "dpi" .!= optDpi defaultOpts
        <*> o .:? "wrap" .!= optWrap defaultOpts
        <*> o .:? "columns" .!= optColumns defaultOpts
@@ -594,6 +599,10 @@ doOpt (k,v) = do
       parseJSON v >>= \x -> return (\o -> o{ optReferenceLinks = x })
     "reference-location" ->
       parseJSON v >>= \x -> return (\o -> o{ optReferenceLocation = x })
+    "figure-caption-position" ->
+      parseJSON v >>= \x -> return (\o -> o{ optFigureCaptionPosition = x })
+    "table-caption-position" ->
+      parseJSON v >>= \x -> return (\o -> o{ optTableCaptionPosition = x })
     "dpi" ->
       parseJSON v >>= \x -> return (\o -> o{ optDpi = x })
     "wrap" ->
@@ -766,6 +775,8 @@ defaultOpts = Opt
     , optFailIfWarnings        = False
     , optReferenceLinks        = False
     , optReferenceLocation     = EndOfDocument
+    , optFigureCaptionPosition = CaptionBelow
+    , optTableCaptionPosition  = CaptionAbove
     , optDpi                   = 96
     , optWrap                  = WrapAuto
     , optColumns               = 72

diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs
@@ -238,6 +238,8 @@ optToOutputSettings scriptingEngine opts = do
         , writerExtensions       = writerExts
         , writerReferenceLinks   = optReferenceLinks opts
         , writerReferenceLocation = optReferenceLocation opts
+        , writerFigureCaptionPosition = optFigureCaptionPosition opts
+        , writerTableCaptionPosition = optTableCaptionPosition opts
         , writerDpi              = optDpi opts
         , writerWrapText         = optWrap opts
         , writerColumns          = optColumns opts

diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
@@ -28,6 +28,7 @@ module Text.Pandoc.Options ( module Text.Pandoc.Extensions
                            , WriterOptions (..)
                            , TrackChanges (..)
                            , ReferenceLocation (..)
+                           , CaptionPosition (..)
                            , def
                            , isEnabled
                            , defaultMathJaxURL
@@ -286,6 +287,22 @@ instance ToJSON ReferenceLocation where
    toJSON EndOfSection = "end-of-section"
    toJSON EndOfDocument = "end-of-document"
 
+-- | Positions for figure and table captions
+data CaptionPosition = CaptionAbove -- ^ above figure or table
+                     | CaptionBelow -- ^ below figure or table
+                     deriving (Show, Read, Eq, Data, Typeable, Generic)
+
+instance FromJSON CaptionPosition where
+  parseJSON v =
+    case v of
+      String "above" -> return CaptionAbove
+      String "below" -> return CaptionBelow
+      _ -> fail $ "Unknown caption position " <> toStringLazy (encode v)
+
+instance ToJSON CaptionPosition where
+   toJSON CaptionAbove = "above"
+   toJSON CaptionBelow = "below"
+
 -- | Options for writers
 data WriterOptions = WriterOptions
   { writerTemplate          :: Maybe (Template Text) -- ^ Template to use
@@ -323,6 +340,8 @@ data WriterOptions = WriterOptions
   , writerTOCDepth          :: Int            -- ^ Number of levels to include in TOC
   , writerReferenceDoc      :: Maybe FilePath -- ^ Path to reference document if specified
   , writerReferenceLocation :: ReferenceLocation    -- ^ Location of footnotes and references for writing markdown
+  , writerFigureCaptionPosition :: CaptionPosition -- ^ Position of figure caption
+  , writerTableCaptionPosition :: CaptionPosition -- ^ Position of table caption
   , writerSyntaxMap         :: SyntaxMap
   , writerPreferAscii       :: Bool           -- ^ Prefer ASCII representations of characters when possible
   , writerLinkImages        :: Bool           -- ^ Use links rather than embedding ODT images
@@ -362,6 +381,8 @@ instance Default WriterOptions where
                       , writerTOCDepth         = 3
                       , writerReferenceDoc     = Nothing
                       , writerReferenceLocation = EndOfDocument
+                      , writerFigureCaptionPosition = CaptionBelow
+                      , writerTableCaptionPosition  = CaptionAbove
                       , writerSyntaxMap        = defaultSyntaxMap
                       , writerPreferAscii      = False
                       , writerLinkImages       = False

diff --git a/src/Text/Pandoc/Writers/Docx/OpenXML.hs b/src/Text/Pandoc/Writers/Docx/OpenXML.hs
@@ -455,7 +455,10 @@ blockToOpenXML' opts (Figure (ident, _, _) (Caption _ longcapt) body) = do
     (Para xs  : bs) -> imageCaption (fstCaptionPara xs : bs)
     (Plain xs : bs) -> imageCaption (fstCaptionPara xs : bs)
     _               -> imageCaption longcapt
-  wrapBookmark ident $ contentsNode : captionNode
+  wrapBookmark ident $
+    case writerFigureCaptionPosition opts of
+      CaptionBelow -> contentsNode : captionNode
+      CaptionAbove -> captionNode ++ [contentsNode]
 
 toFigureTable :: PandocMonad m
               => WriterOptions -> [Block] -> WS m Content

diff --git a/src/Text/Pandoc/Writers/Docx/Table.hs b/src/Text/Pandoc/Writers/Docx/Table.hs
@@ -46,7 +46,7 @@ import Text.Pandoc.Writers.Docx.Types
       withParaPropM )
 import Control.Monad.Reader (asks)
 import Text.Pandoc.Shared ( tshow, stringify )
-import Text.Pandoc.Options (WriterOptions, isEnabled)
+import Text.Pandoc.Options (WriterOptions(..), isEnabled, CaptionPosition(..))
 import Text.Pandoc.Extensions (Extension(Ext_native_numbering))
 import Text.Pandoc.Error (PandocError(PandocSomeError))
 import Text.Printf (printf)
@@ -134,7 +134,10 @@ tableToOpenXML opts blocksToOpenXML gridTable = do
           : head' ++ mconcat bodies ++ foot'
         )
   modify $ \s -> s { stInTable = False }
-  return $ captionXml ++ [Elem tbl]
+  return $
+    case writerTableCaptionPosition opts of
+      CaptionAbove -> captionXml ++ [Elem tbl]
+      CaptionBelow -> Elem tbl : captionXml
 
 addLabel :: Text -> Text -> Int -> [Block] -> [Block]
 addLabel tableid tablename tablenum bs =

diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
@@ -446,6 +446,8 @@ pandocToHtml opts (Pandoc meta blocks) = do
                   defField "slideous-url" ("slideous" :: Doc Text) .
                   defField "revealjs-url" ("https://unpkg.com/reveal.js@^4/" :: Doc Text) $
                   defField "s5-url" ("s5/default" :: Doc Text) .
+                  defField "table-caption-below"
+                     (writerTableCaptionPosition opts == CaptionBelow) .
                   defField "html5" (stHtml5 st) $
                   metadata
   return (thebody, context)
@@ -1056,24 +1058,26 @@ blockToHtmlInner opts (Figure attrs (Caption _ captBody)  body) = do
 
   figAttrs <- attrsToHtml opts attrs
   contents <- blockListToHtml opts body
-  figCaption <- if null captBody
-                then return mempty
-                else do
-                  captCont <- blockListToHtml opts captBody
-                  return . mconcat $
+  captCont <- blockListToHtml opts captBody
+  let figCaption = mconcat $
                     if html5
                     then let fcattr = if captionIsAlt captBody body
                                       then H5.customAttribute
                                            (textTag "aria-hidden")
                                            (toValue @Text "true")
                                       else mempty
-                         in [ H5.figcaption ! fcattr $ captCont, nl ]
-                    else [ (H.div ! A.class_ "figcaption") captCont, nl ]
+                         in [ H5.figcaption ! fcattr $ captCont ]
+                    else [ (H.div ! A.class_ "figcaption") captCont ]
+  let innards = mconcat $
+                if null captBody
+                   then [nl, contents, nl]
+                   else case writerFigureCaptionPosition opts of
+                         CaptionAbove -> [nl, figCaption, nl, contents, nl]
+                         CaptionBelow -> [nl, contents, nl, figCaption, nl]
   return $
     if html5
-    then foldl (!) H5.figure figAttrs $ mconcat [nl, contents, nl, figCaption]
-    else foldl (!) H.div (A.class_ "float" : figAttrs) $ mconcat
-           [nl, contents, nl, figCaption]
+    then foldl (!) H5.figure figAttrs innards
+    else foldl (!) H.div (A.class_ "float" : figAttrs) innards
  where
   captionIsAlt capt [Plain [Image (_, _, kv) desc _]] =
     let alt = fromMaybe (stringify desc) $ lookup "alt" kv

diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -605,6 +605,7 @@ blockToLaTeX (Table attr blkCapt specs thead tbodies tfoot) =
   tableToLaTeX inlineListToLaTeX blockListToLaTeX
                (Ann.toTable attr blkCapt specs thead tbodies tfoot)
 blockToLaTeX (Figure (ident, _, _) captnode body) = do
+  opts <- gets stOptions
   (capt, captForLof, footnotes) <- getCaption inlineListToLaTeX True captnode
   lab <- labelFor ident
   let caption = "\\caption" <> captForLof <> braces capt <> lab
@@ -615,7 +616,10 @@ blockToLaTeX (Figure (ident, _, _) captnode body) = do
     [b] -> blockToLaTeX b
     bs  -> mconcat . intersperse (cr <> "\\hfill") <$>
            mapM (toSubfigure (length bs)) bs
-  let innards = "\\centering" $$ contents $$ caption <> cr
+  let innards = "\\centering" $$
+                (case writerFigureCaptionPosition opts of
+                  CaptionBelow -> contents $$ caption
+                  CaptionAbove -> caption $$ contents) <> cr
   modify $ \st ->
     st{ stInFigure = isSubfigure
       , stSubfigure = stSubfigure st || isSubfigure

diff --git a/src/Text/Pandoc/Writers/LaTeX/Table.hs b/src/Text/Pandoc/Writers/LaTeX/Table.hs
@@ -33,20 +33,26 @@ import Text.Pandoc.Writers.LaTeX.Caption (getCaption)
 import Text.Pandoc.Writers.LaTeX.Notes (notesToLaTeX)
 import Text.Pandoc.Writers.LaTeX.Types
   ( LW, WriterState (stBeamer, stExternalNotes, stInMinipage, stMultiRow
-                    , stNotes, stTable) )
+                    , stNotes, stTable, stOptions) )
 import Text.Pandoc.Writers.LaTeX.Util (labelFor)
 import Text.Printf (printf)
 import qualified Text.Pandoc.Builder as B
 import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
+import Text.Pandoc.Options (CaptionPosition(..), WriterOptions(..))
 
 tableToLaTeX :: PandocMonad m
              => ([Inline] -> LW m (Doc Text))
              -> ([Block]  -> LW m (Doc Text))
              -> Ann.Table
              -> LW m (Doc Text)
 tableToLaTeX inlnsToLaTeX blksToLaTeX tbl = do
+  opts <- gets stOptions
   let (Ann.Table (ident, _, _) caption specs thead tbodies tfoot) = tbl
   CaptionDocs capt captNotes <- captionToLaTeX inlnsToLaTeX caption ident
+  let hasTopCaption = not (isEmpty capt) &&
+                        writerTableCaptionPosition opts == CaptionAbove
+  let hasBottomCaption = not (isEmpty capt) &&
+                          writerTableCaptionPosition opts == CaptionBelow
   let isSimpleTable =
         all ((== ColWidthDefault) . snd) specs &&
         all (all isSimpleCell)
@@ -64,24 +70,31 @@ tableToLaTeX inlnsToLaTeX blksToLaTeX tbl = do
   -- duplicate the header rows for this.
   head' <- do
     let mkHead = headToLaTeX blksToLaTeX isSimpleTable colCount
-    case (not $ isEmpty capt, not $ isEmptyHead thead) of
-      (False, False) -> return "\\toprule\\noalign{}"
-      (False, True)  -> mkHead thead
-      (True, False)  -> return (capt $$ "\\toprule\\noalign{}" $$ "\\endfirsthead")
-      (True, True)   -> do
+    case (hasTopCaption, isEmptyHead thead) of
+      (False, True) -> return "\\toprule\\noalign{}"
+      (False, False)  -> mkHead thead
+      (True, True)  -> return (capt <> "\\tabularnewline"
+                                $$ "\\toprule\\noalign{}"
+                                $$ "\\endfirsthead")
+      (True, False)   -> do
         -- avoid duplicate notes in head and firsthead:
         firsthead <- mkHead thead
         repeated  <- mkHead (walk removeNote thead)
-        return $ capt $$ firsthead $$ "\\endfirsthead" $$ repeated
+        return $ capt <> "\\tabularnewline"
+                 $$ firsthead
+                 $$ "\\endfirsthead"
+                 $$ repeated
   rows' <- mapM (rowToLaTeX blksToLaTeX isSimpleTable colCount BodyCell) $
                 mconcat (map bodyRows tbodies)
-  foot' <- if isEmptyFoot tfoot
-           then pure empty
-           else do
-             lastfoot <- mapM
-                (rowToLaTeX blksToLaTeX isSimpleTable colCount BodyCell) $
-                footRows tfoot
-             pure $ "\\midrule\\noalign{}" $$ vcat lastfoot
+  lastfoot <- mapM (rowToLaTeX blksToLaTeX isSimpleTable colCount BodyCell) $
+                    footRows tfoot
+  let foot' = (if isEmptyFoot tfoot
+                  then mempty
+                  else "\\midrule\\noalign{}" $$ vcat lastfoot)
+              $$ "\\bottomrule\\noalign{}"
+              $$ (if hasBottomCaption
+                     then "\\tabularnewline" $$ capt
+                     else mempty)
   modify $ \s -> s{ stTable = True }
   notes <- notesToLaTeX <$> gets stNotes
   beamer <- gets stBeamer
@@ -99,10 +112,8 @@ tableToLaTeX inlnsToLaTeX blksToLaTeX tbl = do
        (if beamer
              then [ vcat rows'
                   , foot'
-                  , "\\bottomrule\\noalign{}"
                   ]
              else [ foot'
-                  , "\\bottomrule\\noalign{}"
                   , "\\endlastfoot"
                   ,  vcat rows'
                   ])
@@ -192,7 +203,6 @@ captionToLaTeX inlnsToLaTeX caption ident = do
                        else "\\caption" <> captForLot <>
                             braces captionText
                             <> label
-                            <> "\\tabularnewline"
     }
 
 type BlocksWriter m = [Block] -> LW m (Doc Text)