Use the Figure Block constructor.

* It provides a specific representation for figures in the pandoc's AST.
* It uses the `SimpleFigure` pattern synonym to replace the previous
  construction:

  [Para [Image ("",[],[]) [Str "CAP2"] ("../media/rId25.jpg","fig:")]]

Author: argent0

MANUAL.txt

@@ -3176,6 +3176,17 @@ In the `context` output format this enables the use of [Natural Tables
 Natural tables allow more fine-grained global customization but come
 at a performance penalty compared to extreme tables.
 
+#### Extension: `native_figures` ####
+
+Use pandoc's native `Figure` element for content inside `<figure>` tags, in the
+case of HTML, or `figure` environments, in case of LaTeX. This, in turn, allows
+some writers to produce more accurate representations of figures. It also
+allows the use of the `Figure` element in filters, for custom figure output.
+
+This extension can be enabled/disabled for the following formats:
+
+input formats
+: `latex` `html`
 
 # Pandoc's Markdown
 

cabal.project

@@ -7,3 +7,8 @@ source-repository-package
   type: git
   location: https://github.com/jgm/texmath.git
   tag: 674bcbaec03e5550f155623de6662953bd157625
+
+source-repository-package
+  type: git
+  location: https://github.com/tarleb/pandoc-types
+  tag: b6217365df62716366ab7dac1a7f540486bfafa2

src/Text/Pandoc/Extensions.hs

@@ -105,6 +105,7 @@ data Extension =
     | Ext_mmd_title_block     -- ^ Multimarkdown metadata block
     | Ext_multiline_tables    -- ^ Pandoc-style multiline tables
     | Ext_native_divs             -- ^ Use Div blocks for contents of <div> tags
+    | Ext_native_figures      -- ^ Use Figure blocks for contenst of <figure> tags.
     | Ext_native_spans            -- ^ Use Span inlines for contents of <span>
     | Ext_native_numbering    -- ^ Use output format's native numbering for figures and tables
     | Ext_ntb                 -- ^ ConTeXt Natural Tables
@@ -539,6 +540,7 @@ getAllExtensions f = universalExtensions <> getAll f
   getAll "html"            = autoIdExtensions <>
     extensionsFromList
     [ Ext_native_divs
+    , Ext_native_figures
     , Ext_line_blocks
     , Ext_native_spans
     , Ext_empty_paragraphs
@@ -564,6 +566,7 @@ getAllExtensions f = universalExtensions <> getAll f
     , Ext_raw_tex
     , Ext_task_lists
     , Ext_literate_haskell
+    , Ext_native_figures
     ]
   getAll "beamer"          = getAll "latex"
   getAll "context"         = autoIdExtensions <>

src/Text/Pandoc/Lua/Marshaling/AST.hs

@@ -263,12 +263,14 @@ typeBlock = deftype "Block"
       (pushAttr, \case
           CodeBlock attr _     -> Actual attr
           Div attr _           -> Actual attr
+          Figure attr _ _      -> Actual attr
           Header _ attr _      -> Actual attr
           Table attr _ _ _ _ _ -> Actual attr
           _                    -> Absent)
       (peekAttr, \case
           CodeBlock _ code     -> Actual . flip CodeBlock code
           Div _ blks           -> Actual . flip Div blks
+          Figure _ capt bs     -> Actual . (\attr -> Figure attr capt bs)
           Header lvl _ blks    -> Actual . (\attr -> Header lvl attr blks)
           Table _ c cs h bs f  -> Actual . (\attr -> Table attr c cs h bs f)
           _                    -> const Absent)
@@ -280,9 +282,13 @@ typeBlock = deftype "Block"
           Table attr c cs h _ f -> Actual . (\bs -> Table attr c cs h bs f)
           _                     -> const Absent)
   , possibleProperty "caption" "element caption"
