Support complex figures.

cabal.project

@@ -16,3 +16,13 @@ source-repository-package
   type: git
   location: https://github.com/jgm/texmath
   tag: 1a77db688bd3285228299e5aeefc93d6c0d8c0b9
+
+source-repository-package
+  type: git
+  location: https://github.com/tarleb/pandoc-types
+  tag: f84b7359765a2798f22efe4e9457538cda7a8d4a
+
+source-repository-package
+  type: git
+  location: https://github.com/pandoc/pandoc-lua-marshal
+  tag: a2a97e2af78326ea7841101d4ef56e74426b66c4

data/templates/default.latex

@@ -293,6 +293,9 @@ $if(numbersections)$
 $else$
 \setcounter{secnumdepth}{-\maxdimen} % remove section numbering
 $endif$
+$if(subfigure)$
+\usepackage{subcaption}
+$endif$
 $if(beamer)$
 $else$
 $if(block-headings)$

pandoc-lua-engine/src/Text/Pandoc/Lua/Writer/Classic.hs

@@ -157,6 +157,12 @@ blockToCustom (CodeBlock attr str) =
 blockToCustom (BlockQuote blocks) =
   invoke "BlockQuote" (Stringify blocks)
 
+blockToCustom (Figure attr (Caption _ cbody) content) =
+  invoke "Figure"
+    (Stringify cbody)
+    (Stringify content)
+    (attrToMap attr)
+
 blockToCustom (Table _ blkCapt specs thead tbody tfoot) =
   let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
       aligns' = map show aligns

pandoc-lua-engine/test/sample.lua

@@ -295,6 +295,12 @@ function CaptionedImage(src, tit, caption, attr)
   end
 end
 
+function Figure(caption, contents, attr)
+  return '<figure' .. attributes(attr) .. '>\n' .. contents ..
+    '\n<figcaption>' .. caption .. '</figcaption>\n' ..
+    '</figure>'
+end
+
 -- Caption is a string, aligns is an array of strings,
 -- widths is an array of floats, headers is an array of
 -- strings, rows is an array of arrays of strings.

pandoc-lua-engine/test/writer.custom

@@ -737,7 +737,8 @@ So is &lsquo;pine.&rsquo;</p>
 <p>From &ldquo;Voyage dans la Lune&rdquo; by Georges Melies (1902):</p>
 
 <figure>
-<img src="lalune.jpg" id="" alt="lalune"/><figcaption>lalune</figcaption>
+<img src="lalune.jpg" title="Voyage dans la Lune"/>
+<figcaption>lalune</figcaption>
 </figure>
 
 <p>Here is a movie <img src="movie.jpg" title=""/> icon.</p>

src/Text/Pandoc/Readers/HTML.hs

@@ -25,7 +25,7 @@ module Text.Pandoc.Readers.HTML ( readHtml
                                 ) where
 
 import Control.Applicative ((<|>))
-import Control.Monad (guard, msum, mzero, unless, void)
+import Control.Monad (guard, mzero, unless, void)
 import Control.Monad.Except (throwError, catchError)
 import Control.Monad.Reader (ask, asks, lift, local, runReaderT)
 import Data.Text.Encoding.Base64 (encodeBase64)
@@ -36,6 +36,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)
@@ -63,8 +64,8 @@ import Text.Pandoc.Options (
     extensionEnabled)
 import Text.Pandoc.Parsing hiding ((<|>))
 import Text.Pandoc.Shared (
-    addMetaField, blocksToInlines', extractSpaces,
-    htmlSpanLikeElements, renderTags', safeRead, tshow, formatCode)
+    addMetaField, extractSpaces, htmlSpanLikeElements, renderTags',
+    safeRead, tshow, formatCode)
 import Text.Pandoc.URI (escapeURI)
 import Text.Pandoc.Walk
 import Text.TeXMath (readMathML, writeTeX)
@@ -581,24 +582,15 @@ pPara = do
     <|> return (B.para contents)
 
 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
+pFigure = do
+  TagOpen tag attrList <- pSatisfy $ matchTagOpen "figure" []
+  let parser = Left <$> pInTags "figcaption" block <|>
+             (Right <$> block)
+  (captions, rest) <- partitionEithers <$> manyTill parser (pCloses tag <|> eof)
+  -- Concatenate all captions together
+  return $ B.figureWith (toAttr attrList)
+                        (B.simpleCaption (mconcat captions))
+                        (mconcat rest)
 
 pCodeBlock :: PandocMonad m => TagParser m Blocks
 pCodeBlock = try $ do

src/Text/Pandoc/Readers/JATS.hs

@@ -38,7 +38,6 @@ import Text.TeXMath (readMathML, writeTeX)
 import qualified Data.Set as S (fromList, member)
 import Data.Set ((\\))
 import Text.Pandoc.Sources (ToSources(..), sourcesToText)
-import qualified Data.Foldable as DF
 
 type JATS m = StateT JATSState m
 
@@ -232,29 +231,17 @@ parseBlock (Elem e) =
                      terms' <- mapM getInlines terms
                      items' <- mapM getBlocks items
                      return (mconcat $ intersperse (str "; ") terms', items')
