diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
23 files changed, 443 insertions, 229 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index c3406f31f..174b00dac 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -46,6 +46,7 @@ import Text.Pandoc.Parsing hiding (blankline, space) import Data.Maybe (fromMaybe) import Data.List ( stripPrefix, intersperse, intercalate ) import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Control.Monad.State import qualified Data.Map as M import Data.Aeson (Value(String), fromJSON, toJSON, Result(..)) @@ -126,8 +127,8 @@ blockToAsciiDoc _ Null = return empty blockToAsciiDoc opts (Plain inlines) = do contents <- inlineListToAsciiDoc opts inlines return $ contents <> blankline -blockToAsciiDoc opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do - blockToAsciiDoc opts (Para [Image alt (src,tit)]) +blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do + blockToAsciiDoc opts (Para [Image attr alt (src,tit)]) blockToAsciiDoc opts (Para inlines) = do contents <- inlineListToAsciiDoc opts inlines -- escape if para starts with ordered list marker @@ -392,7 +393,7 @@ inlineToAsciiDoc _ (RawInline f s) inlineToAsciiDoc _ (LineBreak) = return $ " +" <> cr inlineToAsciiDoc _ Space = return space inlineToAsciiDoc opts (Cite _ lst) = inlineListToAsciiDoc opts lst -inlineToAsciiDoc opts (Link txt (src, _tit)) = do +inlineToAsciiDoc opts (Link _ txt (src, _tit)) = do -- relative: link:downloads/foo.zip[download foo.zip] -- abs: http://google.cod[Google] -- or my@email.com[email john] @@ -408,7 +409,7 @@ inlineToAsciiDoc opts (Link txt (src, _tit)) = do return $ if useAuto then text srcSuffix else prefix <> text src <> "[" <> linktext <> "]" -inlineToAsciiDoc opts (Image alternate (src, tit)) = do +inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do -- image:images/logo.png[Company logo, title="blah"] let txt = if (null alternate) || (alternate == [Str ""]) then [Str "image"] @@ -416,8 +417,19 @@ inlineToAsciiDoc opts (Image alternate (src, tit)) = do linktext <- inlineListToAsciiDoc opts txt let linktitle = if null tit then empty - else text $ ",title=\"" ++ tit ++ "\"" - return $ "image:" <> text src <> "[" <> linktext <> linktitle <> "]" + else ",title=\"" <> text tit <> "\"" + showDim dir = case (dimension dir attr) of + Just (Percent a) -> + ["scaledwidth=" <> text (show (Percent a))] + Just dim -> + [text (show dir) <> "=" <> text (showInPixel opts dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else "," <> cat (intersperse "," dimList) + return $ "image:" <> text src <> "[" <> linktext <> linktitle <> dims <> "]" inlineToAsciiDoc opts (Note [Para inlines]) = inlineToAsciiDoc opts (Note [Plain inlines]) inlineToAsciiDoc opts (Note [Plain inlines]) = do diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index fee36d454..c2d476641 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -153,9 +153,9 @@ inlineToNodes (SmallCaps xs) = ((node (INLINE_HTML (T.pack "<span style=\"font-variant:small-caps;\">")) [] : inlinesToNodes xs ++ [node (INLINE_HTML (T.pack "</span>")) []]) ++ ) -inlineToNodes (Link ils (url,tit)) = +inlineToNodes (Link _ ils (url,tit)) = (node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes ils) :) -inlineToNodes (Image ils (url,tit)) = +inlineToNodes (Image _ ils (url,tit)) = (node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes ils) :) inlineToNodes (RawInline fmt xs) | fmt == Format "html" = (node (INLINE_HTML (T.pack xs)) [] :) diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 61e62aa17..bbc5f7132 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -35,10 +35,11 @@ import Text.Pandoc.Writers.Shared import Text.Pandoc.Options import Text.Pandoc.Walk (query) import Text.Printf ( printf ) -import Data.List ( intercalate ) +import Data.List ( intercalate, intersperse ) import Data.Char ( ord ) import Control.Monad.State import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Text.Pandoc.Templates ( renderTemplate' ) import Network.URI ( isURI, unEscapeString ) @@ -141,10 +142,14 @@ blockToConTeXt :: Block blockToConTeXt Null = return empty blockToConTeXt (Plain lst) = inlineListToConTeXt lst -- title beginning with fig: indicates that the image is a figure -blockToConTeXt (Para [Image txt (src,'f':'i':'g':':':_)]) = do +blockToConTeXt (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do capt <- inlineListToConTeXt txt - return $ blankline $$ "\\placefigure" <> braces capt <> - braces ("\\externalfigure" <> brackets (text src)) <> blankline + img <- inlineToConTeXt (Image attr txt (src, "")) + let (ident, _, _) = attr + label = if null ident + then empty + else "[]" <> brackets (text $ toLabel ident) + return $ blankline $$ "\\placefigure" <> label <> braces capt <> img <> blankline blockToConTeXt (Para lst) = do contents <- inlineListToConTeXt lst return $ contents <> blankline @@ -312,7 +317,7 @@ inlineToConTeXt (RawInline _ _) = return empty inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr inlineToConTeXt Space = return space -- Handle HTML-like internal document references to sections -inlineToConTeXt (Link txt (('#' : ref), _)) = do +inlineToConTeXt (Link _ txt (('#' : ref), _)) = do opts <- gets stOptions contents <- inlineListToConTeXt txt let ref' = toLabel $ stringToConTeXt opts ref @@ -320,7 +325,7 @@ inlineToConTeXt (Link txt (('#' : ref), _)) = do <> braces contents <> brackets (text ref') -inlineToConTeXt (Link txt (src, _)) = do +inlineToConTeXt (Link _ txt (src, _)) = do let isAutolink = txt == [Str (unEscapeString src)] st <- get let next = stNextRef st @@ -335,11 +340,29 @@ inlineToConTeXt (Link txt (src, _)) = do else brackets empty <> brackets contents) <> "\\from" <> brackets (text ref) -inlineToConTeXt (Image _ (src, _)) = do - let src' = if isURI src +inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do + opts <- gets stOptions + let showDim dir = let d = text (show dir) <> "=" + in case (dimension dir attr) of + Just (Pixel a) -> + [d <> text (showInInch opts (Pixel a)) <> "in"] + Just (Percent a) -> + [d <> text (showFl (a / 100)) <> "\\textwidth"] + Just dim -> + [d <> text (show dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else brackets $ cat (intersperse "," dimList) + clas = if null cls + then empty + else brackets $ text $ toLabel $ head cls + src' = if isURI src then src else unEscapeString src - return $ braces $ "\\externalfigure" <> brackets (text src') + return $ braces $ "\\externalfigure" <> brackets (text src') <> dims <> clas inlineToConTeXt (Note contents) = do contents' <- blockListToConTeXt contents let codeBlock x@(CodeBlock _ _) = [x] diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 8b7dde3e5..e89828911 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -222,7 +222,7 @@ blockToCustom _ Null = return "" blockToCustom lua (Plain inlines) = callfunc lua "Plain" inlines -blockToCustom lua (Para [Image txt (src,tit)]) = +blockToCustom lua (Para [Image _ txt (src,tit)]) = callfunc lua "CaptionedImage" src tit txt blockToCustom lua (Para inlines) = callfunc lua "Para" inlines @@ -308,10 +308,10 @@ inlineToCustom lua (RawInline format str) = inlineToCustom lua (LineBreak) = callfunc lua "LineBreak" -inlineToCustom lua (Link txt (src,tit)) = +inlineToCustom lua (Link _ txt (src,tit)) = callfunc lua "Link" txt src tit -inlineToCustom lua (Image alt (src,tit)) = +inlineToCustom lua (Image _ alt (src,tit)) = callfunc lua "Image" alt src tit inlineToCustom lua (Note contents) = callfunc lua "Note" contents diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 8f9eecea8..d2c39e3b9 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -42,6 +42,7 @@ import Data.Char ( toLower ) import Data.Monoid ( Any(..) ) import Text.Pandoc.Highlighting ( languages, languagesByExtension ) import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import qualified Text.Pandoc.Builder as B import Text.TeXMath import qualified Text.XML.Light as Xml @@ -150,6 +151,15 @@ listItemToDocbook :: WriterOptions -> [Block] -> Doc listItemToDocbook opts item = inTagsIndented "listitem" $ blocksToDocbook opts $ map plainToPara item +imageToDocbook :: WriterOptions -> Attr -> String -> Doc +imageToDocbook _ attr src = selfClosingTag "imagedata" $ + ("fileref", src) : idAndRole attr ++ dims + where + dims = go Width "width" ++ go Height "depth" + go dir dstr = case (dimension dir attr) of + Just a -> [(dstr, show a)] + Nothing -> [] + -- | Convert a Pandoc block element to Docbook. blockToDocbook :: WriterOptions -> Block -> Doc blockToDocbook _ Null = empty @@ -165,7 +175,7 @@ blockToDocbook opts (Div _ bs) = blocksToDocbook opts $ map plainToPara bs blockToDocbook _ (Header _ _ _) = empty -- should not occur after hierarchicalize blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst -- title beginning with fig: indicates that the image is a figure -blockToDocbook opts (Para [Image txt (src,'f':'i':'g':':':_)]) = +blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = let alt = inlinesToDocbook opts txt capt = if null txt then empty @@ -174,7 +184,7 @@ blockToDocbook opts (Para [Image txt (src,'f':'i':'g':':':_)]) = capt $$ (inTagsIndented "mediaobject" $ (inTagsIndented "imageobject" - (selfClosingTag "imagedata" [("fileref",src)])) $$ + (imageToDocbook opts attr src)) $$ inTagsSimple "textobject" (inTagsSimple "phrase" alt)) blockToDocbook opts (Para lst) | hasLineBreaks lst = flush $ nowrap $ inTagsSimple "literallayout" $ inlinesToDocbook opts lst @@ -321,7 +331,7 @@ inlineToDocbook _ (RawInline f x) | f == "html" || f == "docbook" = text x | otherwise = empty inlineToDocbook _ LineBreak = text "\n" inlineToDocbook _ Space = space -inlineToDocbook opts (Link txt (src, _)) +inlineToDocbook opts (Link attr txt (src, _)) | Just email <- stripPrefix "mailto:" src = let emailLink = inTagsSimple "email" $ text $ escapeStringForXML $ email @@ -331,19 +341,30 @@ inlineToDocbook opts (Link txt (src, _)) char '(' <> emailLink <> char ')' | otherwise = (if isPrefixOf "#" src - then inTags False "link" [("linkend", drop 1 src)] - else inTags False "ulink" [("url", src)]) $ + then inTags False "link" $ ("linkend", drop 1 src) : idAndRole attr + else inTags False "ulink" $ ("url", src) : idAndRole attr ) $ inlinesToDocbook opts txt -inlineToDocbook _ (Image _ (src, tit)) = +inlineToDocbook opts (Image attr _ (src, tit)) = let titleDoc = if null tit then empty else inTagsIndented "objectinfo" $ inTagsIndented "title" (text $ escapeStringForXML tit) in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $ - titleDoc $$ selfClosingTag "imagedata" [("fileref", src)] + titleDoc $$ imageToDocbook opts attr src inlineToDocbook opts (Note contents) = inTagsIndented "footnote" $ blocksToDocbook opts contents isMathML :: HTMLMathMethod -> Bool isMathML (MathML _) = True isMathML _ = False + +idAndRole :: Attr -> [(String, String)] +idAndRole (id',cls,_) = ident ++ role + where + ident = if null id' + then [] + else [("id", id')] + role = if null cls + then [] + else [("role", unwords cls)] + diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 94c9ff28e..dd4a4b258 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -536,7 +536,6 @@ styleToOpenXml sm style = , mknode "w:link" [("w:val","VerbatimChar")] () , mknode "w:pPr" [] $ mknode "w:wordWrap" [("w:val","off")] () - : mknode "w:noProof" [] () : ( maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) $ backgroundColor style ) ] @@ -752,7 +751,7 @@ blockToOpenXML opts (Header lev (ident,_,_) lst) = do blockToOpenXML opts (Plain lst) = withParaProp (pCustomStyle "Compact") $ blockToOpenXML opts (Para lst) -- title beginning with fig: indicates that the image is a figure -blockToOpenXML opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do +blockToOpenXML opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do setFirstPara pushParaProp $ pCustomStyle $ if null alt @@ -760,7 +759,7 @@ blockToOpenXML opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do else "FigureWithCaption" paraProps <- getParaProps False popParaProp - contents <- inlinesToOpenXML opts [Image alt (src,tit)] + contents <- inlinesToOpenXML opts [Image attr alt (src,tit)] captionNode <- withParaProp (pCustomStyle "ImageCaption") $ blockToOpenXML opts (Para alt) return $ mknode "w:p" [] (paraProps ++ contents) : captionNode @@ -1087,11 +1086,11 @@ inlineToOpenXML opts (Note bs) = do [ mknode "w:rPr" [] footnoteStyle , mknode "w:footnoteReference" [("w:id", notenum)] () ] ] -- internal link: -inlineToOpenXML opts (Link txt ('#':xs,_)) = do +inlineToOpenXML opts (Link _ txt ('#':xs,_)) = do contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt return [ mknode "w:hyperlink" [("w:anchor",xs)] contents ] -- external link: -inlineToOpenXML opts (Link txt (src,_)) = do +inlineToOpenXML opts (Link _ txt (src,_)) = do contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt extlinks <- gets stExternalLinks id' <- case M.lookup src extlinks of @@ -1102,7 +1101,7 @@ inlineToOpenXML opts (Link txt (src,_)) = do M.insert src i extlinks } return i return [ mknode "w:hyperlink" [("r:id",id')] contents ] -inlineToOpenXML opts (Image alt (src, tit)) = do +inlineToOpenXML opts (Image attr alt (src, tit)) = do -- first, check to see if we've already done this image pageWidth <- gets stPrintWidth imgs <- gets stImages @@ -1119,7 +1118,8 @@ inlineToOpenXML opts (Image alt (src, tit)) = do Right (img, mt) -> do ident <- ("rId"++) `fmap` getUniqueId (xpt,ypt) <- case imageSize img of - Right size -> return $ sizeInPoints size + Right size -> return $ + desiredSizeInPoints opts attr size Left msg -> do liftIO $ warn $ "Could not determine image size in `" ++ @@ -1211,11 +1211,9 @@ parseXml refArchive distArchive relpath = -- | Scales the image to fit the page -- sizes are passed in emu -fitToPage :: (Integer, Integer) -> Integer -> (Integer, Integer) +fitToPage :: (Double, Double) -> Integer -> (Integer, Integer) fitToPage (x, y) pageWidth -- Fixes width to the page width and scales the height - | x > pageWidth = - (pageWidth, round $ - ((fromIntegral pageWidth) / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y)) - | otherwise = (x, y) - + | x > fromIntegral pageWidth = + (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) + | otherwise = (floor x, floor y) diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index b68c46c7e..730b31fe8 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -47,6 +47,7 @@ import Text.Pandoc.Options ( WriterOptions( import Text.Pandoc.Shared ( escapeURI, removeFormatting, camelCaseToHyphenated , trimr, normalize, substitute ) import Text.Pandoc.Writers.Shared ( defField, metaToJSON ) +import Text.Pandoc.ImageSize import Text.Pandoc.Templates ( renderTemplate' ) import Data.List ( intersect, intercalate, isPrefixOf, transpose ) import Data.Default (Default(..)) @@ -126,7 +127,7 @@ blockToDokuWiki opts (Plain 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 (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToDokuWiki opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return "" else (" " ++) `fmap` inlineListToDokuWiki opts txt @@ -135,7 +136,7 @@ blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do else "|" ++ if null tit then capt else tit ++ capt -- Relative links fail isURI and receive a colon prefix = if isURI src then "" else ":" - return $ "{{" ++ prefix ++ src ++ opt ++ "}}\n" + return $ "{{" ++ prefix ++ src ++ imageDims opts attr ++ opt ++ "}}\n" blockToDokuWiki opts (Para inlines) = do indent <- stIndent <$> ask @@ -462,18 +463,18 @@ inlineToDokuWiki _ (LineBreak) = return "\\\\\n" inlineToDokuWiki _ Space = return " " -inlineToDokuWiki opts (Link txt (src, _)) = do +inlineToDokuWiki opts (Link _ txt (src, _)) = do label <- inlineListToDokuWiki opts txt case txt of [Str s] | "mailto:" `isPrefixOf` src -> return $ "<" ++ s ++ ">" | escapeURI s == src -> return src _ -> if isURI src - then return $ "[[" ++ src ++ "|" ++ label ++ "]]" + then return $ "[[" ++ src ++ "|" ++ label ++ "]]" else return $ "[[" ++ src' ++ "|" ++ label ++ "]]" where src' = case src of '/':xs -> xs -- with leading / it's a _ -> src -- link to a help page -inlineToDokuWiki opts (Image alt (source, tit)) = do +inlineToDokuWiki opts (Image attr alt (source, tit)) = do alt' <- inlineListToDokuWiki opts alt let txt = case (tit, alt) of ("", []) -> "" @@ -481,10 +482,21 @@ inlineToDokuWiki opts (Image alt (source, tit)) = do (_ , _ ) -> "|" ++ tit -- Relative links fail isURI and receive a colon prefix = if isURI source then "" else ":" - return $ "{{" ++ prefix ++ source ++ txt ++ "}}" + return $ "{{" ++ prefix ++ source ++ imageDims opts attr ++ txt ++ "}}" inlineToDokuWiki opts (Note contents) = do contents' <- blockListToDokuWiki opts contents modify (\s -> s { stNotes = True }) return $ "((" ++ contents' ++ "))" -- note - may not work for notes with multiple blocks + +imageDims :: WriterOptions -> Attr -> String +imageDims opts attr = go (toPx $ dimension Width attr) (toPx $ dimension Height attr) + where + toPx = fmap (showInPixel opts) . checkPct + checkPct (Just (Percent _)) = Nothing + checkPct maybeDim = maybeDim + go (Just w) Nothing = "?" ++ w + go (Just w) (Just h) = "?" ++ w ++ "x" ++ h + go Nothing (Just h) = "?0x" ++ h + go Nothing Nothing = "" diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 42f3d5e57..f4989c8ea 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -455,10 +455,10 @@ writeEPUB opts doc@(Pandoc meta _) = do chapters' [1..] let fixInternalReferences :: Inline -> Inline - fixInternalReferences (Link lab ('#':xs, tit)) = + fixInternalReferences (Link attr lab ('#':xs, tit)) = case lookup xs reftable of - Just ys -> Link lab (ys, tit) - Nothing -> Link lab ('#':xs, tit) + Just ys -> Link attr lab (ys, tit) + Nothing -> Link attr lab ('#':xs, tit) fixInternalReferences x = x -- internal reference IDs change when we chunk the file, @@ -870,14 +870,14 @@ transformInline :: WriterOptions -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media -> Inline -> IO Inline -transformInline opts mediaRef (Image lab (src,tit)) = do +transformInline opts mediaRef (Image attr lab (src,tit)) = do newsrc <- modifyMediaRef opts mediaRef src - return $ Image lab (newsrc, tit) + return $ Image attr lab (newsrc, tit) transformInline opts mediaRef (x@(Math t m)) | WebTeX url <- writerHTMLMathMethod opts = do newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m) let mathclass = if t == DisplayMath then "display" else "inline" - return $ Span ("",["math",mathclass],[]) [Image [x] (newsrc, "")] + return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")] transformInline opts mediaRef (RawInline fmt raw) | fmt == Format "html" = do let tags = parseTags raw diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 31fa4bee8..bc936fce5 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -314,8 +314,8 @@ blockToXml :: Block -> FBM [Content] blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2 blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula -- title beginning with fig: indicates that the image is a figure -blockToXml (Para [Image alt (src,'f':'i':'g':':':tit)]) = - insertImage NormalImage (Image alt (src,tit)) +blockToXml (Para [Image atr alt (src,'f':'i':'g':':':tit)]) = + insertImage NormalImage (Image atr alt (src,tit)) blockToXml (Para ss) = liftM (list . el "p") $ cMapM toXml ss blockToXml (CodeBlock _ s) = return . spaceBeforeAfter . map (el "p" . el "code") . lines $ s @@ -442,7 +442,7 @@ toXml Space = return [txt " "] toXml LineBreak = return [el "empty-line" ()] toXml (Math _ formula) = insertMath InlineImage formula toXml (RawInline _ _) = return [] -- raw TeX and raw HTML are suppressed -toXml (Link text (url,ttl)) = do +toXml (Link _ text (url,ttl)) = do fns <- footnotes `liftM` get let n = 1 + length fns let ln_id = linkID n @@ -459,7 +459,7 @@ toXml (Link text (url,ttl)) = do ( [ attr ("l","href") ('#':ln_id) , uattr "type" "note" ] , ln_ref) ] -toXml img@(Image _ _) = insertImage InlineImage img +toXml img@(Image _ _ _) = insertImage InlineImage img toXml (Note bs) = do fns <- footnotes `liftM` get let n = 1 + length fns @@ -478,12 +478,12 @@ insertMath immode formula = do WebTeX url -> do let alt = [Code nullAttr formula] let imgurl = url ++ urlEncode formula - let img = Image alt (imgurl, "") + let img = Image nullAttr alt (imgurl, "") insertImage immode img _ -> return [el "code" formula] insertImage :: ImageMode -> Inline -> FBM [Content] -insertImage immode (Image alt (url,ttl)) = do +insertImage immode (Image _ alt (url,ttl)) = do images <- imagesToFetch `liftM` get let n = 1 + length images let fname = "image" ++ show n @@ -572,8 +572,8 @@ plain Space = " " plain LineBreak = "\n" plain (Math _ s) = s plain (RawInline _ s) = s -plain (Link text (url,_)) = concat (map plain text ++ [" <", url, ">"]) -plain (Image alt _) = concat (map plain alt) +plain (Link _ text (url,_)) = concat (map plain text ++ [" <", url, ">"]) +plain (Image _ alt _) = concat (map plain alt) plain (Note _) = "" -- FIXME -- | Create an XML element. diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 626732ef2..67d398a4d 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -35,6 +35,7 @@ import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Options +import Text.Pandoc.ImageSize import Text.Pandoc.Templates import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Slides @@ -356,10 +357,10 @@ parseMailto s = do _ -> fail "not a mailto: URL" -- | Obfuscate a "mailto:" link. -obfuscateLink :: WriterOptions -> Html -> String -> Html -obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation = - H.a ! A.href (toValue s) $ txt -obfuscateLink opts (renderHtml -> txt) s = +obfuscateLink :: WriterOptions -> Attr -> Html -> String -> Html +obfuscateLink opts attr txt s | writerEmailObfuscation opts == NoObfuscation = + addAttrs opts attr $ H.a ! A.href (toValue s) $ txt +obfuscateLink opts attr (renderHtml -> txt) s = let meth = writerEmailObfuscation opts s' = map toLower (take 7 s) ++ drop 7 s in case parseMailto s' of @@ -385,7 +386,7 @@ obfuscateLink opts (renderHtml -> txt) s = linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >> H.noscript (preEscapedString $ obfuscateString altText) _ -> error $ "Unknown obfuscation method: " ++ show meth - _ -> H.a ! A.href (toValue s) $ toHtml txt -- malformed email + _ -> addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email -- | Obfuscate character as entity. obfuscateChar :: Char -> String @@ -401,11 +402,33 @@ obfuscateString = concatMap obfuscateChar . fromEntities addAttrs :: WriterOptions -> Attr -> Html -> Html addAttrs opts attr h = foldl (!) h (attrsToHtml opts attr) +toAttrs :: [(String, String)] -> [Attribute] +toAttrs kvs = map (\(x,y) -> customAttribute (fromString x) (toValue y)) kvs + attrsToHtml :: WriterOptions -> Attr -> [Attribute] attrsToHtml opts (id',classes',keyvals) = [prefixedId opts id' | not (null id')] ++ - [A.class_ (toValue $ unwords classes') | not (null classes')] ++ - map (\(x,y) -> customAttribute (fromString x) (toValue y)) keyvals + [A.class_ (toValue $ unwords classes') | not (null classes')] ++ toAttrs keyvals + +imgAttrsToHtml :: WriterOptions -> Attr -> [Attribute] +imgAttrsToHtml opts attr = + attrsToHtml opts (ident,cls,kvs') ++ + toAttrs (dimensionsToAttrList opts attr) + where + (ident,cls,kvs) = attr + kvs' = filter isNotDim kvs + isNotDim ("width", _) = False + isNotDim ("height", _) = False + isNotDim _ = True + +dimensionsToAttrList :: WriterOptions -> Attr -> [(String, String)] +dimensionsToAttrList opts attr = (go Width) ++ (go Height) + where + go dir = case (dimension dir attr) of + (Just (Percent a)) -> [("style", show dir ++ ":" ++ show (Percent a))] + (Just dim) -> [(show dir, showInPixel opts dim)] + _ -> [] + imageExts :: [String] imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", @@ -426,8 +449,8 @@ blockToHtml :: WriterOptions -> Block -> State WriterState Html blockToHtml _ Null = return mempty blockToHtml opts (Plain lst) = inlineListToHtml opts lst -- title beginning with fig: indicates that the image is a figure -blockToHtml opts (Para [Image txt (s,'f':'i':'g':':':tit)]) = do - img <- inlineToHtml opts (Image txt (s,tit)) +blockToHtml opts (Para [Image attr txt (s,'f':'i':'g':':':tit)]) = do + img <- inlineToHtml opts (Image attr txt (s,tit)) let tocapt = if writerHtml5 opts then H5.figcaption else H.p ! A.class_ "caption" @@ -792,10 +815,10 @@ inlineToHtml opts inline = _ -> return mempty | f == Format "html" -> return $ preEscapedString str | otherwise -> return mempty - (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do + (Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do linkText <- inlineListToHtml opts txt - return $ obfuscateLink opts linkText s - (Link txt (s,tit)) -> do + return $ obfuscateLink opts attr linkText s + (Link attr txt (s,tit)) -> do linkText <- inlineListToHtml opts txt let s' = case s of '#':xs | writerSlideVariant opts == @@ -805,19 +828,23 @@ inlineToHtml opts inline = let link' = if txt == [Str (unEscapeString s)] then link ! A.class_ "uri" else link + let link'' = addAttrs opts attr link' return $ if null tit - then link' - else link' ! A.title (toValue tit) - (Image txt (s,tit)) | treatAsImage s -> do + then link'' + else link'' ! A.title (toValue tit) + (Image attr txt (s,tit)) | treatAsImage s -> do + let alternate' = stringify txt let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not $ null tit] ++ - [A.alt $ toValue $ stringify txt] + [A.title $ toValue tit | not (null tit)] ++ + [A.alt $ toValue alternate' | not (null txt)] ++ + imgAttrsToHtml opts attr let tag = if writerHtml5 opts then H5.img else H.img return $ foldl (!) tag attributes -- note: null title included, as in Markdown.pl - (Image _ (s,tit)) -> do + (Image attr _ (s,tit)) -> do let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not $ null tit] + [A.title $ toValue tit | not (null tit)] ++ + imgAttrsToHtml opts attr return $ foldl (!) H5.embed attributes -- note: null title included, as in Markdown.pl (Note contents) @@ -855,7 +882,7 @@ blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html blockListToNote opts ref blocks = -- If last block is Para or Plain, include the backlink at the end of -- that block. Otherwise, insert a new Plain block with the backlink. - let backlink = [Link [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] + let backlink = [Link nullAttr [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] blocks' = if null blocks then [] else let lastBlock = last blocks diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 5df6786ac..118d42d7d 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -103,8 +103,8 @@ blockToHaddock opts (Plain inlines) = do contents <- inlineListToHaddock opts inlines return $ contents <> cr -- title beginning with fig: indicates figure -blockToHaddock opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = - blockToHaddock opts (Para [Image alt (src,tit)]) +blockToHaddock opts (Para [Image attr alt (src,'f':'i':'g':':':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) @@ -327,7 +327,7 @@ inlineToHaddock _ (RawInline f str) inlineToHaddock _ (LineBreak) = return cr inlineToHaddock _ Space = return space inlineToHaddock opts (Cite _ lst) = inlineListToHaddock opts lst -inlineToHaddock _opts (Link txt (src, _)) = do +inlineToHaddock _ (Link _ txt (src, _)) = do let linktext = text $ escapeString $ stringify txt let useAuto = isURI src && case txt of @@ -335,8 +335,8 @@ inlineToHaddock _opts (Link txt (src, _)) = do _ -> False return $ nowrap $ "<" <> text src <> (if useAuto then empty else space <> linktext) <> ">" -inlineToHaddock opts (Image alternate (source, tit)) = do - linkhaddock <- inlineToHaddock opts (Link alternate (source, tit)) +inlineToHaddock opts (Image attr alternate (source, tit)) = do + linkhaddock <- inlineToHaddock opts (Link attr alternate (source, tit)) return $ "<" <> linkhaddock <> ">" -- haddock doesn't have notes, but we can fake it: inlineToHaddock opts (Note contents) = do diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 95ea0c643..eb6d135ca 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -18,14 +18,16 @@ import Text.Pandoc.Definition import Text.Pandoc.XML import Text.Pandoc.Readers.TeXMath (texMathToInlines) import Text.Pandoc.Writers.Shared -import Text.Pandoc.Shared (splitBy) +import Text.Pandoc.Shared (splitBy, fetchItem, warn) import Text.Pandoc.Options import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Data.List (isPrefixOf, isInfixOf, stripPrefix) import Data.Text as Text (breakOnAll, pack) import Control.Monad.State import Network.URI (isURI) +import System.FilePath (pathSeparator) import qualified Data.Set as Set type Style = [String] @@ -39,7 +41,7 @@ data WriterState = WriterState{ , maxListDepth :: Int } -type WS a = State WriterState a +type WS a = StateT WriterState IO a defaultWriterState :: WriterState defaultWriterState = WriterState{ @@ -91,6 +93,7 @@ lowerAlphaName :: String upperAlphaName :: String subListParName :: String footnoteName :: String +citeName :: String paragraphName = "Paragraph" codeBlockName = "CodeBlock" blockQuoteName = "Blockquote" @@ -113,30 +116,31 @@ lowerAlphaName = "lowerAlpha" upperAlphaName = "upperAlpha" subListParName = "subParagraph" footnoteName = "Footnote" +citeName = "Cite" -- | Convert Pandoc document to string in ICML format. -writeICML :: WriterOptions -> Pandoc -> String -writeICML opts (Pandoc meta blocks) = +writeICML :: WriterOptions -> Pandoc -> IO String +writeICML opts (Pandoc meta blocks) = do let colwidth = if writerWrapText opts then Just $ writerColumns opts else Nothing render' = render colwidth - renderMeta f s = Just $ render' $ fst $ runState (f opts [] s) defaultWriterState - Just metadata = metaToJSON opts - (renderMeta blocksToICML) - (renderMeta inlinesToICML) - meta - (doc, st) = runState (blocksToICML opts [] blocks) defaultWriterState - main = render' doc + renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState + metadata <- metaToJSON opts + (renderMeta blocksToICML) + (renderMeta inlinesToICML) + meta + (doc, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState + let main = render' doc context = defField "body" main $ defField "charStyles" (render' $ charStylesToDoc st) $ defField "parStyles" (render' $ parStylesToDoc st) $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) $ metadata - in if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + return $ if writerStandalone opts + then renderTemplate' (writerTemplate opts) context + else main -- | Auxilary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] @@ -407,7 +411,7 @@ inlineToICML opts style (Subscript lst) = inlinesToICML opts (subscriptName:styl inlineToICML opts style (SmallCaps lst) = inlinesToICML opts (smallCapsName:style) lst inlineToICML opts style (Quoted SingleQuote lst) = inlinesToICML opts style $ [Str "‘"] ++ lst ++ [Str "’"] inlineToICML opts style (Quoted DoubleQuote lst) = inlinesToICML opts style $ [Str "“"] ++ lst ++ [Str "”"] -inlineToICML opts style (Cite _ lst) = inlinesToICML opts style lst +inlineToICML opts style (Cite _ lst) = inlinesToICML opts (citeName:style) lst inlineToICML _ style (Code _ str) = charStyle (codeName:style) $ text $ escapeStringForXML str inlineToICML _ style Space = charStyle style space inlineToICML _ style LineBreak = charStyle style $ text lineSeparator @@ -416,7 +420,7 @@ inlineToICML opts style (Math mt str) = inlineToICML _ _ (RawInline f str) | f == Format "icml" = return $ text str | otherwise = return empty -inlineToICML opts style (Link lst (url, title)) = do +inlineToICML opts style (Link _ lst (url, title)) = do content <- inlinesToICML opts (linkName:style) lst state $ \st -> let ident = if null $ links st @@ -426,7 +430,7 @@ inlineToICML opts style (Link lst (url, title)) = do cont = inTags True "HyperlinkTextSource" [("Self","htss-"++show ident), ("Name",title), ("Hidden","false")] content in (cont, newst) -inlineToICML opts style (Image alt target) = imageICML opts style alt target +inlineToICML opts style (Image attr alt target) = imageICML opts style attr alt target inlineToICML opts style (Note lst) = footnoteToICML opts style lst inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst @@ -499,39 +503,48 @@ styleToStrAttr style = in (stlStr, attrs) -- | Assemble an ICML Image. -imageICML :: WriterOptions -> Style -> [Inline] -> Target -> WS Doc -imageICML _ style _ (linkURI, _) = - let imgWidth = 300::Int --TODO: set width, height dynamically as in Docx.hs - imgHeight = 200::Int - scaleFact = show (1::Double) --TODO: set scaling factor so image is scaled exactly to imgWidth x imgHeight - hw = show $ imgWidth `div` 2 - hh = show $ imgHeight `div` 2 - qw = show $ imgWidth `div` 4 - qh = show $ imgHeight `div` 4 - uriPrefix = if isURI linkURI then "" else "file:" +imageICML :: WriterOptions -> Style -> Attr -> [Inline] -> Target -> WS Doc +imageICML opts style attr _ (src, _) = do + res <- liftIO $ fetchItem (writerSourceURL opts) src + imgS <- case res of + Left (_) -> do + liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..." + return def + Right (img, _) -> do + case imageSize img of + Right size -> return size + Left msg -> do + return $ warn $ "Could not determine image size in `" ++ + src ++ "': " ++ msg + return def + let (ow, oh) = sizeInPoints imgS + (imgWidth, imgHeight) = desiredSizeInPoints opts attr imgS + hw = showFl $ ow / 2 + hh = showFl $ oh / 2 + scale = showFl (imgWidth / ow) ++ " 0 0 " ++ showFl (imgHeight / oh) + src' = if isURI src then src else "file://." ++ pathSeparator : src (stlStr, attrs) = styleToStrAttr style props = inTags True "Properties" [] $ inTags True "PathGeometry" [] $ inTags True "GeometryPathType" [("PathOpen","false")] $ inTags True "PathPointArray" [] $ vcat [ - selfClosingTag "PathPointType" [("Anchor", "-"++qw++" -"++qh), - ("LeftDirection", "-"++qw++" -"++qh), ("RightDirection", "-"++qw++" -"++qh)] - , selfClosingTag "PathPointType" [("Anchor", "-"++qw++" "++qh), - ("LeftDirection", "-"++qw++" "++qh), ("RightDirection", "-"++qw++" "++qh)] - , selfClosingTag "PathPointType" [("Anchor", qw++" "++qh), - ("LeftDirection", qw++" "++qh), ("RightDirection", qw++" "++qh)] - , selfClosingTag "PathPointType" [("Anchor", qw++" -"++qh), - ("LeftDirection", qw++" -"++qh), ("RightDirection", qw++" -"++qh)] + selfClosingTag "PathPointType" [("Anchor", "-"++hw++" -"++hh), + ("LeftDirection", "-"++hw++" -"++hh), ("RightDirection", "-"++hw++" -"++hh)] + , selfClosingTag "PathPointType" [("Anchor", "-"++hw++" "++hh), + ("LeftDirection", "-"++hw++" "++hh), ("RightDirection", "-"++hw++" "++hh)] + , selfClosingTag "PathPointType" [("Anchor", hw++" "++hh), + ("LeftDirection", hw++" "++hh), ("RightDirection", hw++" "++hh)] + , selfClosingTag "PathPointType" [("Anchor", hw++" -"++hh), + ("LeftDirection", hw++" -"++hh), ("RightDirection", hw++" -"++hh)] ] image = inTags True "Image" - [("Self","ue6"), ("ItemTransform", scaleFact++" 0 0 "++scaleFact++" -"++qw++" -"++qh)] + [("Self","ue6"), ("ItemTransform", scale++" -"++hw++" -"++hh)] $ vcat [ inTags True "Properties" [] $ inTags True "Profile" [("type","string")] $ text "$ID/Embedded" - $$ selfClosingTag "GraphicBounds" [("Left","0"), ("Top","0"), ("Right", hw), ("Bottom", hh)] - , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", uriPrefix++linkURI)] + , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", src')] ] doc = inTags True "CharacterStyleRange" attrs - $ inTags True "Rectangle" [("Self","uec"), ("ItemTransform", "1 0 0 1 "++qw++" -"++qh)] + $ inTags True "Rectangle" [("Self","uec"), ("StrokeWeight", "0"), + ("ItemTransform", scale++" "++hw++" -"++hh)] $ (props $$ image) - in do - state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } ) + state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } ) diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index e9a2e0a56..9e15e0be7 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -47,6 +47,7 @@ import Control.Applicative ((<|>)) import Control.Monad.State import qualified Text.Parsec as P import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Text.Pandoc.Slides import Text.Pandoc.Highlighting (highlight, styleToLaTeX, formatLaTeXInline, formatLaTeXBlock, @@ -99,8 +100,8 @@ pandocToLaTeX options (Pandoc meta blocks) = do _ -> blocks else blocks -- see if there are internal links - let isInternalLink (Link _ ('#':xs,_)) = [xs] - isInternalLink _ = [] + let isInternalLink (Link _ _ ('#':xs,_)) = [xs] + isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } let template = writerTemplate options -- set stBook depending on documentclass @@ -395,7 +396,7 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) = do blockToLaTeX (Plain lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -- title beginning with fig: indicates that the image is a figure -blockToLaTeX (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToLaTeX (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do inNote <- gets stInNote modify $ \st -> st{ stInMinipage = True, stNotes = [] } capt <- inlineListToLaTeX txt @@ -405,7 +406,7 @@ blockToLaTeX (Para [Image txt (src,'f':'i':'g':':':tit)]) = do captForLof <- if null notes then return empty else brackets <$> inlineListToLaTeX (walk deNote txt) - img <- inlineToLaTeX (Image txt (src,tit)) + img <- inlineToLaTeX (Image attr txt (src,tit)) let footnotes = notesToLaTeX notes return $ if inNote -- can't have figures in notes @@ -684,12 +685,19 @@ listItemToLaTeX lst defListItemToLaTeX :: ([Inline], [[Block]]) -> State WriterState Doc defListItemToLaTeX (term, defs) = do term' <- inlineListToLaTeX term + -- put braces around term if it contains an internal link, + -- since otherwise we get bad bracket interactions: \item[\hyperref[..] + let isInternalLink (Link _ _ ('#':_,_)) = True + isInternalLink _ = False + let term'' = if any isInternalLink term + then braces term' + else term' def' <- liftM vsep $ mapM blockListToLaTeX defs return $ case defs of (((Header _ _ _) : _) : _) -> - "\\item" <> brackets term' <> " ~ " $$ def' + "\\item" <> brackets term'' <> " ~ " $$ def' _ -> - "\\item" <> brackets term' $$ def' + "\\item" <> brackets term'' $$ def' -- | Craft the section header, inserting the secton reference, if supplied. sectionHeader :: Bool -- True for unnumbered @@ -893,11 +901,11 @@ inlineToLaTeX (RawInline f str) | otherwise = return empty inlineToLaTeX (LineBreak) = return $ "\\\\" <> cr inlineToLaTeX Space = return space -inlineToLaTeX (Link txt ('#':ident, _)) = do +inlineToLaTeX (Link _ txt ('#':ident, _)) = do contents <- inlineListToLaTeX txt lab <- toLabel ident return $ text "\\protect\\hyperlink" <> braces (text lab) <> braces contents -inlineToLaTeX (Link txt (src, _)) = +inlineToLaTeX (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink do modify $ \s -> s{ stUrl = True } @@ -914,16 +922,31 @@ inlineToLaTeX (Link txt (src, _)) = src' <- stringToLaTeX URLString (escapeURI src) return $ text ("\\href{" ++ src' ++ "}{") <> contents <> char '}' -inlineToLaTeX (Image _ (source, _)) = do +inlineToLaTeX (Image attr _ (source, _)) = do modify $ \s -> s{ stGraphics = True } - let source' = if isURI source + opts <- gets stOptions + let showDim dir = let d = text (show dir) <> "=" + in case (dimension dir attr) of + Just (Pixel a) -> + [d <> text (showInInch opts (Pixel a)) <> "in"] + Just (Percent a) -> + [d <> text (showFl (a / 100)) <> "\\textwidth"] + Just dim -> + [d <> text (show dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else brackets $ cat (intersperse "," dimList) + source' = if isURI source then source else unEscapeString source source'' <- stringToLaTeX URLString (escapeURI source') inHeading <- gets stInHeading return $ - (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") - <> braces (text source'') + (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") <> + dims <> braces (text source'') inlineToLaTeX (Note contents) = do inMinipage <- gets stInMinipage modify (\s -> s{stInNote = True}) diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 6b1e42394..b8b1c1fdd 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -344,7 +344,7 @@ inlineToMan _ (RawInline f str) inlineToMan _ (LineBreak) = return $ cr <> text ".PD 0" $$ text ".P" $$ text ".PD" <> cr inlineToMan _ Space = return space -inlineToMan opts (Link txt (src, _)) = do +inlineToMan opts (Link _ txt (src, _)) = do linktext <- inlineListToMan opts txt let srcSuffix = fromMaybe src (stripPrefix "mailto:" src) return $ case txt of @@ -352,12 +352,12 @@ inlineToMan opts (Link txt (src, _)) = do | escapeURI s == srcSuffix -> char '<' <> text srcSuffix <> char '>' _ -> linktext <> text " (" <> text src <> char ')' -inlineToMan opts (Image alternate (source, tit)) = do +inlineToMan opts (Image attr alternate (source, tit)) = do let txt = if (null alternate) || (alternate == [Str ""]) || (alternate == [Str source]) -- to prevent autolinks then [Str "image"] else alternate - linkPart <- inlineToMan opts (Link txt (source, tit)) + linkPart <- inlineToMan opts (Link attr txt (source, tit)) return $ char '[' <> text "IMAGE: " <> linkPart <> char ']' inlineToMan _ (Note contents) = do -- add to notes in state diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index cd9c26289..898e6c32d 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -55,7 +55,8 @@ import qualified Data.Vector as V import qualified Data.Text as T type Notes = [[Block]] -type Refs = [([Inline], Target)] +type Ref = ([Inline], Target, Attr) +type Refs = [Ref] data WriterState = WriterState { stNotes :: Notes , stRefs :: Refs , stRefShortcutable :: Bool @@ -200,15 +201,16 @@ refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat -- | Return markdown representation of a reference key. keyToMarkdown :: WriterOptions - -> ([Inline], (String, String)) + -> Ref -> State WriterState Doc -keyToMarkdown opts (label, (src, tit)) = do +keyToMarkdown opts (label, (src, tit), attr) = do label' <- inlineListToMarkdown opts label let tit' = if null tit then empty else space <> "\"" <> text tit <> "\"" return $ nest 2 $ hang 2 ("[" <> label' <> "]:" <> space) (text src <> tit') + <> linkAttributes opts attr -- | Return markdown representation of notes. notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc @@ -264,7 +266,7 @@ elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs) not (null subsecs) && lev < writerTOCDepth opts ] where headerLink = if null ident then headerText - else [Link headerText ('#':ident, "")] + else [Link nullAttr headerText ('#':ident, "")] elementToListItem _ (Blk _) = [] attrsToMarkdown :: Attr -> Doc @@ -283,6 +285,12 @@ attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys] map (\(k,v) -> text k <> "=\"" <> text v <> "\"") ks +linkAttributes :: WriterOptions -> Attr -> Doc +linkAttributes opts attr = + if isEnabled Ext_common_link_attributes opts && attr /= nullAttr + then attrsToMarkdown attr + else empty + -- | Ordered list start parser for use in Para below. olMarker :: Parser [Char] ParserState Char olMarker = do (start, style', delim) <- anyOrderedListMarker @@ -328,8 +336,8 @@ blockToMarkdown opts (Plain inlines) = do else contents return $ contents' <> cr -- title beginning with fig: indicates figure -blockToMarkdown opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = - blockToMarkdown opts (Para [Image alt (src,tit)]) +blockToMarkdown opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = + blockToMarkdown opts (Para [Image attr alt (src,tit)]) blockToMarkdown opts (Para inlines) = (<> blankline) `fmap` blockToMarkdown opts (Plain inlines) blockToMarkdown opts (RawBlock f str) @@ -668,21 +676,21 @@ blockListToMarkdown opts blocks = -- | Get reference for target; if none exists, create unique one and return. -- Prefer label if possible; otherwise, generate a unique key. -getReference :: [Inline] -> Target -> State WriterState [Inline] -getReference label (src, tit) = do +getReference :: Attr -> [Inline] -> Target -> State WriterState [Inline] +getReference attr label target = do st <- get - case find ((== (src, tit)) . snd) (stRefs st) of - Just (ref, _) -> return ref + case find (\(_,t,a) -> t == target && a == attr) (stRefs st) of + Just (ref, _, _) -> return ref Nothing -> do - let label' = case find ((== label) . fst) (stRefs st) of + let label' = case find (\(l,_,_) -> l == label) (stRefs st) of Just _ -> -- label is used; generate numerical label case find (\n -> notElem [Str (show n)] - (map fst (stRefs st))) + (map (\(l,_,_) -> l) (stRefs st))) [1..(10000 :: Integer)] of Just x -> [Str (show x)] Nothing -> error "no unique label" Nothing -> label - modify (\s -> s{ stRefs = (label', (src,tit)) : stRefs st }) + modify (\s -> s{ stRefs = (label', target, attr) : stRefs st }) return label' -- | Convert list of Pandoc inline elements to markdown. @@ -692,10 +700,10 @@ inlineListToMarkdown opts lst = do go (if inlist then avoidBadWrapsInList lst else lst) where go [] = return empty go (i:is) = case i of - (Link _ _) -> case is of + (Link _ _ _) -> case is of -- If a link is followed by another link or '[' we don't shortcut - (Link _ _):_ -> unshortcutable - Space:(Link _ _):_ -> unshortcutable + (Link _ _ _):_ -> unshortcutable + Space:(Link _ _ _):_ -> unshortcutable Space:(Str('[':_)):_ -> unshortcutable Space:(RawInline _ ('[':_)):_ -> unshortcutable Space:(Cite _ _):_ -> unshortcutable @@ -897,7 +905,7 @@ inlineToMarkdown opts (Cite (c:cs) lst) return $ pdoc <+> r modekey SuppressAuthor = "-" modekey _ = "" -inlineToMarkdown opts (Link txt (src, tit)) = do +inlineToMarkdown opts (Link attr txt (src, tit)) = do plain <- gets stPlain linktext <- inlineListToMarkdown opts txt let linktitle = if null tit @@ -912,7 +920,7 @@ inlineToMarkdown opts (Link txt (src, tit)) = do shortcutable <- gets stRefShortcutable let useShortcutRefLinks = shortcutable && isEnabled Ext_shortcut_reference_links opts - ref <- if useRefLinks then getReference txt (src, tit) else return [] + ref <- if useRefLinks then getReference attr txt (src, tit) else return [] reftext <- inlineListToMarkdown opts ref return $ if useAuto then if plain @@ -929,14 +937,15 @@ inlineToMarkdown opts (Link txt (src, tit)) = do else if plain then linktext else "[" <> linktext <> "](" <> - text src <> linktitle <> ")" -inlineToMarkdown opts (Image alternate (source, tit)) = do + text src <> linktitle <> ")" <> + linkAttributes opts attr +inlineToMarkdown opts (Image attr alternate (source, tit)) = do plain <- gets stPlain let txt = if null alternate || alternate == [Str source] -- to prevent autolinks then [Str ""] else alternate - linkPart <- inlineToMarkdown opts (Link txt (source, tit)) + linkPart <- inlineToMarkdown opts (Link attr txt (source, tit)) return $ if plain then "[" <> linkPart <> "]" else "!" <> linkPart diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 2b7c47e24..1aae15354 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -35,6 +35,7 @@ import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Pretty (render) +import Text.Pandoc.ImageSize import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) import Data.List ( intersect, intercalate ) @@ -44,6 +45,7 @@ import Control.Monad.State data WriterState = WriterState { stNotes :: Bool -- True if there are notes + , stOptions :: WriterOptions -- writer options } data WriterReader = WriterReader { @@ -57,7 +59,7 @@ type MediaWikiWriter = ReaderT WriterReader (State WriterState) -- | Convert Pandoc to MediaWiki. writeMediaWiki :: WriterOptions -> Pandoc -> String writeMediaWiki opts document = - let initialState = WriterState { stNotes = False } + let initialState = WriterState { stNotes = False, stOptions = opts } env = WriterReader { options = opts, listLevel = [], useTags = False } in evalState (runReaderT (pandocToMediaWiki document) env) initialState @@ -100,14 +102,15 @@ blockToMediaWiki (Plain inlines) = inlineListToMediaWiki inlines -- title beginning with fig: indicates that the image is a figure -blockToMediaWiki (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToMediaWiki (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return "" else ("|caption " ++) `fmap` inlineListToMediaWiki txt + img <- imageToMediaWiki attr let opt = if null txt then "" else "|alt=" ++ if null tit then capt else tit ++ capt - return $ "[[File:" ++ src ++ "|frame|none" ++ opt ++ "]]\n" + return $ "[[File:" ++ src ++ "|frame|none" ++ img ++ opt ++ "]]\n" blockToMediaWiki (Para inlines) = do tags <- asks useTags @@ -312,6 +315,23 @@ alignmentToString alignment = case alignment of AlignCenter -> "center" AlignDefault -> "left" +imageToMediaWiki :: Attr -> MediaWikiWriter String +imageToMediaWiki attr = do + opts <- gets stOptions + let (_, cls, _) = attr + toPx = fmap (showInPixel opts) . checkPct + checkPct (Just (Percent _)) = Nothing + checkPct maybeDim = maybeDim + go (Just w) Nothing = '|':w ++ "px" + go (Just w) (Just h) = '|':w ++ "x" ++ h ++ "px" + go Nothing (Just h) = "|x" ++ h ++ "px" + go Nothing Nothing = "" + dims = go (toPx $ dimension Width attr) (toPx $ dimension Height attr) + classes = if null cls + then "" + else "|class=" ++ unwords cls + return $ dims ++ classes + -- | Convert list of Pandoc block elements to MediaWiki. blockListToMediaWiki :: [Block] -- ^ List of block elements -> MediaWikiWriter String @@ -379,7 +399,7 @@ inlineToMediaWiki (LineBreak) = return "<br />\n" inlineToMediaWiki Space = return " " -inlineToMediaWiki (Link txt (src, _)) = do +inlineToMediaWiki (Link _ txt (src, _)) = do label <- inlineListToMediaWiki txt case txt of [Str s] | isURI src && escapeURI s == src -> return src @@ -390,14 +410,15 @@ inlineToMediaWiki (Link txt (src, _)) = do '/':xs -> xs -- with leading / it's a _ -> src -- link to a help page -inlineToMediaWiki (Image alt (source, tit)) = do +inlineToMediaWiki (Image attr alt (source, tit)) = do + img <- imageToMediaWiki attr alt' <- inlineListToMediaWiki alt let txt = if null tit then if null alt then "" else '|' : alt' else '|' : tit - return $ "[[File:" ++ source ++ txt ++ "]]" + return $ "[[File:" ++ source ++ img ++ txt ++ "]]" inlineToMediaWiki (Note contents) = do contents' <- blockListToMediaWiki contents diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 922a3a785..835e79ce7 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -40,7 +40,7 @@ import Codec.Archive.Zip import Text.Pandoc.Options ( WriterOptions(..) ) import Text.Pandoc.Shared ( stringify, fetchItem', warn, getDefaultReferenceODT ) -import Text.Pandoc.ImageSize ( imageSize, sizeInPoints ) +import Text.Pandoc.ImageSize ( imageSize, desiredSizeInPoints ) import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType ) import Text.Pandoc.Definition import Text.Pandoc.Walk @@ -126,7 +126,7 @@ writeODT opts doc@(Pandoc meta _) = do return $ fromArchive archive'' transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline -transformPicMath opts entriesRef (Image lab (src,t)) = do +transformPicMath opts entriesRef (Image attr lab (src,t)) = do res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case res of Left (_ :: E.SomeException) -> do @@ -134,11 +134,12 @@ transformPicMath opts entriesRef (Image lab (src,t)) = do return $ Emph lab Right (img, mbMimeType) -> do (w,h) <- case imageSize img of - Right size -> return $ sizeInPoints size - Left msg -> do - warn $ "Could not determine image size in `" ++ - src ++ "': " ++ msg - return (0,0) + Right size -> return $ + desiredSizeInPoints opts attr size + Left msg -> do + warn $ "Could not determine image size in `" ++ + src ++ "': " ++ msg + return (0,0) let tit' = show w ++ "x" ++ show h entries <- readIORef entriesRef let extension = fromMaybe (takeExtension $ takeWhile (/='?') src) @@ -150,7 +151,7 @@ transformPicMath opts entriesRef (Image lab (src,t)) = do modifyIORef entriesRef (entry:) let fig | "fig:" `isPrefixOf` t = "fig:" | otherwise = "" - return $ Image lab (newsrc, fig++tit') + return $ Image attr lab (newsrc, fig++tit') transformPicMath _ entriesRef (Math t math) = do entries <- readIORef entriesRef let dt = if t == InlineMath then DisplayInline else DisplayBlock diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 7ee87f4af..dad6b431e 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -286,8 +286,8 @@ blockToOpenDocument o bs | Plain b <- bs = if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b - | Para [Image c (s,'f':'i':'g':':':t)] <- bs - = figure c s t + | Para [Image attr c (s,'f':'i':'g':':':t)] <- bs + = figure attr c s t | Para b <- bs = if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b @@ -342,10 +342,10 @@ blockToOpenDocument o bs return $ inTags True "table:table" [ ("table:name" , name) , ("table:style-name", name) ] (vcat columns $$ th $$ vcat tr) $$ captionDoc - figure caption source title | null caption = - withParagraphStyle o "Figure" [Para [Image caption (source,title)]] + figure attr caption source title | null caption = + withParagraphStyle o "Figure" [Para [Image attr caption (source,title)]] | otherwise = do - imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image caption (source,title)]] + imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image attr caption (source,title)]] captionDoc <- withParagraphStyle o "FigureCaption" [Para caption] return $ imageDoc $$ captionDoc @@ -391,8 +391,8 @@ inlineToOpenDocument o ils | RawInline f s <- ils = if f == Format "opendocument" then return $ text s else return empty - | Link l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l - | Image _ (s,t) <- ils = mkImg s t + | Link _ l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l + | Image attr _ (s,t) <- ils = mkImg attr s t | Note l <- ils = mkNote l | otherwise = return empty where @@ -401,7 +401,7 @@ inlineToOpenDocument o ils , ("xlink:href" , s ) , ("office:name", t ) ] . inSpanTags "Definition" - mkImg s t = do + mkImg _ s t = do id' <- gets stImageId modify (\st -> st{ stImageId = id' + 1 }) return $ inTags False "draw:frame" diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 1b0ab387f..75967fa2a 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -116,12 +116,12 @@ blockToOrg (Div attrs bs) = do nest 2 endTag $$ "#+END_HTML" $$ blankline blockToOrg (Plain inlines) = inlineListToOrg inlines -- title beginning with fig: indicates that the image is a figure -blockToOrg (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return empty else (\c -> "#+CAPTION: " <> c <> blankline) `fmap` inlineListToOrg txt - img <- inlineToOrg (Image txt (src,tit)) + img <- inlineToOrg (Image attr txt (src,tit)) return $ capt <> img blockToOrg (Para inlines) = do contents <- inlineListToOrg inlines @@ -275,7 +275,7 @@ inlineToOrg (RawInline f str) | f == "tex" || f == "latex" = return $ text str inlineToOrg (RawInline _ _) = return empty inlineToOrg (LineBreak) = return (text "\\\\" <> cr) inlineToOrg Space = return space -inlineToOrg (Link txt (src, _)) = do +inlineToOrg (Link _ txt (src, _)) = do case txt of [Str x] | escapeURI x == src -> -- autolink do modify $ \s -> s{ stLinks = True } @@ -283,7 +283,7 @@ inlineToOrg (Link txt (src, _)) = do _ -> do contents <- inlineListToOrg txt modify $ \s -> s{ stLinks = True } return $ "[[" <> text src <> "][" <> contents <> "]]" -inlineToOrg (Image _ (source, _)) = do +inlineToOrg (Image _ _ (source, _)) = do modify $ \s -> s{ stImages = True } return $ "[[" <> text source <> "]]" inlineToOrg (Note contents) = do diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 334619880..94c54c250 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -35,6 +35,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared +import Text.Pandoc.ImageSize import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Builder (deleteMeta) import Data.Maybe (fromMaybe) @@ -49,7 +50,7 @@ type Refs = [([Inline], Target)] data WriterState = WriterState { stNotes :: [[Block]] , stLinks :: Refs - , stImages :: [([Inline], (String, String, Maybe String))] + , stImages :: [([Inline], (Attr, String, String, Maybe String))] , stHasMath :: Bool , stHasRawTeX :: Bool , stOptions :: WriterOptions @@ -138,17 +139,22 @@ noteToRST num note = do return $ nowrap $ marker $$ nest 3 contents -- | Return RST representation of picture reference table. -pictRefsToRST :: [([Inline], (String, String, Maybe String))] +pictRefsToRST :: [([Inline], (Attr, String, String, Maybe String))] -> State WriterState Doc pictRefsToRST refs = mapM pictToRST refs >>= return . vcat -- | Return RST representation of a picture substitution reference. -pictToRST :: ([Inline], (String, String,Maybe String)) +pictToRST :: ([Inline], (Attr, String, String, Maybe String)) -> State WriterState Doc -pictToRST (label, (src, _, mbtarget)) = do +pictToRST (label, (attr, src, _, mbtarget)) = do label' <- inlineListToRST label + dims <- imageDimsToRST attr + let (_, cls, _) = attr + classes = if null cls + then empty + else ":class: " <> text (unwords cls) return $ nowrap - $ ".. |" <> label' <> "| image:: " <> text src + $ ".. |" <> label' <> "| image:: " <> text src $$ hang 3 empty (classes $$ dims) $$ case mbtarget of Nothing -> empty Just t -> " :target: " <> text t @@ -183,11 +189,16 @@ blockToRST (Div attr bs) = do return $ blankline <> startTag $+$ contents $+$ endTag $$ blankline blockToRST (Plain inlines) = inlineListToRST inlines -- title beginning with fig: indicates that the image is a figure -blockToRST (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToRST (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- inlineListToRST txt + dims <- imageDimsToRST attr let fig = "figure:: " <> text src - let alt = ":alt: " <> if null tit then capt else text tit - return $ hang 3 ".. " (fig $$ alt $+$ capt) $$ blankline + alt = ":alt: " <> if null tit then capt else text tit + (_,cls,_) = attr + classes = if null cls + then empty + else ":figclass: " <> text (unwords cls) + return $ hang 3 ".. " (fig $$ alt $$ classes $$ dims $+$ capt) $$ blankline blockToRST (Para inlines) | LineBreak `elem` inlines = do -- use line block if LineBreaks lns <- mapM inlineListToRST $ splitBy (==LineBreak) inlines @@ -382,8 +393,8 @@ inlineListToRST lst = isComplex (Strikeout _) = True isComplex (Superscript _) = True isComplex (Subscript _) = True - isComplex (Link _ _) = True - isComplex (Image _ _) = True + isComplex (Link _ _ _) = True + isComplex (Image _ _ _) = True isComplex (Code _ _) = True isComplex (Math _ _) = True isComplex (Cite _ (x:_)) = isComplex x @@ -436,17 +447,17 @@ inlineToRST (RawInline f x) inlineToRST (LineBreak) = return cr -- there's no line break in RST (see Para) inlineToRST Space = return space -- autolink -inlineToRST (Link [Str str] (src, _)) +inlineToRST (Link _ [Str str] (src, _)) | isURI src && if "mailto:" `isPrefixOf` src then src == escapeURI ("mailto:" ++ str) else src == escapeURI str = do let srcSuffix = fromMaybe src (stripPrefix "mailto:" src) return $ text srcSuffix -inlineToRST (Link [Image alt (imgsrc,imgtit)] (src, _tit)) = do - label <- registerImage alt (imgsrc,imgtit) (Just src) +inlineToRST (Link _ [Image attr alt (imgsrc,imgtit)] (src, _tit)) = do + label <- registerImage attr alt (imgsrc,imgtit) (Just src) return $ "|" <> label <> "|" -inlineToRST (Link txt (src, tit)) = do +inlineToRST (Link _ txt (src, tit)) = do useReferenceLinks <- get >>= return . writerReferenceLinks . stOptions linktext <- inlineListToRST $ normalizeSpaces txt if useReferenceLinks @@ -461,8 +472,8 @@ inlineToRST (Link txt (src, tit)) = do modify $ \st -> st { stLinks = (txt,(src,tit)):refs } return $ "`" <> linktext <> "`_" else return $ "`" <> linktext <> " <" <> text src <> ">`__" -inlineToRST (Image alternate (source, tit)) = do - label <- registerImage alternate (source,tit) Nothing +inlineToRST (Image attr alternate (source, tit)) = do + label <- registerImage attr alternate (source,tit) Nothing return $ "|" <> label <> "|" inlineToRST (Note contents) = do -- add to notes in state @@ -471,16 +482,33 @@ inlineToRST (Note contents) = do let ref = show $ (length notes) + 1 return $ " [" <> text ref <> "]_" -registerImage :: [Inline] -> Target -> Maybe String -> State WriterState Doc -registerImage alt (src,tit) mbtarget = do +registerImage :: Attr -> [Inline] -> Target -> Maybe String -> State WriterState Doc +registerImage attr alt (src,tit) mbtarget = do pics <- get >>= return . stImages txt <- case lookup alt pics of - Just (s,t,mbt) | (s,t,mbt) == (src,tit,mbtarget) -> return alt + Just (a,s,t,mbt) | (a,s,t,mbt) == (attr,src,tit,mbtarget) + -> return alt _ -> do let alt' = if null alt || alt == [Str ""] then [Str $ "image" ++ show (length pics)] else alt modify $ \st -> st { stImages = - (alt', (src,tit, mbtarget)):stImages st } + (alt', (attr,src,tit, mbtarget)):stImages st } return alt' inlineListToRST txt + +imageDimsToRST :: Attr -> State WriterState Doc +imageDimsToRST attr = do + let (ident, _, _) = attr + name = if null ident + then empty + else ":name: " <> text ident + showDim dir = let cols d = ":" <> text (show dir) <> ": " <> text (show d) + in case (dimension dir attr) of + Just (Percent a) -> + case dir of + Height -> empty + Width -> cols (Percent a) + Just dim -> cols dim + Nothing -> empty + return $ cr <> name $$ showDim Width $$ showDim Height diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 9eb02ad02..dabe5cf78 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -46,7 +46,7 @@ import Text.Pandoc.ImageSize -- or a MediaBag, or the internet. -- If file not found or filetype not jpeg or png, leave the inline unchanged. rtfEmbedImage :: WriterOptions -> Inline -> IO Inline -rtfEmbedImage opts x@(Image _ (src,_)) = do +rtfEmbedImage opts x@(Image attr _ (src,_)) = do result <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case result of Right (imgdata, Just mime) @@ -63,12 +63,12 @@ rtfEmbedImage opts x@(Image _ (src,_)) = do return "" Right sz -> return $ "\\picw" ++ show xpx ++ "\\pich" ++ show ypx ++ - "\\picwgoal" ++ show (xpt * 20) - ++ "\\pichgoal" ++ show (ypt * 20) + "\\picwgoal" ++ show (floor (xpt * 20) :: Integer) + ++ "\\pichgoal" ++ show (floor (ypt * 20) :: Integer) -- twip = 1/1440in = 1/20pt where (xpx, ypx) = sizeInPixels sz - (xpt, ypt) = sizeInPoints sz - let raw = "{\\pict" ++ filetype ++ sizeSpec ++ " " ++ + (xpt, ypt) = desiredSizeInPoints opts attr sz + let raw = "{\\pict" ++ filetype ++ sizeSpec ++ "\\bin " ++ concat bytes ++ "}" return $ if B.null imgdata then x @@ -350,10 +350,10 @@ inlineToRTF (RawInline f str) | otherwise = "" inlineToRTF (LineBreak) = "\\line " inlineToRTF Space = " " -inlineToRTF (Link text (src, _)) = +inlineToRTF (Link _ text (src, _)) = "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n" -inlineToRTF (Image _ (source, _)) = +inlineToRTF (Image _ _ (source, _)) = "{\\cf1 [image: " ++ source ++ "]\\cf0}" inlineToRTF (Note contents) = "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 2325d1425..cd9e2ef3d 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -40,6 +40,7 @@ import Data.Ord ( comparing ) import Data.Char ( chr, ord ) import Control.Monad.State import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Network.URI ( isURI, unEscapeString ) import System.FilePath @@ -49,6 +50,7 @@ data WriterState = , stSubscript :: Bool -- document contains subscript , stEscapeComma :: Bool -- in a context where we need @comma , stIdentifiers :: [String] -- header ids used already + , stOptions :: WriterOptions -- writer options } {- TODO: @@ -61,7 +63,8 @@ writeTexinfo :: WriterOptions -> Pandoc -> String writeTexinfo options document = evalState (pandocToTexinfo options $ wrapTop document) $ WriterState { stStrikeout = False, stSuperscript = False, - stEscapeComma = False, stSubscript = False, stIdentifiers = [] } + stEscapeComma = False, stSubscript = False, + stIdentifiers = [], stOptions = options} -- | Add a "Top" node around the document, needed by Texinfo. wrapTop :: Pandoc -> Pandoc @@ -130,12 +133,12 @@ blockToTexinfo (Plain lst) = inlineListToTexinfo lst -- title beginning with fig: indicates that the image is a figure -blockToTexinfo (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToTexinfo (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return empty else (\c -> text "@caption" <> braces c) `fmap` inlineListToTexinfo txt - img <- inlineToTexinfo (Image txt (src,tit)) + img <- inlineToTexinfo (Image attr txt (src,tit)) return $ text "@float" $$ img $$ capt $$ text "@end float" blockToTexinfo (Para lst) = @@ -424,11 +427,11 @@ inlineToTexinfo (RawInline f str) inlineToTexinfo (LineBreak) = return $ text "@*" <> cr inlineToTexinfo Space = return space -inlineToTexinfo (Link txt (src@('#':_), _)) = do +inlineToTexinfo (Link _ txt (src@('#':_), _)) = do contents <- escapeCommas $ inlineListToTexinfo txt return $ text "@ref" <> braces (text (stringToTexinfo src) <> text "," <> contents) -inlineToTexinfo (Link txt (src, _)) = do +inlineToTexinfo (Link _ txt (src, _)) = do case txt of [Str x] | escapeURI x == src -> -- autolink do return $ text $ "@url{" ++ x ++ "}" @@ -437,10 +440,16 @@ inlineToTexinfo (Link txt (src, _)) = do return $ text ("@uref{" ++ src1 ++ ",") <> contents <> char '}' -inlineToTexinfo (Image alternate (source, _)) = do +inlineToTexinfo (Image attr alternate (source, _)) = do content <- escapeCommas $ inlineListToTexinfo alternate - return $ text ("@image{" ++ base ++ ",,,") <> content <> text "," <> - text (ext ++ "}") + opts <- gets stOptions + let showDim dim = case (dimension dim attr) of + (Just (Pixel a)) -> showInInch opts (Pixel a) ++ "in" + (Just (Percent _)) -> "" + (Just d) -> show d + Nothing -> "" + return $ text ("@image{" ++ base ++ ',':(showDim Width) ++ ',':(showDim Height) ++ ",") + <> content <> text "," <> text (ext ++ "}") where ext = drop 1 $ takeExtension source' base = dropExtension source' diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index dbc9eb40a..1d5734c96 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -34,6 +34,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Pretty (render) +import Text.Pandoc.ImageSize import Text.Pandoc.Writers.Shared import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) @@ -116,9 +117,9 @@ blockToTextile opts (Plain inlines) = inlineListToTextile opts inlines -- title beginning with fig: indicates that the image is a figure -blockToTextile opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToTextile opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- blockToTextile opts (Para txt) - im <- inlineToTextile opts (Image txt (src,tit)) + im <- inlineToTextile opts (Image attr txt (src,tit)) return $ im ++ "\n" ++ capt blockToTextile opts (Para inlines) = do @@ -435,23 +436,39 @@ inlineToTextile _ (LineBreak) = return "\n" inlineToTextile _ Space = return " " -inlineToTextile opts (Link txt (src, _)) = do +inlineToTextile opts (Link (_, cls, _) txt (src, _)) = do + let classes = if null cls + then "" + else "(" ++ unwords cls ++ ")" label <- case txt of [Code _ s] | s == src -> return "$" [Str s] | s == src -> return "$" _ -> inlineListToTextile opts txt - return $ "\"" ++ label ++ "\":" ++ src + return $ "\"" ++ classes ++ label ++ "\":" ++ src -inlineToTextile opts (Image alt (source, tit)) = do +inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do alt' <- inlineListToTextile opts alt let txt = if null tit then if null alt' then "" else "(" ++ alt' ++ ")" else "(" ++ tit ++ ")" - return $ "!" ++ source ++ txt ++ "!" + classes = if null cls + then "" + else "(" ++ unwords cls ++ ")" + showDim dir = let toCss str = Just $ show dir ++ ":" ++ str ++ ";" + in case (dimension dir attr) of + Just (Percent a) -> toCss $ show (Percent a) + Just dim -> toCss $ showInPixel opts dim ++ "px" + Nothing -> Nothing + styles = case (showDim Width, showDim Height) of + (Just w, Just h) -> "{" ++ w ++ h ++ "}" + (Just w, Nothing) -> "{" ++ w ++ "height:auto;}" + (Nothing, Just h) -> "{" ++ "width:auto;" ++ h ++ "}" + (Nothing, Nothing) -> "" + return $ "!" ++ classes ++ styles ++ source ++ txt ++ "!" inlineToTextile opts (Note contents) = do curNotes <- liftM stNotes get |