-      (pushCaption, \case {Table _ capt _ _ _ _ -> Actual capt; _ -> Absent})
+      (pushCaption, \case
+          Table _ capt _ _ _ _ -> Actual capt
+          Figure _ capt _      -> Actual capt
+          _ -> Absent)
       (peekCaption, \case
           Table attr _ cs h bs f -> Actual . (\c -> Table attr c cs h bs f)
+          Figure attr _ bs       -> Actual . (\c -> Figure attr c bs)
           _                      -> const Absent)
   , possibleProperty "colspecs" "column alignments and widths"
       (pushPandocList pushColSpec, \case
@@ -359,6 +365,7 @@ getBlockContent = \case
   -- inline content
   BlockQuote blks     -> Actual $ ContentBlocks blks
   Div _ blks          -> Actual $ ContentBlocks blks
+  Figure _ _ blks     -> Actual $ ContentBlocks blks
   -- lines content
   LineBlock lns       -> Actual $ ContentLines lns
   -- list items content
@@ -377,6 +384,7 @@ setBlockContent = \case
   -- block content
   BlockQuote _     -> Actual . BlockQuote . blockContent
   Div attr _       -> Actual . Div attr . blockContent
+  Figure attr c _  -> Actual . Figure attr c . blockContent
   -- lines content
   LineBlock _      -> Actual . LineBlock . lineContent
   -- list items content

src/Text/Pandoc/Lua/Module/Pandoc.hs

@@ -244,6 +244,14 @@ blockConstructors =
     <#> optAttrParam
     =#> blockResult "Div element"
 
+  , defun "Figure"
+    ### liftPure3 (\capt content mattr ->
+                     Figure (fromMaybe nullAttr mattr) capt content)
+    <#> parameter peekCaption "Caption" "caption" "figure caption"
+    <#> parameter peekBlocksFuzzy "Blocks" "content" "figure content"
+    <#> optAttrParam
+    =#> blockResult "Figure element"
+
   , defun "Header"
     ### liftPure3 (\lvl content mattr ->
                      Header lvl (fromMaybe nullAttr mattr) content)

src/Text/Pandoc/Readers/HTML.hs

@@ -35,6 +35,7 @@ import Data.List.Split (splitWhen)
 import Data.List (foldl')
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isJust, isNothing)
+import Data.Either (partitionEithers)
 import Data.Monoid (First (..))
 import qualified Data.Set as Set
 import Data.Text (Text)
@@ -57,7 +58,8 @@ import Text.Pandoc.Error
 import Text.Pandoc.Logging
 import Text.Pandoc.Options (
     Extension (Ext_epub_html_exts, Ext_empty_paragraphs, Ext_native_divs,
-               Ext_native_spans, Ext_raw_html, Ext_line_blocks, Ext_raw_tex),
+               Ext_native_spans, Ext_raw_html, Ext_line_blocks, Ext_raw_tex,
+               Ext_native_figures),
     ReaderOptions (readerExtensions, readerStripComments),
     extensionEnabled)
 import Text.Pandoc.Parsing hiding ((<|>))
@@ -536,23 +538,40 @@ pPara = do
 
 pFigure :: PandocMonad m => TagParser m Blocks
 pFigure = try $ do
-  TagOpen _ _ <- pSatisfy (matchTagOpen "figure" [])
-  skipMany pBlank
-  let pImg  = (\x -> (Just x, Nothing)) <$>
-               (pInTag TagsOmittable "p" pImage <* skipMany pBlank)
-      pCapt = (\x -> (Nothing, Just x)) <$> do
-                bs <- pInTags "figcaption" block
-                return $ blocksToInlines' $ B.toList bs
-      pSkip = (Nothing, Nothing) <$ pSatisfy (not . matchTagClose "figure")
-  res <- many (pImg <|> pCapt <|> pSkip)
-  let mbimg = msum $ map fst res
-  let mbcap = msum $ map snd res
-  TagClose _ <- pSatisfy (matchTagClose "figure")
-  let caption = fromMaybe mempty mbcap
-  case B.toList <$> mbimg of
-       Just [Image attr _ (url, tit)] ->
-         return $ B.simpleFigureWith attr caption url tit
-       _ -> mzero
+  has_native_figures <-
+    extensionEnabled Ext_native_figures <$> getOption readerExtensions
+  if has_native_figures
+     then pNativeFigure
+     else try $ do
+        TagOpen _ _ <- pSatisfy (matchTagOpen "figure" [])
+        skipMany pBlank
+        let pImg  = (\x -> (Just x, Nothing)) <$>
+                     (pInTag TagsOmittable "p" pImage <* skipMany pBlank)
+            pCapt = (\x -> (Nothing, Just x)) <$> do
+                      bs <- pInTags "figcaption" block
+                      return $ blocksToInlines' $ B.toList bs
+            pSkip = (Nothing, Nothing) <$ pSatisfy (not . matchTagClose "figure")
+        res <- many (pImg <|> pCapt <|> pSkip)
+        -- Takes the first image and the first caption, if any, drop the rest.
+        let mbimg = msum $ map fst res
+        let mbcap = msum $ map snd res -- mbcap :: Maybe Inlines
+        TagClose _ <- pSatisfy (matchTagClose "figure")
+        let caption = fromMaybe mempty mbcap
+        -- only process one image
+        case B.toList <$> mbimg of
+             Just [Image attr _ (url, tit)] ->
+               return $ B.simpleFigureWith attr caption url tit
+             _ -> mzero
+
+pNativeFigure :: PandocMonad m => TagParser m Blocks
+pNativeFigure = try $ do
+  TagOpen tag attrList <- lookAhead $ pSatisfy (matchTagOpen "figure" [])
+  --let (ident, classes, kvs) = toAttr attr
+  contents <- pInTags tag (many $ Left <$> pInTags "figcaption" block <|> (Right <$> block))
+
+  let (captions, rest) = partitionEithers contents
+  -- I should capture the caption
+  return $ B.figureWith (toAttr attrList) (Caption Nothing (B.toList (mconcat captions))) $ mconcat rest
 
 pCodeBlock :: PandocMonad m => TagParser m Blocks
 pCodeBlock = try $ do