-         parseFigure =
-           -- if a simple caption and single graphic, we emit a standard
-           -- implicit figure.  otherwise, we emit a div with the contents
-           case filterChildren (named "graphic") e of
-                  [g] -> do
-                         capt <- case filterChild (named "caption") e of
-                                        Just t  -> mconcat .
-                                          intersperse linebreak <$>
-                                          mapM getInlines
-                                          (filterChildren (const True) t)
-                                        Nothing -> return mempty
-
-                         let figAttributes = DF.toList $
-                              ("alt", ) . strContent <$>
-                              filterChild (named "alt-text") e
-
-                         return $ simpleFigureWith
-                          (attrValue "id" e, [], figAttributes)
-                          capt
-                          (attrValue "href" g)
-                          (attrValue "title" g)
-
-                  _   -> divWith (attrValue "id" e, ["fig"], []) <$> getBlocks e
+         parseFigure = do
+           capt <- case filterChild (named "caption") e of
+                     Just t  -> mconcat . intersperse linebreak <$>
+                                mapM getInlines (filterChildren (const True) t)
+                     Nothing -> return mempty
+           contents <- getBlocks e
+
+           return $ figureWith
+             (attrValue "id" e, [], [])
+             (simpleCaption $ plain capt)
+             contents
          parseFootnoteGroup = do
            forM_ (filterChildren (named "fn") e) $ \fn -> do
              let id' = attrValue "id" fn

src/Text/Pandoc/Readers/LaTeX.hs

