diff options
Diffstat (limited to 'src/Text')
37 files changed, 618 insertions, 373 deletions
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index f033b8e92..3083ffcd3 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/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 diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs index 643c92242..fbf46a339 100644 --- a/src/Text/Pandoc/Readers/JATS.hs +++ b/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 diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 9ee3dea21..39386843f 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/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 diff --git a/src/Text/Pandoc/Readers/LaTeX/Math.hs b/src/Text/Pandoc/Readers/LaTeX/Math.hs index 6eb57c178..7b0437109 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Math.hs +++ b/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 diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index d3a236571..776eecd62 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/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 -- diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index c8e75e383..4dcf56b22 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/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 () diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index d2a3b8db0..560e35f40 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/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 diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index b021db3c3..bbd0f3d18 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/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 = diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 7d378bbbf..29b6ff971 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Writers.AsciiDoc @@ -29,6 +30,7 @@ import Data.Maybe (fromMaybe, isJust) import qualified Data.Set as Set import qualified Data.Text as T import Data.Text (Text) +import System.FilePath (dropExtension) import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.ImageSize @@ -152,10 +154,6 @@ blockToAsciiDoc opts (Div (id',"section":_,_) blockToAsciiDoc opts (Plain inlines) = do contents <- inlineListToAsciiDoc opts inlines return $ contents <> blankline -blockToAsciiDoc opts (SimpleFigure attr alternate (src, tit)) - -- image::images/logo.png[Company logo, title="blah"] - = (\args -> "image::" <> args <> blankline) <$> - imageArguments opts attr alternate src tit blockToAsciiDoc opts (Para inlines) = do contents <- inlineListToAsciiDoc opts inlines -- escape if para starts with ordered list marker @@ -189,7 +187,23 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do return $ identifier $$ nowrap (text (replicate (level + 1) '=') <> space <> contents) <> blankline - +blockToAsciiDoc opts (Figure attr (Caption _ longcapt) body) = do + -- Images in figures all get rendered as individual block-level images + -- with the given caption. Non-image elements are rendered unchanged. + capt <- inlineListToAsciiDoc opts (blocksToInlines longcapt) + let renderFigElement = \case + Plain [Image imgAttr alternate (src, tit)] -> do + args <- imageArguments opts imgAttr alternate src tit + let figAttributes = case attr of + ("", _, _) -> empty + (ident, _, _) -> literal $ "[#" <> ident <> "]" + -- .Figure caption + -- image::images/logo.png[Company logo, title="blah"] + return $ "." <> nowrap capt $$ + figAttributes $$ + "image::" <> args <> blankline + blk -> blockToAsciiDoc opts blk + vcat <$> mapM renderFigElement body blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ flush ( if null classes then "...." $$ literal str $$ "...." @@ -615,7 +629,7 @@ imageArguments :: PandocMonad m => WriterOptions -> ADW m (Doc Text) imageArguments opts attr altText src title = do let txt = if null altText || (altText == [Str ""]) - then [Str "image"] + then [Str . T.pack . dropExtension $ T.unpack src] else altText linktext <- inlineListToAsciiDoc opts txt let linktitle = if T.null title diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 858ad8761..b5543b036 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -21,6 +21,7 @@ import Data.Char (ord, isDigit) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Maybe (isNothing, mapMaybe, catMaybes) +import Data.Monoid (Any (Any, getAny)) import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) @@ -186,14 +187,6 @@ blockToConTeXt (Div attr@(_,"section":_,_) innerContents <- blockListToConTeXt xs return $ header' $$ innerContents $$ footer' blockToConTeXt (Plain lst) = inlineListToConTeXt lst -blockToConTeXt (SimpleFigure attr txt (src, _)) = do - capt <- inlineListToConTeXt txt - img <- inlineToConTeXt (Image attr txt (src, "")) - let (ident, _, _) = attr - label = if T.null ident - then empty - else "[]" <> brackets (literal $ toLabel ident) - return $ blankline $$ "\\placefigure" <> label <> braces capt <> img <> blankline blockToConTeXt (Para lst) = do contents <- inlineListToConTeXt lst return $ contents <> blankline @@ -293,6 +286,24 @@ blockToConTeXt (Header level attr lst) = sectionHeader attr level lst NonSectionHeading blockToConTeXt (Table attr caption colspecs thead tbody tfoot) = tableToConTeXt (Ann.toTable attr caption colspecs thead tbody tfoot) +blockToConTeXt (Figure (ident, _, _) (Caption cshort clong) body) = do + title <- inlineListToConTeXt (blocksToInlines clong) + list <- maybe (pure empty) inlineListToConTeXt cshort + content <- blockListToConTeXt body + + let options = + ["reference=" <> literal (toLabel ident) | not (T.null ident)] + ++ ["title=" <> braces title | not (isEmpty title)] + ++ ["list=" <> braces list | not (isEmpty list)] + let hasSubfigures = getAny $ + query (Any . \case {Figure {} -> True; _ -> False}) body + return + $ "\\startplacefigure" <> brackets (mconcat $ intersperse "," options) + $$ (if hasSubfigures then "\\startfloatcombination" else empty) + $$ content + $$ (if hasSubfigures then "\\stopfloatcombination" else empty) + $$ "\\stopplacefigure" + $$ blankline tableToConTeXt :: PandocMonad m => Ann.Table -> WM m (Doc Text) tableToConTeXt (Ann.Table attr caption colspecs thead tbodies tfoot) = do diff --git a/src/Text/Pandoc/Writers/DocBook.hs b/src/Text/Pandoc/Writers/DocBook.hs index e9eceb60c..3f6d3cfda 100644 --- a/src/Text/Pandoc/Writers/DocBook.hs +++ b/src/Text/Pandoc/Writers/DocBook.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {- | @@ -15,7 +16,7 @@ module Text.Pandoc.Writers.DocBook ( writeDocBook4, writeDocBook5 ) where import Control.Monad.Reader import Data.Generics (everywhere, mkT) import Data.Maybe (isNothing, maybeToList) -import Data.Monoid (Any (..)) +import Data.Monoid (All (..), Any (..)) import Data.Text (Text) import qualified Data.Text as T import qualified Text.Pandoc.Builder as B @@ -192,7 +193,7 @@ blockToDocBook opts (Div (id',"section":_,_) (Header lvl (_,classes,attrs) ils : -- Populate miscAttr with Header.Attr.attributes, filtering out non-valid DocBook section attributes, id, and xml:id -- Also enrich the role attribute with certain class tokens - miscAttr = enrichRole (filter (isSectionAttr version) attrs) classes + miscAttr = enrichRole (filter (isSectionAttr version) attrs) classes attribs = nsAttr <> idAttr <> miscAttr title' <- inlinesToDocBook opts ils contents <- blocksToDocBook opts bs @@ -234,18 +235,6 @@ blockToDocBook _ h@Header{} = do report $ BlockNotRendered h return empty blockToDocBook opts (Plain lst) = inlinesToDocBook opts lst --- title beginning with fig: indicates that the image is a figure -blockToDocBook opts (SimpleFigure attr txt (src, _)) = do - alt <- inlinesToDocBook opts txt - let capt = if null txt - then empty - else inTagsSimple "title" alt - return $ inTagsIndented "figure" $ - capt $$ - inTagsIndented "mediaobject" ( - inTagsIndented "imageobject" - (imageToDocBook opts attr src) $$ - inTagsSimple "textobject" (inTagsSimple "phrase" alt)) blockToDocBook opts (Para lst) | hasLineBreaks lst = flush . nowrap . inTagsSimple "literallayout" <$> inlinesToDocBook opts lst @@ -324,6 +313,36 @@ blockToDocBook opts (Table _ blkCapt specs thead tbody tfoot) = do return $ inTagsIndented tableType $ captionDoc $$ inTags True "tgroup" [("cols", tshow (length aligns))] ( coltags $$ head' $$ body') +blockToDocBook opts (Figure attr capt@(Caption _ caption) body) = do + -- TODO: probably better to handle nested figures as mediaobject + let isAcceptable = \case + Table {} -> All False + Figure {} -> All False + _ -> All True + if not . getAll $ query isAcceptable body + -- Fallback to a div if the content cannot be included in a figure + then blockToDocBook opts $ figureDiv attr capt body + else do + title <- inlinesToDocBook opts (blocksToInlines caption) + let toMediaobject = \case + Plain [Image imgAttr inlns (src, _)] -> do + alt <- inlinesToDocBook opts inlns + pure $ inTagsIndented "mediaobject" ( + inTagsIndented "imageobject" + (imageToDocBook opts imgAttr src) $$ + if isEmpty alt + then empty + else inTagsSimple "textobject" (inTagsSimple "phrase" alt)) + _ -> ask >>= \case + DocBook4 -> pure mempty -- docbook4 requires media + DocBook5 -> blocksToDocBook opts body + mediaobjects <- mapM toMediaobject body + return $ + if isEmpty $ mconcat mediaobjects + then mempty -- figures must have at least some content + else inTagsIndented "figure" $ + inTagsSimple "title" title $$ + mconcat mediaobjects hasLineBreaks :: [Inline] -> Bool hasLineBreaks = getAny . query isLineBreak . walk removeNote diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 1f69d2fa9..8970d75b8 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Writers.Docx Copyright : Copyright (C) 2012-2023 John MacFarlane @@ -63,7 +64,7 @@ import Text.Pandoc.Logging import Text.Pandoc.MIME (extensionFromMimeType, getMimeType, getMimeTypeDef) import Text.Pandoc.Options import Text.Pandoc.Writers.Docx.StyleMap -import Text.Pandoc.Writers.Docx.Table +import Text.Pandoc.Writers.Docx.Table as Table import Text.Pandoc.Writers.Docx.Types import Text.Pandoc.Shared import Text.Pandoc.Walk @@ -890,38 +891,6 @@ blockToOpenXML' opts (Plain lst) = do if isInTable || isInList then withParaProp prop block else block --- title beginning with fig: indicates that the image is a figure -blockToOpenXML' opts (SimpleFigure attr@(imgident, _, _) alt (src, tit)) = do - setFirstPara - fignum <- gets stNextFigureNum - unless (null alt) $ modify $ \st -> st{ stNextFigureNum = fignum + 1 } - let refid = if T.null imgident - then "ref_fig" <> tshow fignum - else "ref_" <> imgident - 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 <- if null alt - then return [] - else withParaPropM (pStyleM "Image Caption") - $ blockToOpenXML opts - $ Para - $ if isEnabled Ext_native_numbering opts - then Span (refid,[],[]) - [Str (figname <> "\160"), - RawInline (Format "openxml") - ("<w:fldSimple w:instr=\"SEQ Figure" - <> " \\* ARABIC \"><w:r><w:t>" - <> tshow fignum - <> "</w:t></w:r></w:fldSimple>")] : Str ": " : alt - else alt - return $ - Elem (mknode "w:p" [] (map Elem paraProps ++ contents)) - : captionNode blockToOpenXML' opts (Para lst) | null lst && not (isEnabled Ext_empty_paragraphs opts) = return [] | otherwise = do @@ -990,6 +959,99 @@ blockToOpenXML' opts (DefinitionList items) = do l <- concat `fmap` mapM (definitionListItemToOpenXML opts) items setFirstPara return l +blockToOpenXML' opts (Figure (ident, _, _) (Caption _ longcapt) body) = do + setFirstPara + fignum <- gets stNextFigureNum + unless (null longcapt) $ modify $ \st -> st{ stNextFigureNum = fignum + 1 } + let refid = if T.null ident + then "ref_fig" <> tshow fignum + else "ref_" <> ident + figname <- translateTerm Term.Figure + prop <- pStyleM $ + if null longcapt + then "Figure" + else "Captioned Figure" + paraProps <- local + (\env -> env { envParaProperties = EnvProps (Just prop) [] <> + envParaProperties env }) + (getParaProps False) + + -- Figure contents + let simpleImage x = do + imgXML <- inlineToOpenXML opts x + pure $ Elem (mknode "w:p" [] (map Elem paraProps ++ imgXML)) + contentsNode <- case body of + [Plain [img@Image {}]] -> simpleImage img + [Para [img@Image {}]] -> simpleImage img + _ -> toFigureTable opts body + -- Caption + let imageCaption = withParaPropM (pStyleM "Image Caption") + . blocksToOpenXML opts + let fstCaptionPara inlns = Para $ + if not $ isEnabled Ext_native_numbering opts + then inlns + else let rawfld = RawInline (Format "openxml") $ mconcat + [ "<w:fldSimple w:instr=\"SEQ Figure" + , " \\* ARABIC \"><w:r><w:t>" + , tshow fignum + , "</w:t></w:r></w:fldSimple>" + ] + in Span (refid,[],[]) [Str (figname <> "\160") , rawfld] + : Str ": " : inlns + captionNode <- case longcapt of + [] -> return [] + (Para xs : bs) -> imageCaption (fstCaptionPara xs : bs) + (Plain xs : bs) -> imageCaption (fstCaptionPara xs : bs) + _ -> imageCaption longcapt + return $ contentsNode : captionNode + +toFigureTable :: PandocMonad m + => WriterOptions -> [Block] -> WS m Content +toFigureTable opts blks = do + modify $ \s -> s { stInTable = True } + let ncols = length blks + let textwidth = 7920 -- 5.5 in in twips (1 twip == 1/20 pt) + let cellfrac = 1 / fromIntegral ncols + let colwidth = tshow @Integer $ floor (textwidth * cellfrac) -- twips + let gridCols = replicate ncols $ mknode "w:gridCol" [("w:w", colwidth)] () + let scaleImage = \case + Image attr@(ident, classes, attribs) alt tgt -> + let dimWidth = case dimension Width attr of + Nothing -> Percent (cellfrac * 100) + Just d -> scaleDimension cellfrac d + dimHeight = scaleDimension cellfrac <$> dimension Height attr + attribs' = (tshow Width, tshow dimWidth) : + (case dimHeight of + Nothing -> id + Just h -> ((tshow Height, tshow h) :)) + [ (k, v) | (k, v) <- attribs + , k `notElem` ["width", "height"] + ] + in Image (ident, classes, attribs') alt tgt + x -> x + let blockToCell = Table.OOXMLCell nullAttr AlignCenter 1 1 . (:[]) + . walk scaleImage + tblBody <- Table.rowToOpenXML (blocksToOpenXML opts) . + Table.OOXMLRow Table.BodyRow nullAttr $ + map blockToCell blks + let tbl = mknode "w:tbl" [] + ( mknode "w:tblPr" [] + ( mknode "w:tblStyle" [("w:val","FigureTable")] () : + mknode "w:tblW" [ ("w:type", "auto"), ("w:w", "0") ] () : + mknode "w:tblLook" [ ("w:firstRow", "0") + , ("w:lastRow", "0") + , ("w:firstColumn", "0") + , ("w:lastColumn", "0") + ] () : + mknode "w:jc" [("w:val","center")] () : + [] + ) + : mknode "w:tblGrid" [] gridCols + : [tblBody] + ) + modify $ \s -> s { stInTable = False } + return $ Elem tbl + definitionListItemToOpenXML :: (PandocMonad m) => WriterOptions -> ([Inline],[[Block]]) diff --git a/src/Text/Pandoc/Writers/Docx/Table.hs b/src/Text/Pandoc/Writers/Docx/Table.hs index 5bce9d257..c8d3fc104 100644 --- a/src/Text/Pandoc/Writers/Docx/Table.hs +++ b/src/Text/Pandoc/Writers/Docx/Table.hs @@ -11,6 +11,10 @@ Conversion of table blocks to docx. -} module Text.Pandoc.Writers.Docx.Table ( tableToOpenXML + , rowToOpenXML + , OOXMLRow (..) + , OOXMLCell (..) + , RowType (..) ) where import Control.Monad.State.Strict ( modify, gets ) diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 66f44084b..e2b2a988c 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -36,7 +36,7 @@ import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText)) -import Text.Pandoc.Shared (camelCaseToHyphenated, linesToPara, +import Text.Pandoc.Shared (camelCaseToHyphenated, figureDiv, linesToPara, removeFormatting, trimr, tshow) import Text.Pandoc.URI (escapeURI, isURI) import Text.Pandoc.Templates (renderTemplate) @@ -109,17 +109,6 @@ blockToDokuWiki opts (Div _attrs bs) = do blockToDokuWiki opts (Plain inlines) = inlineListToDokuWiki opts inlines --- title beginning with fig: indicates that the image is a figure --- dokuwiki doesn't support captions - so combine together alt and caption into alt -blockToDokuWiki opts (SimpleFigure attr txt (src, tit)) = do - capt <- if null txt - then return "" - else (" " <>) `fmap` inlineListToDokuWiki opts txt - let opt = if null txt - then "" - else "|" <> if T.null tit then capt else tit <> capt - return $ "{{" <> src <> imageDims opts attr <> opt <> "}}\n" - blockToDokuWiki opts (Para inlines) = do indent <- asks stIndent useTags <- asks stUseTags @@ -223,6 +212,9 @@ blockToDokuWiki opts x@(OrderedList attribs items) = do (mapM (orderedListItemToDokuWiki opts) items) return $ vcat contents <> if T.null indent then "\n" else "" +blockToDokuWiki opts (Figure attr capt body) = + blockToDokuWiki opts $ figureDiv attr capt body + -- TODO Need to decide how to make definition lists work on dokuwiki - I don't think there -- is a specific representation of them. -- TODO This creates double '; ; ' if there is a bullet or ordered list inside a definition list diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 3d9770f53..e2d9deffe 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -37,8 +37,9 @@ import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError(..)) import Text.Pandoc.Logging import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def) -import Text.Pandoc.Shared (capitalize, orderedListMarkers, +import Text.Pandoc.Shared (blocksToInlines, capitalize, orderedListMarkers, makeSections, tshow, stringify) +import Text.Pandoc.Walk (walk) import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable, ensureValidXmlIdentifiers) import Data.Generics (everywhere, mkT) @@ -299,11 +300,11 @@ mkitem mrk bs = do -- | Convert a block-level Pandoc's element to FictionBook XML representation. blockToXml :: PandocMonad m => Block -> FBM m [Content] +blockToXml (Plain [img@Image {}]) = insertImage NormalImage img blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2 +-- Special handling for singular images and display math elements blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula --- title beginning with fig: indicates that the image is a figure -blockToXml (SimpleFigure atr alt (src, tit)) = - insertImage NormalImage (Image atr alt (src,tit)) +blockToXml (Para [img@(Image {})]) = insertImage NormalImage img blockToXml (Para ss) = list . el "p" <$> cMapM toXml ss blockToXml (CodeBlock _ s) = return . spaceBeforeAfter . map (el "p" . el "code") . T.lines $ s @@ -361,6 +362,11 @@ blockToXml (Table _ blkCapt specs thead tbody tfoot) = do align_str AlignRight = "right" align_str AlignDefault = "left" blockToXml Null = return [] +blockToXml (Figure _attr (Caption _ longcapt) body) = + let alt = blocksToInlines longcapt + addAlt (Image imgattr [] tgt) = Image imgattr alt tgt + addAlt inln = inln + in cMapM blockToXml (walk addAlt body) -- Replace plain text with paragraphs and add line break after paragraphs. -- It is used to convert plain text from tight list items to paragraphs. diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 6ccb33bc8..4a1934387 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -704,34 +705,6 @@ dimensionsToAttrList attr = go Width ++ go Height (Just x) -> [("style", tshow dir <> ":" <> tshow x)] Nothing -> [] -figure :: PandocMonad m - => WriterOptions -> Attr -> [Inline] -> (Text, Text) - -> StateT WriterState m Html -figure opts attr@(_, _, attrList) txt (s,tit) = do - html5 <- gets stHtml5 - -- Screen-readers will normally read the @alt@ text and the figure; we - -- want to avoid them reading the same text twice. With HTML5 we can - -- use aria-hidden for the caption; with HTML4, we use an empty - -- alt-text instead. - -- When the alt text differs from the caption both should be read. - let alt = if html5 then txt else [Str ""] - let tocapt = if html5 - then (H5.figcaption !) $ - if isJust (lookup "alt" attrList) - then mempty - else H5.customAttribute (textTag "aria-hidden") - (toValue @Text "true") - else H.p ! A.class_ "caption" - img <- inlineToHtml opts (Image attr alt (s,tit)) - capt <- if null txt - then return mempty - else (nl <>) . tocapt <$> inlineListToHtml opts txt - let inner = mconcat [nl, img, capt, nl] - return $ if html5 - then H5.figure inner - else H.div ! A.class_ "figure" $ inner - - adjustNumbers :: WriterOptions -> [Block] -> [Block] adjustNumbers opts doc = if all (==0) (writerNumberOffset opts) @@ -754,23 +727,19 @@ adjustNumbers opts doc = blockToHtmlInner :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html blockToHtmlInner _ Null = return mempty blockToHtmlInner opts (Plain lst) = inlineListToHtml opts lst -blockToHtmlInner opts (Para [Image attr@(_,classes,_) txt (src,tit)]) - | "r-stretch" `elem` classes = do - slideVariant <- gets stSlideVariant - case slideVariant of - RevealJsSlides -> - -- a "stretched" image in reveal.js must be a direct child - -- of the slide container - inlineToHtml opts (Image attr txt (src, tit)) - _ -> figure opts attr txt (src, tit) --- title beginning with fig: indicates that the image is a figure -blockToHtmlInner opts (SimpleFigure attr caption (src, title)) = - figure opts attr caption (src, title) blockToHtmlInner opts (Para lst) = do - contents <- inlineListToHtml opts lst - case contents of - Empty _ | not (isEnabled Ext_empty_paragraphs opts) -> return mempty - _ -> return $ H.p contents + slideVariant <- gets stSlideVariant + case (slideVariant, lst) of + (RevealJsSlides, [Image attr@(_,classes,_) txt (src,tit)]) + | "r-stretch" `elem` classes -> do + -- a "stretched" image in reveal.js must be a direct child + -- of the slide container + inlineToHtml opts (Image attr txt (src, tit)) + _ -> do + contents <- inlineListToHtml opts lst + case contents of + Empty _ | not (isEnabled Ext_empty_paragraphs opts) -> return mempty + _ -> return $ H.p contents blockToHtmlInner opts (LineBlock lns) = if writerWrapText opts == WrapNone then blockToHtml opts $ linesToPara lns @@ -1050,6 +1019,34 @@ blockToHtmlInner opts (DefinitionList lst) = do defList opts contents blockToHtmlInner opts (Table attr caption colspecs thead tbody tfoot) = tableToHtml opts (Ann.toTable attr caption colspecs thead tbody tfoot) +blockToHtmlInner opts (Figure attrs (Caption _ captBody) body) = do + html5 <- gets stHtml5 + + figAttrs <- attrsToHtml opts attrs + contents <- blockListToHtml opts body + figCaption <- if null captBody + then return mempty + else do + captCont <- blockListToHtml opts captBody + return . 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 ] + 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] + where + captionIsAlt capt [Plain [Image (_, _, kv) desc _]] = + let alt = fromMaybe (stringify desc) $ lookup "alt" kv + in stringify capt == alt + captionIsAlt _ _ = False -- | Convert Pandoc block element to HTML. All the legwork is done by -- 'blockToHtmlInner', this just takes care of emitting the notes after diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 6f8594ff5..c2bcddf83 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -100,9 +100,6 @@ blockToHaddock opts (Div _ ils) = do blockToHaddock opts (Plain inlines) = do contents <- inlineListToHaddock opts inlines return $ contents <> cr --- title beginning with fig: indicates figure -blockToHaddock opts (SimpleFigure attr alt (src, tit)) - = blockToHaddock opts (Para [Image attr alt (src,tit)]) blockToHaddock opts (Para inlines) = -- TODO: if it contains linebreaks, we need to use a @...@ block (<> blankline) `fmap` blockToHaddock opts (Plain inlines) @@ -152,6 +149,9 @@ blockToHaddock opts (OrderedList (start,_,delim) items) = do blockToHaddock opts (DefinitionList items) = do contents <- mapM (definitionListItemToHaddock opts) items return $ vcat contents <> blankline +blockToHaddock opts (Figure _ (Caption _ longcapt) body) = + -- Haddock has no concept of figures, floats, or captions. + fmap (<> blankline) (blockListToHaddock opts (body ++ longcapt)) -- | Convert bullet list item (list of blocks) to haddock bulletListItemToHaddock :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 7c39a99c4..5f660bc2d 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -312,10 +312,6 @@ blocksToICML opts style lst = do -- | Convert a Pandoc block element to ICML. blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m (Doc Text) blockToICML opts style (Plain lst) = parStyle opts style "" lst -blockToICML opts style (SimpleFigure attr txt (src, tit)) = do - figure <- parStyle opts (figureName:style) "" [Image attr txt (src, tit)] - caption <- parStyle opts (imgCaptionName:style) "" txt - return $ intersperseBrs [figure, caption] blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) "" lst blockToICML opts style (LineBlock lns) = blockToICML opts style $ linesToPara lns @@ -387,6 +383,16 @@ blockToICML opts style (Div (_ident, _, kvs) lst) = let dynamicStyle = maybeToList $ lookup dynamicStyleKey kvs in blocksToICML opts (dynamicStyle <> style) lst blockToICML _ _ Null = return empty +blockToICML opts style (Figure attr capt@(Caption _ longcapt) body) = + case body of + [Plain [img@(Image {})]] -> do + figure <- parStyle opts (figureName:style) "" [img] + caption <- parStyle opts (imgCaptionName:style) "" $ + blocksToInlines longcapt + return $ intersperseBrs [figure, caption] + _ -> -- fallback to rendering the figure as a Div + blockToICML opts style $ figureDiv attr capt body + -- | Convert a list of lists of blocks to ICML list items. listItemsToICML :: PandocMonad m => WriterOptions -> Text -> Style -> Maybe ListAttributes -> [[Block]] -> WS m (Doc Text) diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 16a7fb672..f19be1445 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -220,17 +220,6 @@ listItemToJATS opts mbmarker item = do maybe empty (inTagsSimple "label" . text . T.unpack) mbmarker $$ contents -imageMimeType :: Text -> [(Text, Text)] -> (Text, Text) -imageMimeType src kvs = - let mbMT = getMimeType (T.unpack src) - maintype = fromMaybe "image" $ - lookup "mimetype" kvs `mplus` - (T.takeWhile (/='/') <$> mbMT) - subtype = fromMaybe "" $ - lookup "mime-subtype" kvs `mplus` - (T.drop 1 . T.dropWhile (/='/') <$> mbMT) - in (maintype, subtype) - languageFor :: WriterOptions -> [Text] -> Text languageFor opts classes = case langs of @@ -301,35 +290,13 @@ blockToJATS opts (Div (ident,_,kvs) bs) = do blockToJATS opts (Header _ _ title) = do title' <- inlinesToJATS opts (map fixLineBreak title) return $ inTagsSimple "title" title' +-- Special cases for bare images, which are rendered as graphics +blockToJATS _opts (Plain [Image attr alt tgt]) = + return $ graphic attr alt tgt +blockToJATS _opts (Para [Image attr alt tgt]) = + return $ graphic attr alt tgt -- No Plain, everything needs to be in a block-level tag blockToJATS opts (Plain lst) = blockToJATS opts (Para lst) -blockToJATS opts (SimpleFigure (ident, _, kvs) txt (src, tit)) = do - alt <- inlinesToJATS opts txt - let (maintype, subtype) = imageMimeType src kvs - let capt = if null txt - then empty - else inTagsSimple "caption" $ inTagsSimple "p" alt - let attr = [("id", escapeNCName ident) | not (T.null ident)] ++ - [(k,v) | (k,v) <- kvs, k `elem` ["fig-type", "orientation", - "position", "specific-use"]] - let graphicattr = [("mimetype",maintype), - ("mime-subtype",subtype), - ("xlink:href",src), -- do we need to URL escape this? - ("xlink:title",tit)] - return $ inTags True "fig" attr $ - capt $$ selfClosingTag "graphic" graphicattr -blockToJATS _ (Para [Image (ident,_,kvs) _ (src, tit)]) = do - let (maintype, subtype) = imageMimeType src kvs - let attr = [("id", escapeNCName ident) | not (T.null ident)] ++ - [("mimetype", maintype), - ("mime-subtype", subtype), - ("xlink:href", src)] ++ - [("xlink:title", tit) | not (T.null tit)] ++ - [(k,v) | (k,v) <- kvs, k `elem` ["baseline-shift", - "content-type", "specific-use", "xlink:actuate", - "xlink:href", "xlink:role", "xlink:show", - "xlink:type"]] - return $ selfClosingTag "graphic" attr blockToJATS opts (Para lst) = inTagsSimple "p" <$> inlinesToJATS opts lst blockToJATS opts (LineBlock lns) = @@ -385,6 +352,16 @@ blockToJATS _ b@(RawBlock f str) blockToJATS _ HorizontalRule = return empty -- not semantic blockToJATS opts (Table attr caption colspecs thead tbody tfoot) = tableToJATS opts (Ann.toTable attr caption colspecs thead tbody tfoot) +blockToJATS opts (Figure (ident, _, kvs) caption body) = do + capt <- case caption of + Caption _ [] -> pure empty + Caption _ cpt -> inTagsSimple "caption" <$> blocksToJATS opts cpt + figbod <- blocksToJATS opts body + let figattr = [("id", escapeNCName ident) | not (T.null ident)] ++ + [(k,v) | (k,v) <- kvs + , k `elem` [ "fig-type", "orientation" + , "position", "specific-use"]] + return $ inTags True "fig" figattr $ capt $$ figbod -- | Convert a list of inline elements to JATS. inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text) @@ -543,27 +520,40 @@ inlineToJATS opts (Link (ident,_,kvs) txt (src, tit)) = do "xlink:type"]] contents <- inlinesToJATS opts txt return $ inTags False "ext-link" attr contents -inlineToJATS _ (Image (ident,_,kvs) _ (src, tit)) = do +inlineToJATS _ (Image attr alt tgt) = do + return $ selfClosingTag "inline-graphic" (graphicAttr attr alt tgt) + +graphic :: Attr -> [Inline] -> Target -> (Doc Text) +graphic attr alt tgt = + selfClosingTag "graphic" (graphicAttr attr alt tgt) + +graphicAttr :: Attr -> [Inline] -> Target -> [(Text, Text)] +graphicAttr (ident, _, kvs) _alt (src, tit) = + let (maintype, subtype) = imageMimeType src kvs + in [("id", escapeNCName ident) | not (T.null ident)] ++ + [ ("mimetype", maintype) + , ("mime-subtype", subtype) + , ("xlink:href", src) + ] ++ + [("xlink:title", tit) | not (T.null tit)] ++ + [(k,v) | (k,v) <- kvs + , k `elem` [ "baseline-shift", "content-type", "specific-use" + , "xlink:actuate", "xlink:href", "xlink:role" + , "xlink:show", "xlink:type"] + ] + +imageMimeType :: Text -> [(Text, Text)] -> (Text, Text) +imageMimeType src kvs = let mbMT = getMimeType (T.unpack src) - let maintype = fromMaybe "image" $ + maintype = fromMaybe "image" $ lookup "mimetype" kvs `mplus` (T.takeWhile (/='/') <$> mbMT) - let subtype = fromMaybe "" $ + subtype = fromMaybe "" $ lookup "mime-subtype" kvs `mplus` (T.drop 1 . T.dropWhile (/='/') <$> mbMT) - let attr = [("id", escapeNCName ident) | not (T.null ident)] ++ - [("mimetype", maintype), - ("mime-subtype", subtype), - ("xlink:href", src)] ++ - [("xlink:title", tit) | not (T.null tit)] ++ - [(k,v) | (k,v) <- kvs, k `elem` ["baseline-shift", - "content-type", "specific-use", "xlink:actuate", - "xlink:href", "xlink:role", "xlink:show", - "xlink:type"]] - return $ selfClosingTag "inline-graphic" attr + in (maintype, subtype) isParaOrList :: Block -> Bool -isParaOrList SimpleFigure{} = False -- implicit figures are not paragraphs isParaOrList Para{} = True isParaOrList Plain{} = True isParaOrList BulletList{} = True diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs index 612e517c7..7b637268b 100644 --- a/src/Text/Pandoc/Writers/Jira.hs +++ b/src/Text/Pandoc/Writers/Jira.hs @@ -114,6 +114,7 @@ toJiraBlocks blocks = do Just header -> header : bodyRows Nothing -> bodyRows return $ Jira.Table rows + Figure attr _ body -> toJiraPanel attr body jiraBlocks <- mapM convert blocks return $ mconcat jiraBlocks diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 0585a7111..6dd259dae 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.Writers.LaTeX @@ -33,6 +34,7 @@ import Data.Containers.ListUtils (nubOrd) import Data.Char (isDigit) import Data.List (intersperse, (\\)) import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing) +import Data.Monoid (Any (..)) import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) @@ -176,6 +178,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do defField "numbersections" (writerNumberSections options) $ defField "lhs" (stLHS st) $ defField "graphics" (stGraphics st) $ + defField "subfigure" (stSubfigure st) $ defField "svg" (stSVG st) $ defField "has-chapters" (stHasChapters st) $ defField "has-frontmatter" (documentClass `elem` frontmatterClasses) $ @@ -366,21 +369,6 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) = do wrapNotes <$> wrapDiv (identifier,classes,kvs) result blockToLaTeX (Plain lst) = inlineListToLaTeX lst -blockToLaTeX (SimpleFigure attr@(ident, _, _) txt (src, tit)) = do - (capt, captForLof, footnotes) <- getCaption inlineListToLaTeX True txt - lab <- labelFor ident - let caption = "\\caption" <> captForLof <> braces capt <> lab - img <- inlineToLaTeX (Image attr txt (src,tit)) - innards <- hypertarget True ident $ - "\\centering" $$ img $$ caption <> cr - let figure = cr <> "\\begin{figure}" $$ innards $$ "\\end{figure}" - st <- get - return $ (if stInMinipage st - -- can't have figures in notes or minipage (here, table cell) - -- http://www.tex.ac.uk/FAQ-ouparmd.html - then cr <> "\\begin{center}" $$ img $+$ capt $$ - "\\end{center}" - else figure) $$ footnotes -- . . . indicates pause in beamer slides blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do beamer <- gets stBeamer @@ -576,6 +564,58 @@ blockToLaTeX (Header level (id',classes,_) lst) = do blockToLaTeX (Table attr blkCapt specs thead tbodies tfoot) = tableToLaTeX inlineListToLaTeX blockListToLaTeX (Ann.toTable attr blkCapt specs thead tbodies tfoot) +blockToLaTeX (Figure (ident, _, _) (Caption _ longCapt) body) = do + (capt, captForLof, footnotes) <- getCaption inlineListToLaTeX True + (blocksToInlines longCapt) + lab <- labelFor ident + let caption = "\\caption" <> captForLof <> braces capt <> lab + + isSubfigure <- gets stInFigure + modify $ \st -> st{ stInFigure = True } + contents <- case body of + [b] -> blockToLaTeX b + bs -> mconcat . intersperse (cr <> "\\hfill") <$> + mapM (toSubfigure (length bs)) bs + innards <- hypertarget True ident $ + "\\centering" $$ contents $$ caption <> cr + modify $ \st -> + st{ stInFigure = isSubfigure + , stSubfigure = stSubfigure st || isSubfigure + } + + let containsTable = getAny . (query $ \case + Table {} -> Any True + _ -> Any False) + st <- get + return $ (case () of + _ | containsTable body -> + -- placing a longtable in a figure or center environment does + -- not make sense. + cr <> contents + _ | stInMinipage st -> + -- can't have figures in notes or minipage (here, table cell) + -- http://www.tex.ac.uk/FAQ-ouparmd.html + cr <> "\\begin{center}" $$ contents $+$ capt $$ "\\end{center}" + _ | isSubfigure -> + innards + _ -> cr <> "\\begin{figure}" $$ innards $$ "\\end{figure}") + $$ footnotes + +toSubfigure :: PandocMonad m => Int -> Block -> LW m (Doc Text) +toSubfigure nsubfigs blk = do + contents <- blockToLaTeX blk + let linewidth = tshow @Double (0.9 / fromIntegral nsubfigs) <> "\\linewidth" + return $ cr <> case blk of + Figure {} -> vcat + [ "\\begin{subfigure}[t]" <> braces (literal linewidth) + , contents + , "\\end{subfigure}" + ] + _ -> vcat + [ "\\begin{minipage}[t]" <> braces (literal linewidth) + , contents + , "\\end{minipage}" + ] blockListToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text) blockListToLaTeX lst = diff --git a/src/Text/Pandoc/Writers/LaTeX/Types.hs b/src/Text/Pandoc/Writers/LaTeX/Types.hs index ff5b22cad..97ac1dcf9 100644 --- a/src/Text/Pandoc/Writers/LaTeX/Types.hs +++ b/src/Text/Pandoc/Writers/LaTeX/Types.hs @@ -25,12 +25,14 @@ data WriterState = , stInMinipage :: Bool -- ^ true if in minipage , stInHeading :: Bool -- ^ true if in a section heading , stInItem :: Bool -- ^ true if in \item[..] + , stInFigure :: Bool -- ^ true if in figure environment , stNotes :: [Doc Text] -- ^ notes in a minipage , stOLLevel :: Int -- ^ level of ordered list nesting , stOptions :: WriterOptions -- ^ writer options, so they don't have to -- be parameter , stVerbInNote :: Bool -- ^ true if document has verbatim text in note , stTable :: Bool -- ^ true if document has a table + , stSubfigure :: Bool -- ^ true if document has subfigures , stMultiRow :: Bool -- ^ true if document has multirow cells , stStrikeout :: Bool -- ^ true if document has strikeout , stUrl :: Bool -- ^ true if document has visible URL link @@ -58,11 +60,13 @@ startingState options = , stInHeading = False , stInMinipage = False , stInItem = False + , stInFigure = False , stNotes = [] , stOLLevel = 1 , stOptions = options , stVerbInNote = False , stTable = False + , stSubfigure = False , stMultiRow = False , stStrikeout = False , stUrl = False diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 5573a9838..1ea5b8650 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -173,7 +173,6 @@ blockToMan opts (Table _ blkCapt specs thead tbody tfoot) = return $ literal ".PP" $$ caption' $$ literal ".TS" $$ literal "tab(@);" $$ coldescriptions $$ colheadings' $$ vcat body $$ literal ".TE" - blockToMan opts (BulletList items) = do contents <- mapM (bulletListItemToMan opts) items return (vcat contents) @@ -186,6 +185,8 @@ blockToMan opts (OrderedList attribs items) = do blockToMan opts (DefinitionList items) = do contents <- mapM (definitionListItemToMan opts) items return (vcat contents) +blockToMan opts (Figure attr capt body) = do + blockToMan opts (figureDiv attr capt body) -- | Convert bullet list item (list of blocks) to man. bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m (Doc Text) diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index cde993091..95dedb0b5 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -25,7 +25,7 @@ import Control.Monad (foldM, zipWithM, MonadPlus(..), when) import Control.Monad.Reader ( asks, MonadReader(local) ) import Control.Monad.State.Strict ( gets, modify ) import Data.Default -import Data.List (intersperse, sortOn) +import Data.List (intersperse, sortOn, union) import Data.List.NonEmpty (nonEmpty, NonEmpty(..)) import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe, isNothing) @@ -427,14 +427,6 @@ blockToMarkdown' opts (Plain inlines) = do _ -> inlines contents <- inlineListToMarkdown opts inlines' return $ contents <> cr -blockToMarkdown' opts (SimpleFigure attr alt (src, tit)) - | isEnabled Ext_raw_html opts && - not (isEnabled Ext_link_attributes opts || isEnabled Ext_attributes opts) && - attr /= nullAttr = -- use raw HTML - (<> blankline) . literal . T.strip <$> - writeHtml5String opts{ writerTemplate = Nothing } - (Pandoc nullMeta [SimpleFigure attr alt (src, tit)]) - | otherwise = blockToMarkdown opts (Para [Image attr alt (src,tit)]) blockToMarkdown' opts (Para inlines) = (<> blankline) `fmap` blockToMarkdown opts (Plain inlines) blockToMarkdown' opts (LineBlock lns) = @@ -677,6 +669,33 @@ blockToMarkdown' opts (OrderedList (start,sty,delim) items) = do blockToMarkdown' opts (DefinitionList items) = do contents <- inList $ mapM (definitionListItemToMarkdown opts) items return $ mconcat contents <> blankline +blockToMarkdown' opts (Figure figattr capt body) = do + let combinedAttr imgattr = case imgattr of + ("", cls, kv) | (figid, [], []) <- figattr -> Just (figid, cls, kv) + _ -> Nothing + let combinedAlt alt = case capt of + Caption Nothing [] -> if null alt + then Just [Str "image"] + else Just alt + Caption Nothing [Plain captInlines] + | captInlines == alt -> Just captInlines + _ -> Nothing + case body of + [Plain [Image imgAttr alt (src, ttl)]] + | isEnabled Ext_implicit_figures opts + , Just descr <- combinedAlt alt + , Just imgAttr' <- combinedAttr imgAttr + , isEnabled Ext_link_attributes opts || imgAttr' == nullAttr + -> do + -- use implicit figures if possible + let tgt' = (src, fromMaybe ttl $ T.stripPrefix "fig:" ttl) + contents <- inlineListToMarkdown opts [Image imgAttr' descr tgt'] + return $ contents <> blankline + _ -> + -- fallback to raw html if possible or div otherwise + if isEnabled Ext_raw_html opts + then figureToMarkdown opts figattr capt body + else blockToMarkdown' opts $ figureDiv figattr capt body inList :: Monad m => MD m a -> MD m a inList p = local (\env -> env {envInList = True}) p @@ -690,6 +709,22 @@ addMarkdownAttribute s = x /= "markdown"] _ -> s +-- | Converts a figure to Markdown by wrapping it in a div named `figure`. +figureToMarkdown :: PandocMonad m + => WriterOptions + -> Attr + -> Caption + -> [Block] + -> MD m (Doc Text) +figureToMarkdown opts attr@(ident, classes, kvs) capt body + | isEnabled Ext_raw_html opts = + (<> blankline) . literal . T.strip <$> + writeHtml5String + opts{ writerTemplate = Nothing } + (Pandoc nullMeta [Figure attr capt body]) + | otherwise = let attr' = (ident, ["figure"] `union` classes, kvs) + in blockToMarkdown' opts (Div attr' body) + itemEndsWithTightList :: [Block] -> Bool itemEndsWithTightList bs = case bs of diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index b93226d08..a244a52ff 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -16,6 +16,7 @@ module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki, highlightingLangs ) where import Control.Monad.Reader import Control.Monad.State.Strict import Data.Maybe (fromMaybe) +import qualified Data.List as DL import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T @@ -202,6 +203,9 @@ blockToMediaWiki x@(DefinitionList items) = do contents <- local (\s -> s { listLevel = listLevel s <> ";" }) $ mapM definitionListItemToMediaWiki items return $ vcat contents <> if null lev then "\n" else "" +blockToMediaWiki (Figure (ident, classes, kvs) _ body) = + blockToMediaWiki (Div (ident, ["figure"] `DL.union` classes, kvs) body) + -- Auxiliary functions for lists: -- | Convert ordered list attributes to HTML attribute string diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index deea93f97..938ee881e 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -303,7 +303,6 @@ blockToMs opts (Table _ blkCapt specs thead tbody tfoot) = then "" else ".nr LL \\n[LLold]") $$ literal ".ad" - blockToMs opts (BulletList items) = do contents <- mapM (bulletListItemToMs opts) items setFirstPara @@ -319,6 +318,7 @@ blockToMs opts (DefinitionList items) = do contents <- mapM (definitionListItemToMs opts) items setFirstPara return (vcat contents) +blockToMs opts (Figure attr _ body) = blockToMs opts $ Div attr body -- | Convert bullet list item (list of blocks) to ms. bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m (Doc Text) diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index 803394212..c254746b4 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -280,6 +280,8 @@ blockToMuse (Table _ blkCapt specs thead tbody tfoot) = isSimple = onlySimpleTableCells (headers : rows) && all (== 0) widths blockToMuse (Div _ bs) = flatBlockListToMuse bs blockToMuse Null = return empty +blockToMuse (Figure attr capt body) = do + blockToMuse (figureDiv attr capt body) -- | Return Muse representation of notes collected so far. currentNotesToMuse :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index f7142b785..38a04341f 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -60,7 +60,7 @@ type OD m = StateT WriterState m data ReferenceType = HeaderRef | TableRef - | ImageRef + | FigureRef data WriterState = WriterState { stNotes :: [Doc Text] @@ -253,12 +253,11 @@ writeOpenDocument opts (Pandoc meta blocks) = do meta ((body, metadata),s) <- flip runStateT defaultWriterState $ do - let collectInlineIdent (Image (ident,_,_) _ _) = [(ident,ImageRef)] - collectInlineIdent _ = [] let collectBlockIdent (Header _ (ident,_,_) _) = [(ident,HeaderRef)] + collectBlockIdent (Figure (ident,_,_) _ _ ) = [(ident,FigureRef)] collectBlockIdent (Table (ident,_,_) _ _ _ _ _) = [(ident,TableRef)] collectBlockIdent _ = [] - modify $ \s -> s{ stIdentTypes = query collectBlockIdent blocks ++ query collectInlineIdent blocks } + modify $ \s -> s{ stIdentTypes = query collectBlockIdent blocks } m <- metaToContext opts (blocksToOpenDocument opts) (fmap chomp . inlinesToOpenDocument opts) @@ -377,7 +376,6 @@ blockToOpenDocument o = \case Plain b -> if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b - SimpleFigure attr c (s, t) -> figure attr c s t Para b -> if null b && not (isEnabled Ext_empty_paragraphs o) then return empty @@ -399,6 +397,7 @@ blockToOpenDocument o = \case then return $ text $ T.unpack s else empty <$ report (BlockNotRendered b) Null -> return empty + Figure a capt b -> figure a capt b where defList b = do setInDefinitionList True r <- vcat <$> mapM (deflistItemToOpenDocument o) b @@ -454,15 +453,18 @@ blockToOpenDocument o = \case , ("table:style-name", name) ] (vcat columns $$ th $$ vcat tr) return $ captionDoc $$ tableDoc - figure attr@(ident, _, _) caption source title | null caption = - withParagraphStyle o "Figure" [Para [Image attr caption (source,title)]] - | otherwise = do - imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image attr caption (source,title)]] - captionDoc <- inlinesToOpenDocument o caption >>= - if isEnabled Ext_native_numbering o - then numberedFigureCaption ident - else unNumberedCaption "FigureCaption" - return $ imageDoc $$ captionDoc + figure (ident, _, _) (Caption _ longcapt) body = + case blocksToInlines longcapt of + [] -> + withParagraphStyle o "Figure" body + caption -> do + imageDoc <- withParagraphStyle o "FigureWithCaption" $ + map (\case {Plain i -> Para i; b -> b}) body + captionDoc <- inlinesToOpenDocument o caption >>= + if isEnabled Ext_native_numbering o + then numberedFigureCaption ident + else unNumberedCaption "FigureCaption" + return $ imageDoc $$ captionDoc numberedTableCaption :: PandocMonad m => Text -> Doc Text -> OD m (Doc Text) @@ -705,7 +707,7 @@ mkLink o identTypes s t d = linkOrReference = case maybeIdentAndType of Just (ident, HeaderRef) -> bookmarkRef' ident Just (ident, TableRef) -> sequenceRef' ident - Just (ident, ImageRef) -> sequenceRef' ident + Just (ident, FigureRef) -> sequenceRef' ident _ -> link in if isEnabled Ext_xrefs_name o || isEnabled Ext_xrefs_number o then linkOrReference diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 751217e61..f8d16e924 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -123,12 +123,6 @@ blockToOrg (Div attr@(ident,_,_) bs) = do then return mempty else divToOrg attr bs blockToOrg (Plain inlines) = inlineListToOrg inlines -blockToOrg (SimpleFigure attr txt (src, tit)) = do - capt <- if null txt - then return empty - else ("#+caption: " <>) `fmap` inlineListToOrg txt - img <- inlineToOrg (Image attr txt (src,tit)) - return $ capt $$ img $$ blankline blockToOrg (Para inlines) = do contents <- inlineListToOrg inlines return $ contents <> blankline @@ -234,6 +228,18 @@ blockToOrg (OrderedList (start, _, delim) items) = do blockToOrg (DefinitionList items) = do contents <- mapM definitionListItemToOrg items return $ vcat contents $$ blankline +blockToOrg (Figure (ident, _, _) caption body) = do + -- Represent the figure as content that can be internally linked from other + -- parts of the document. + capt <- case caption of + Caption _ [] -> pure empty + Caption _ cpt -> ("#+caption: " <>) <$> + inlineListToOrg (blocksToInlines cpt) + contents <- blockListToOrg body + let anchor = if T.null ident + then empty + else "<<" <> literal ident <> ">>" + return (capt $$ anchor $$ contents $$ blankline) -- | Convert bullet list item (list of blocks) to Org. bulletListItemToOrg :: PandocMonad m => [Block] -> Org m (Doc Text) diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index 49f4f656f..520cf4826 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -537,6 +537,8 @@ blockToParagraphs (Div (_, classes, _) blks) = let | otherwise -> Nothing addIncremental env = env { envInIncrementalDiv = incremental } in local addIncremental (concatMapM blockToParagraphs blks) +blockToParagraphs (Figure attr capt blks) = + blockToParagraphs (Shared.figureDiv attr capt blks) blockToParagraphs blk = do addLogMessage $ BlockNotRendered blk return [] @@ -1041,6 +1043,7 @@ blockIsBlank DefinitionList ds -> all (uncurry (&&) . bimap (all inlineIsBlank) (all (all blockIsBlank))) ds Header _ _ ils -> all inlineIsBlank ils HorizontalRule -> True + Figure _ _ bls -> all blockIsBlank bls Table{} -> False Div _ bls -> all blockIsBlank bls Null -> True diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 4567b44df..d2ba258fe 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -263,20 +263,6 @@ blockToRST (Div (ident,classes,_kvs) bs) = do nest 3 contents $$ blankline blockToRST (Plain inlines) = inlineListToRST inlines -blockToRST (SimpleFigure attr txt (src, tit)) = do - description <- inlineListToRST txt - dims <- imageDimsToRST attr - let fig = "figure:: " <> literal src - alt = ":alt: " <> if T.null tit then description else literal tit - capt = description - (_,cls,_) = attr - classes = case cls of - [] -> empty - ["align-right"] -> ":align: right" - ["align-left"] -> ":align: left" - ["align-center"] -> ":align: center" - _ -> ":figclass: " <> literal (T.unwords cls) - return $ hang 3 ".. " (fig $$ alt $$ classes $$ dims $+$ capt) $$ blankline blockToRST (Para [Image attr txt (src, _)]) = do description <- inlineListToRST txt dims <- imageDimsToRST attr @@ -409,6 +395,36 @@ blockToRST (DefinitionList items) = do -- ensure that sublists have preceding blank line return $ blankline $$ vcat contents $$ blankline +blockToRST (Figure (ident, classes, _) _ body) = do + let figure attr txt (src, tit) = do + description <- inlineListToRST txt + dims <- imageDimsToRST attr + let fig = "figure:: " <> literal src + alt = ":alt: " <> if T.null tit then description else literal tit + capt = description + (_,cls,_) = attr + align = case cls of + [] -> empty + ["align-right"] -> ":align: right" + ["align-left"] -> ":align: left" + ["align-center"] -> ":align: center" + _ -> ":figclass: " <> literal (T.unwords cls) + return $ hang 3 ".. " (fig $$ alt $$ align $$ dims $+$ capt) + $$ blankline + case body of + [Para [Image attr txt tgt]] -> figure attr txt tgt + [Plain [Image attr txt tgt]] -> figure attr txt tgt + _ -> do + content <- blockListToRST body + return $ blankline $$ ( + ".. container:: float" <> space <> + literal (T.unwords (filter (/= "container") classes))) $$ + (if T.null ident + then blankline + else " :name: " <> literal ident $$ blankline) $$ + nest 3 content $$ + blankline + -- | Convert bullet list item (list of blocks) to RST. bulletListItemToRST :: PandocMonad m => [Block] -> RST m (Doc Text) bulletListItemToRST items = do diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 2c012d85e..2f13627e6 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -270,6 +270,8 @@ blockToRTF indent alignment (Table _ blkCapt specs thead tbody tfoot) = do else tableRowToRTF True indent aligns sizes headers rows' <- T.concat <$> mapM (tableRowToRTF False indent aligns sizes) rows return $ header' <> rows' <> rtfPar indent 0 alignment caption' +blockToRTF indent alignment (Figure attr capt body) = + blockToRTF indent alignment $ figureDiv attr capt body tableRowToRTF :: PandocMonad m => Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m Text diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index 6c7a5bb49..f0efa9952 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -130,18 +130,6 @@ blockToTEI _ h@Header{} = do -- we use treat as Para to ensure that Plain text ends up contained by -- something: blockToTEI opts (Plain lst) = blockToTEI opts $ Para lst --- title beginning with fig: indicates that the image is a figure ---blockToTEI opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = --- let alt = inlinesToTEI opts txt --- capt = if null txt --- then empty --- else inTagsSimple "title" alt --- in inTagsIndented "figure" $ --- capt $$ --- (inTagsIndented "mediaobject" $ --- (inTagsIndented "imageobject" --- (imageToTEI opts attr src)) $$ --- inTagsSimple "textobject" (inTagsSimple "phrase" alt)) blockToTEI opts (Para lst) = inTags False "p" [] <$> inlinesToTEI opts lst blockToTEI opts (LineBlock lns) = @@ -193,6 +181,8 @@ blockToTEI _ HorizontalRule = return $ selfClosingTag "milestone" [("unit","undefined") ,("type","separator") ,("rendition","line")] +blockToTEI opts (Figure attr capt bs) = + blockToTEI opts (figureDiv attr capt bs) -- TEI Tables -- TEI Simple's tables are composed of cells and rows; other diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index ed9c8e840..ca27a0a32 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -125,15 +125,6 @@ blockToTexinfo (Div _ bs) = blockListToTexinfo bs blockToTexinfo (Plain lst) = inlineListToTexinfo lst --- title beginning with fig: indicates that the image is a figure -blockToTexinfo (SimpleFigure attr txt (src, tit)) = do - capt <- if null txt - then return empty - else (\c -> text "@caption" <> braces c) `fmap` - inlineListToTexinfo txt - img <- inlineToTexinfo (Image attr txt (src,tit)) - return $ text "@float" $$ img $$ capt $$ text "@end float" - blockToTexinfo (Para lst) = inlineListToTexinfo lst -- this is handled differently from Plain in blockListToTexinfo @@ -257,11 +248,44 @@ blockToTexinfo (Table _ blkCapt specs thead tbody tfoot) = do text "@end multitable" return $ if isEmpty captionText then tableBody <> blankline - else text "@float" $$ + else text "@float Table" $$ tableBody $$ inCmd "caption" captionText $$ text "@end float" +blockToTexinfo (Figure _ caption [SimpleFigure attr figCaption tgt]) = do + let capt = if null figCaption + then let (Caption _ cblks) = caption + in blocksToInlines cblks + else figCaption + captionText <- if null capt + then return empty + else (text "@caption" <>) . braces <$> inlineListToTexinfo capt + img <- inlineToTexinfo (Image attr figCaption tgt) + return $ text "@float Figure" $$ img $$ captionText $$ text "@end float" + +blockToTexinfo (Figure _ fCaption [ + Table attr tCaption@(Caption _ cbody) specs thead tbody tfoot]) = do + let caption = case cbody of + [] -> fCaption + _ -> tCaption + blockToTexinfo (Table attr caption specs thead tbody tfoot) + +blockToTexinfo (Figure _ (Caption _ caption) body) = do + captionText <- inlineListToTexinfo $ blocksToInlines caption + content <- blockListToTexinfo body + return $ text ("@float" ++ floatType body) $$ content $$ ( + if isEmpty captionText + then empty + else inCmd "caption" captionText + ) $$ text "@end float" + where + -- floatType according to + -- https://www.gnu.org/software/texinfo/manual/texinfo/html_node/_0040float.html + floatType [SimpleFigure {}] = " Figure" + floatType [Table {}] = " Table" + floatType _ = "" + tableHeadToTexinfo :: PandocMonad m => [Alignment] -> [[Block]] diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 115756f1d..0f38d91e6 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -111,11 +111,6 @@ blockToTextile opts (Div attr bs) = do blockToTextile opts (Plain inlines) = inlineListToTextile opts inlines -blockToTextile opts (SimpleFigure attr txt (src, tit)) = do - capt <- blockToTextile opts (Para txt) - im <- inlineToTextile opts (Image attr txt (src,tit)) - return $ im <> "\n" <> capt - blockToTextile opts (Para inlines) = do useTags <- gets stUseTags listLevel <- gets stListLevel @@ -243,6 +238,19 @@ blockToTextile opts (DefinitionList items) = do contents <- withUseTags $ mapM (definitionListItemToTextile opts) items return $ "<dl>\n" <> vcat contents <> "\n</dl>\n" +blockToTextile opts (Figure attr (Caption _ caption) body) = do + let startTag = render Nothing $ tagWithAttrs "figure" attr + let endTag = "</figure>" + let captionInlines = blocksToInlines caption + captionMarkup <- if null captionInlines + then return "" + else ((<> "\n\n</figcaption>\n\n") . ("<figcaption>\n\n" <>)) <$> + inlineListToTextile opts (blocksToInlines caption) + contents <- blockListToTextile opts body + return $ startTag <> "\n\n" <> + captionMarkup <> + contents <> "\n\n" <> endTag <> "\n" + -- Auxiliary functions for lists: -- | Convert ordered list attributes to HTML attribute string diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs index f3389d0fd..87eda20ac 100644 --- a/src/Text/Pandoc/Writers/XWiki.hs +++ b/src/Text/Pandoc/Writers/XWiki.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2008-2017 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2008-2023 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.XWiki - Copyright : Copyright (C) 2008-2017 John MacFarlane + Copyright : Copyright (C) 2008-2023 John MacFarlane License : GNU GPL, version 2 or above Maintainer : Derek Chen-Becker <dchenbecker@gmail.com> @@ -135,6 +135,12 @@ blockToXWiki (DefinitionList items) = do contents <- local (\s -> s { listLevel = listLevel s <> ";" }) $ mapM definitionListItemToMediaWiki items return $ vcat contents <> if Text.null lev then "\n" else "" +-- Create a group according to +-- https://www.xwiki.org/xwiki/bin/view/Documentation/UserGuide/Features/XWikiSyntax/?syntax=2.1§ion=Groups +blockToXWiki (Figure attr _ body) = do + content <- blockToXWiki $ Div attr body + return $ intercalate content ["(((\n", "\n)))"] + -- TODO: support more features blockToXWiki (Table _ blkCapt specs thead tbody tfoot) = do let (_, _, _, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 77d627ed1..6e8f49ed9 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -32,7 +32,7 @@ import Text.Pandoc.Logging import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText)) -import Text.Pandoc.Shared (linesToPara, removeFormatting, trimr) +import Text.Pandoc.Shared (figureDiv, linesToPara, removeFormatting, trimr) import Text.Pandoc.URI (escapeURI, isURI) import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable) @@ -86,16 +86,6 @@ blockToZimWiki opts (Div _attrs bs) = do blockToZimWiki opts (Plain inlines) = inlineListToZimWiki opts inlines --- ZimWiki doesn't support captions - so combine together alt and caption into alt -blockToZimWiki opts (SimpleFigure attr txt (src, tit)) = do - capt <- if null txt - then return "" - else (" " <>) `fmap` inlineListToZimWiki opts txt - let opt = if null txt - then "" - else "|" <> if T.null tit then capt else tit <> capt - return $ "{{" <> src <> imageDims opts attr <> opt <> "}}\n" - blockToZimWiki opts (Para inlines) = do indent <- gets stIndent -- useTags <- gets stUseTags @@ -180,6 +170,9 @@ blockToZimWiki opts (DefinitionList items) = do contents <- mapM (definitionListItemToZimWiki opts) items return $ vcat contents +blockToZimWiki opts (Figure attr capt body) = do + blockToZimWiki opts (figureDiv attr capt body) + definitionListItemToZimWiki :: PandocMonad m => WriterOptions -> ([Inline],[[Block]]) |