src/Text/Pandoc/Readers/LaTeX.hs

@@ -32,6 +32,7 @@ import Data.Maybe (fromMaybe, maybeToList)
 import qualified Data.Set as Set
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Either (partitionEithers)
 import Skylighting (defaultSyntaxMap)
 import System.FilePath (addExtension, replaceExtension, takeExtension)
 import Text.Collate.Lang (renderLang)
@@ -935,8 +936,8 @@ environments = M.union (tableEnvironments blocks inline) $
    , ("letter", env "letter" letterContents)
    , ("minipage", env "minipage" $
           skipopts *> spaces *> optional braced *> spaces *> blocks)
-   , ("figure", env "figure" $ skipopts *> figure)
-   , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
+   , ("figure", env "figure" $ skipopts *> Text.Pandoc.Readers.LaTeX.figure)
+   , ("subfigure", env "subfigure" $ skipopts *> tok *> Text.Pandoc.Readers.LaTeX.figure)
    , ("center", divWith ("", ["center"], []) <$> env "center" blocks)
    , ("quote", blockQuote <$> env "quote" blocks)
    , ("quotation", blockQuote <$> env "quotation" blocks)
@@ -1089,9 +1090,33 @@ letterContents = do
   return $ addr <> bs -- sig added by \closing
 
 figure :: PandocMonad m => LP m Blocks
-figure = try $ do
+figure = do
+  has_native_figures <-
+    extensionEnabled Ext_native_figures <$> getOption readerExtensions
+  if has_native_figures
+     then nativeFigure
+     else try $ do
+            resetCaption
+            blocks >>= addImageCaption
+
+nativeFigure :: PandocMonad m => LP m Blocks
+nativeFigure = try $ do
   resetCaption
-  blocks >>= addImageCaption
+  innerContent <- many $ try (Left <$> label) <|> (Right <$> block)
+  let content = walk go $ mconcat $ snd $ partitionEithers innerContent
+  labelResult <- sLastLabel <$> getState
+  let attr = case labelResult of
+                Just lab -> (lab, [], [])
+                _ -> nullAttr
+  captResult <- sCaption <$> getState
+  case captResult of
+    Nothing -> return $ B.figureWith attr (Caption Nothing []) content
+    Just capt -> return $ B.figureWith attr (B.caption Nothing $ B.plain capt) content
+
+  where
+  -- Remove the `Image` caption b.c. it's on the `Figure`
+  go (Para [Image attr _ target]) = Plain [Image attr [] target]
+  go x = x
 
 addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
 addImageCaption = walkM go

src/Text/Pandoc/Shared.hs

@@ -921,6 +921,7 @@ blockToInlines (Table _ _ _ (TableHead _ hbd) bodies (TableFoot _ fbd)) =
     unTableBodies = concatMap unTableBody
 blockToInlines (Div _ blks) = blocksToInlines' blks
 blockToInlines Null = mempty
+blockToInlines (Figure _ _ body) = blocksToInlines' body
 
 blocksToInlinesWithSep :: Inlines -> [Block] -> Inlines
 blocksToInlinesWithSep sep =

src/Text/Pandoc/Writers/AsciiDoc.hs

@@ -186,7 +186,7 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do
   return $ identifier $$
            nowrap (text (replicate (level + 1) '=') <> space <> contents) <>
            blankline
-
+blockToAsciiDoc opts (Figure attr _ body) = blockToAsciiDoc opts $ Div attr body
 blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ flush (
   if null classes
      then "...." $$ literal str $$ "...."

src/Text/Pandoc/Writers/ConTeXt.hs

@@ -267,6 +267,7 @@ blockToConTeXt (Table _ blkCapt specs thead tbody tfoot) = do
         then "location=none"
         else "title=" <> braces captionText
       ) $$ body $$ "\\stopplacetable" <> blankline
+blockToConTeXt (Figure attr _ body) = blockToConTeXt $ Div attr body
 
 tableToConTeXt :: PandocMonad m
                => Tabl -> Doc Text -> [Doc Text] -> WM m (Doc Text)