@@ -33,6 +33,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)
@@ -1011,8 +1012,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 *> figure')
+   , ("subfigure", env "subfigure" $ skipopts *> tok *> figure')
    , ("center", divWith ("", ["center"], []) <$> env "center" blocks)
    , ("quote", blockQuote <$> env "quote" blocks)
    , ("quotation", blockQuote <$> env "quotation" blocks)
@@ -1164,37 +1165,33 @@ letterContents = do
                   _ -> mempty
   return $ addr <> bs -- sig added by \closing
 
-figure :: PandocMonad m => LP m Blocks
-figure = try $ do
+figure' :: PandocMonad m => LP m Blocks
+figure' = try $ do
   resetCaption
-  blocks >>= addImageCaption
-
-addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
-addImageCaption = walkM go
-  where go p@(Para [Image attr@(_, cls, kvs) _ (src, tit)])
-            | not ("fig:" `T.isPrefixOf` tit) = do
-          st <- getState
-          case sCaption st of
-            Nothing -> return p
-            Just (Caption _mbshort bs) -> do
-              let mblabel = sLastLabel st
-              let attr' = case mblabel of
-                            Just lab -> (lab, cls, kvs)
-                            Nothing  -> attr
-              case attr' of
-                   ("", _, _)    -> return ()
-                   (ident, _, _) -> do
-                      num <- getNextNumber sLastFigureNum
-                      setState
-                        st{ sLastFigureNum = num
-                          , sLabels = M.insert ident
-                                     [Str (renderDottedNum num)] (sLabels st) }
-
-              return $ SimpleFigure attr'
-                       (maybe id removeLabel mblabel
-                         (blocksToInlines bs))
-                       (src, tit)
-        go x = return x
+  innerContent <- many $ try (Left <$> label) <|> (Right <$> block)
+  let content = walk go $ mconcat $ snd $ partitionEithers innerContent
+  st <- getState
+  let caption' = case sCaption st of
+                   Nothing   -> B.emptyCaption
+                   Just capt -> capt
+  let mblabel  = sLastLabel st
+  let attr     = case mblabel of
+                   Just lab -> (lab, [], [])
+                   Nothing  -> nullAttr
+  case mblabel of
+    Nothing   -> pure ()
+    Just lab  -> do
+      num <- getNextNumber sLastFigureNum
+      setState
+        st { sLastFigureNum = num
+           , sLabels = M.insert lab [Str (renderDottedNum num)] (sLabels st)
+           }
+  return $ B.figureWith attr caption' 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
 
 coloredBlock :: PandocMonad m => Text -> LP m Blocks
 coloredBlock stylename = try $ do

src/Text/Pandoc/Readers/LaTeX/Math.hs

@@ -214,7 +214,8 @@ addQed bs =
   qedSign = B.str "\xa0\x25FB"
 
 italicize :: Block -> Block
-italicize x@(Para [Image{}]) = x -- see #6925
+italicize x@(Para [Image{}])  = x -- see #6925
+italicize x@(Plain [Image{}]) = x -- ditto
 italicize (Para ils) = Para [Emph ils]
 italicize (Plain ils) = Plain [Emph ils]
 italicize x = x

src/Text/Pandoc/Readers/Markdown.hs

@@ -1046,7 +1046,7 @@ para = try $ do
           [Image attr figCaption (src, tit)]
             | extensionEnabled Ext_implicit_figures exts
             , not (null figCaption) -> do
-                B.simpleFigureWith attr (B.fromList figCaption) src tit
+                implicitFigure attr (B.fromList figCaption) src tit
 
           _ -> constr inlns
 
@@ -1077,6 +1077,17 @@ para = try $ do
 plain :: PandocMonad m => MarkdownParser m (F Blocks)
 plain = fmap B.plain . trimInlinesF <$> inlines1
 
+implicitFigure :: Attr -> Inlines -> Text -> Text -> Blocks
+implicitFigure (ident, classes, attribs) capt url title =
+  let alt = case "alt" `lookup` attribs of
+              Just alt'       -> B.text alt'
+              _               -> capt
+      attribs' = filter ((/= "alt") . fst) attribs
+      figattr = (ident, mempty, mempty)
+      caption = B.simpleCaption $ B.plain capt
+      figbody = B.plain $ B.imageWith ("", classes, attribs') url title alt
+  in B.figureWith figattr caption figbody
+
 --
 -- raw html
 --

src/Text/Pandoc/Readers/Org/Blocks.hs

@@ -489,15 +489,10 @@ figure = try $ do
        figKeyVals = blockAttrKeyValues figAttrs
        attr       = (figLabel, mempty, figKeyVals)
      in if isFigure
-           then (\c ->
-               B.simpleFigureWith
-                   attr c imgSrc (unstackFig figName)) <$> figCaption
+           then (\c -> B.figureWith attr (B.simpleCaption (B.plain c))
+                       (B.plain $ B.image imgSrc figName mempty))
+                <$> figCaption
            else B.para . B.imageWith attr imgSrc figName <$> figCaption
-   unstackFig :: Text -> Text
-   unstackFig figName =
-       if "fig:" `T.isPrefixOf` figName
-           then T.drop 4 figName
-           else figName
 
 -- | Succeeds if looking at the end of the current paragraph
 endOfParagraph :: Monad m => OrgParser m ()

src/Text/Pandoc/Readers/RST.hs

@@ -19,7 +19,7 @@ import Control.Monad (forM_, guard, liftM, mplus, mzero, when)
 import Control.Monad.Except (throwError)
 import Control.Monad.Identity (Identity (..))
 import Data.Char (isHexDigit, isSpace, toUpper, isAlphaNum)
-import Data.List (deleteFirstsBy, elemIndex, nub, sort, transpose)
+import Data.List (deleteFirstsBy, elemIndex, nub, partition, sort, transpose)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, maybeToList, isJust)
 import Data.Sequence (ViewR (..), viewr)
@@ -730,8 +730,12 @@ directive' = do
         "figure" -> do
            (caption, legend) <- parseFromString' extractCaption body'
            let src = escapeURI $ trim top
-           return $ B.simpleFigureWith
-               (imgAttr "figclass") caption src "" <> legend
+           let (ident, cls, kvs) = imgAttr "class"
+           let (figclasskv, kvs') = partition ((== "figclass") . fst) kvs
+           let figattr = ("", concatMap (T.words . snd) figclasskv, [])
+           let capt = B.caption Nothing (B.plain caption <> legend)
+           return $ B.figureWith figattr capt $
+             B.plain (B.imageWith (ident, cls, kvs') src "" (B.text src))
         "image" -> do
            let src = escapeURI $ trim top
            let alt = B.str $ maybe "image" trim $ lookup "alt" fields

src/Text/Pandoc/Shared.hs

@@ -47,6 +47,7 @@ module Text.Pandoc.Shared (
                      compactify,
                      compactifyDL,
                      linesToPara,
+                     figureDiv,
                      makeSections,
                      uniqueIdent,
                      inlineListToIdentifier,
@@ -90,7 +91,8 @@ import Data.Containers.ListUtils (nubOrd)
 import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum,
                   generalCategory, GeneralCategory(NonSpacingMark,
                   SpacingCombiningMark, EnclosingMark, ConnectorPunctuation))
-import Data.List (find, intercalate, intersperse, sortOn, foldl', groupBy)
+import Data.List (find, foldl', groupBy, intercalate, intersperse,
+                  union, sortOn)
 import qualified Data.Map as M
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Monoid (Any (..))
@@ -427,6 +429,23 @@ combineLines = intercalate [LineBreak]
 linesToPara :: [[Inline]] -> Block
 linesToPara = Para . combineLines
 
+-- | Creates a Div block from figure components. The intended use is in
+-- writers of formats that do not have markup support for figures.
+--
+-- The resulting div is given the class @figure@ and contains the figure
+-- body and the figure caption. The latter is wrapped in a 'Div' of
+-- class @caption@, with the stringified @short-caption@ as attribute.
+figureDiv :: Attr -> Caption -> [Block] -> Block
+figureDiv (ident, classes, kv) (Caption shortcapt longcapt) body =
+  let divattr = ( ident
+              , ["figure"] `union` classes
+              , kv
+              )
+      captkv = maybe mempty (\s -> [("short-caption", stringify s)]) shortcapt
+      capt = [Div ("", ["caption"], captkv) longcapt | not (null longcapt)]
+  in Div divattr (body ++ capt)
+
+-- | Returns 'True' iff the given element is a 'Para'.
 isPara :: Block -> Bool
 isPara (Para _) = True
 isPara _        = False
@@ -830,6 +849,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 =