diff options
author | John MacFarlane <jgm@berkeley.edu> | 2015-04-02 21:09:08 -0700 |
---|---|---|
committer | mb21 <mb21@users.noreply.github.com> | 2015-08-07 12:37:12 +0200 |
commit | 92d48fa65bb8b90f6d6b81646a15ce8326083f05 (patch) | |
tree | 04a08d26f789bb0bc62402def33dcd63e3672803 /src/Text | |
parent | 9deb335ca5fbf9f1db0cd1d046d2b59a9a5a55fe (diff) | |
download | pandoc-92d48fa65bb8b90f6d6b81646a15ce8326083f05.tar.gz |
Updated readers and writers for new image attribute parameter.
(mb21)
Diffstat (limited to 'src/Text')
31 files changed, 415 insertions, 188 deletions
diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs index 51a35c8ad..9112979ab 100644 --- a/src/Text/Pandoc/Readers/CommonMark.hs +++ b/src/Text/Pandoc/Readers/CommonMark.hs @@ -115,5 +115,5 @@ addInline (Node _ STRONG nodes) = addInline (Node _ (LINK url title) nodes) = (Link (addInlines nodes) (unpack url, unpack title) :) addInline (Node _ (IMAGE url title) nodes) = - (Image (addInlines nodes) (unpack url, unpack title) :) + (Image nullAttr (addInlines nodes) (unpack url, unpack title) :) addInline _ = id diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 3cc2a4479..cbd50c252 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -633,11 +633,20 @@ addToStart toadd bs = -- A DocBook mediaobject is a wrapper around a set of alternative presentations getMediaobject :: Element -> DB Inlines getMediaobject e = do - imageUrl <- case filterChild (named "imageobject") e of - Nothing -> return mempty - Just z -> case filterChild (named "imagedata") z of - Nothing -> return mempty - Just i -> return $ attrValue "fileref" i + (imageUrl, attr) <- + case filterChild (named "imageobject") e of + Nothing -> return (mempty, nullAttr) + Just z -> case filterChild (named "imagedata") z of + Nothing -> return (mempty, nullAttr) + Just i -> let atVal a = attrValue a i + w = case atVal "width" of + "" -> [] + d -> [("width", d)] + h = case atVal "depth" of + "" -> [] + d -> [("height", d)] + atr = (atVal "id", words $ atVal "role", w ++ h) + in return (atVal "fileref", atr) let getCaption el = case filterChild (\x -> named "caption" x || named "textobject" x || named "alt" x) el of @@ -647,7 +656,7 @@ getMediaobject e = do let (caption, title) = if isNull figTitle then (getCaption e, "") else (return figTitle, "fig:") - liftM (image imageUrl title) caption + liftM (imageWith imageUrl title attr) caption getBlocks :: Element -> DB Blocks getBlocks e = mconcat <$> (mapM parseBlock $ elContent e) diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index 338540533..04edf4c6a 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -101,12 +101,12 @@ fetchImages mimes root arc (query iq -> links) = <$> findEntryByPath abslink arc iq :: Inline -> [FilePath] -iq (Image _ (url, _)) = [url] +iq (Image _ _ (url, _)) = [url] iq _ = [] -- Remove relative paths renameImages :: FilePath -> Inline -> Inline -renameImages root (Image a (url, b)) = Image a (collapseFilePath (root </> url), b) +renameImages root (Image attr a (url, b)) = Image attr a (collapseFilePath (root </> url), b) renameImages _ x = x imageToPandoc :: FilePath -> Pandoc diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index fcba16e04..d0ee893f2 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -609,7 +609,13 @@ pImage = do _ -> url' let title = fromAttrib "title" tag let alt = fromAttrib "alt" tag - return $ B.image (escapeURI url) title (B.text alt) + let uid = fromAttrib "id" tag + let cls = words $ fromAttrib "class" tag + let getAtt k = case fromAttrib k tag of + "" -> [] + v -> [(k, v)] + let kvs = concat $ map getAtt ["width", "height", "sizes", "srcset"] + return $ B.imageWith (escapeURI url) title (uid, cls, kvs) (B.text alt) pCode :: TagParser Inlines pCode = try $ do diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 0da912ea6..def429232 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -55,6 +55,7 @@ import Data.List (intercalate) import qualified Data.Map as M import qualified Control.Exception as E import Text.Pandoc.Highlighting (fromListingsLanguage) +import Text.Pandoc.ImageSize (numUnit, showFl) import Text.Pandoc.Error -- | Parse LaTeX from string and return 'Pandoc' document. @@ -391,7 +392,8 @@ inlineCommand = try $ do star <- option "" (string "*") let name' = name ++ star let raw = do - rawcommand <- getRawCommand name' + rawargs <- withRaw (skipopts *> option "" dimenarg *> many braced) + let rawcommand = '\\' : name ++ star ++ snd rawargs transformed <- applyMacros' rawcommand if transformed /= rawcommand then parseFromString inlines transformed @@ -521,7 +523,9 @@ inlineCommands = M.fromList $ , ("href", (unescapeURL <$> braced <* optional sp) >>= \url -> tok >>= \lab -> pure (link url "" lab)) - , ("includegraphics", skipopts *> (unescapeURL <$> braced) >>= mkImage) + , ("includegraphics", do options <- option [] keyvals + src <- unescapeURL <$> braced + mkImage options src) , ("enquote", enquote) , ("cite", citation "cite" AuthorInText False) , ("citep", citation "citep" NormalCitation False) @@ -582,14 +586,19 @@ inlineCommands = M.fromList $ -- in which case they will appear as raw latex blocks: [ "index" ] -mkImage :: String -> LP Inlines -mkImage src = do +mkImage :: [(String, String)] -> String -> LP Inlines +mkImage options src = do + let replaceTextwidth (k,v) = case numUnit v of + Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%") + _ -> (k, v) + let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options + let attr = ("",[], kvs) let alt = str "image" case takeExtension src of "" -> do defaultExt <- getOption readerDefaultImageExtension - return $ image (addExtension src defaultExt) "" alt - _ -> return $ image src "" alt + return $ imageWith (addExtension src defaultExt) "" attr alt + _ -> return $ imageWith src "" attr alt inNote :: Inlines -> Inlines inNote ils = @@ -970,7 +979,7 @@ readFileFromDirs (d:ds) f = keyval :: LP (String, String) keyval = try $ do key <- many1 alphaNum - val <- option "" $ char '=' >> many1 alphaNum + val <- option "" $ char '=' >> many1 (alphaNum <|> char '.' <|> char '\\') skipMany spaceChar optional (char ',') skipMany spaceChar @@ -997,11 +1006,11 @@ rawLaTeXInline = do addImageCaption :: Blocks -> LP Blocks addImageCaption = walkM go - where go (Image alt (src,tit)) = do + where go (Image attr alt (src,tit)) = do mbcapt <- stateCaption <$> getState return $ case mbcapt of - Just ils -> Image (toList ils) (src, "fig:") - Nothing -> Image alt (src,tit) + Just ils -> Image attr (toList ils) (src, "fig:") + Nothing -> Image attr alt (src,tit) go x = return x addTableCaption :: Blocks -> LP Blocks diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index ea5f5326d..ebca7e83d 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -369,23 +369,26 @@ referenceKey = try $ do let sourceURL = liftM unwords $ many $ try $ do skipMany spaceChar notFollowedBy' referenceTitle + notFollowedBy' $ guardEnabled Ext_common_link_attributes >> attributes notFollowedBy' (() <$ reference) many1 $ notFollowedBy space >> litChar let betweenAngles = try $ char '<' >> manyTill litChar (char '>') src <- try betweenAngles <|> sourceURL tit <- option "" referenceTitle - -- currently we just ignore MMD-style link/image attributes - _kvs <- option [] $ guardEnabled Ext_link_attributes - >> many (try $ spnl >> keyValAttr) + attr <- option nullAttr $ try $ + guardEnabled Ext_common_link_attributes >> skipSpaces >> attributes + addKvs <- option [] $ guardEnabled Ext_link_attributes + >> many (try $ spnl >> keyValAttr) blanklines - let target = (escapeURI $ trimr src, tit) + let attr' = extractIdClass $ foldl (\x f -> f x) attr addKvs + target = (escapeURI $ trimr src, tit) st <- getState let oldkeys = stateKeys st let key = toKey raw case M.lookup key oldkeys of Just _ -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'" Nothing -> return () - updateState $ \s -> s { stateKeys = M.insert key target oldkeys } + updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys } return $ return mempty referenceTitle :: MarkdownParser String @@ -512,9 +515,9 @@ atxHeader = try $ do (text, raw) <- withRaw $ trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline) attr <- atxClosing - attr'@(ident,_,_) <- registerHeader attr (runF text defaultParserState) + attr' <- registerHeader attr (runF text defaultParserState) guardDisabled Ext_implicit_header_references - <|> registerImplicitHeader raw ident + <|> registerImplicitHeader raw attr' return $ B.headerWith attr' level <$> text atxClosing :: MarkdownParser Attr @@ -555,16 +558,16 @@ setextHeader = try $ do many (char underlineChar) blanklines let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1 - attr'@(ident,_,_) <- registerHeader attr (runF text defaultParserState) + attr' <- registerHeader attr (runF text defaultParserState) guardDisabled Ext_implicit_header_references - <|> registerImplicitHeader raw ident + <|> registerImplicitHeader raw attr' return $ B.headerWith attr' level <$> text -registerImplicitHeader :: String -> String -> MarkdownParser () -registerImplicitHeader raw ident = do +registerImplicitHeader :: String -> Attr -> MarkdownParser () +registerImplicitHeader raw attr@(ident, _, _) = do let key = toKey $ "[" ++ raw ++ "]" updateState (\s -> s { stateHeaderKeys = - M.insert key ('#':ident,"") (stateHeaderKeys s) }) + M.insert key (('#':ident,""), attr) (stateHeaderKeys s) }) -- -- hrule block @@ -971,11 +974,11 @@ para = try $ do return $ do result' <- result case B.toList result' of - [Image alt (src,tit)] + [Image attr alt (src,tit)] | Ext_implicit_figures `Set.member` exts -> -- the fig: at beginning of title indicates a figure return $ B.para $ B.singleton - $ Image alt (src,'f':'i':'g':':':tit) + $ Image attr alt (src,'f':'i':'g':':':tit) _ -> return $ B.para result' plain :: MarkdownParser (F Blocks) @@ -1700,16 +1703,18 @@ link = try $ do setState $ st{ stateAllowLinks = False } (lab,raw) <- reference setState $ st{ stateAllowLinks = True } - regLink B.link lab <|> referenceLink B.link (lab,raw) + regLink B.linkWith lab <|> referenceLink B.linkWith (lab,raw) -regLink :: (String -> String -> Inlines -> Inlines) +regLink :: (String -> String -> Attr -> Inlines -> Inlines) -> F Inlines -> MarkdownParser (F Inlines) regLink constructor lab = try $ do (src, tit) <- source - return $ constructor src tit <$> lab + attr <- option nullAttr $ + guardEnabled Ext_common_link_attributes >> attributes + return $ constructor src tit attr <$> lab -- a link like [this][ref] or [this][] or [this] -referenceLink :: (String -> String -> Inlines -> Inlines) +referenceLink :: (String -> String -> Attr -> Inlines -> Inlines) -> (F Inlines, String) -> MarkdownParser (F Inlines) referenceLink constructor (lab, raw) = do sp <- (True <$ lookAhead (char ' ')) <|> return False @@ -1721,7 +1726,7 @@ referenceLink constructor (lab, raw) = do let labIsRef = raw' == "" || raw' == "[]" let key = toKey $ if labIsRef then raw else raw' parsedRaw <- parseFromString (mconcat <$> many inline) raw' - fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw + fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw implicitHeaderRefs <- option False $ True <$ guardEnabled Ext_implicit_header_references let makeFallback = do @@ -1738,10 +1743,10 @@ referenceLink constructor (lab, raw) = do then do headerKeys <- asksF stateHeaderKeys case M.lookup key headerKeys of - Just (src, tit) -> constructor src tit <$> lab - Nothing -> makeFallback + Just ((src, tit), _) -> constructor src tit nullAttr <$> lab + Nothing -> makeFallback else makeFallback - Just (src,tit) -> constructor src tit <$> lab + Just ((src,tit), attr) -> constructor src tit attr <$> lab dropBrackets :: String -> String dropBrackets = reverse . dropRB . reverse . dropLB @@ -1776,8 +1781,8 @@ image = try $ do (lab,raw) <- reference defaultExt <- getOption readerDefaultImageExtension let constructor src = case takeExtension src of - "" -> B.image (addExtension src defaultExt) - _ -> B.image src + "" -> B.imageWith (addExtension src defaultExt) + _ -> B.imageWith src regLink constructor lab <|> referenceLink constructor (lab,raw) note :: MarkdownParser (F Inlines) @@ -1913,7 +1918,7 @@ textualCite = try $ do spc | null spaces' = mempty | otherwise = B.space lab <- parseFromString (mconcat <$> many inline) $ dropBrackets raw' - fallback <- referenceLink B.link (lab,raw') + fallback <- referenceLink B.linkWith (lab,raw') return $ do fallback' <- fallback cs' <- cs diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index 2a5adab22..6f7da2586 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -577,21 +577,29 @@ image = try $ do sym "[[" choice imageIdentifiers fname <- many1 (noneOf "|]") - _ <- many (try $ char '|' *> imageOption) + _ <- many imageOption + dims <- try (char '|' *> (sepBy (many digit) (char 'x')) <* string "px") + <|> return [] + _ <- many imageOption + let kvs = case dims of + w:[] -> [("width", w)] + w:(h:[]) -> [("width", w), ("height", h)] + _ -> [] + let attr = ("", [], kvs) caption <- (B.str fname <$ sym "]]") <|> try (char '|' *> (mconcat <$> manyTill inline (sym "]]"))) - return $ B.image fname ("fig:" ++ stringify caption) caption + return $ B.imageWith fname ("fig:" ++ stringify caption) attr caption imageOption :: MWParser String -imageOption = - try (oneOfStrings [ "border", "thumbnail", "frameless" - , "thumb", "upright", "left", "right" - , "center", "none", "baseline", "sub" - , "super", "top", "text-top", "middle" - , "bottom", "text-bottom" ]) - <|> try (string "frame") - <|> try (many1 (oneOf "x0123456789") <* string "px") - <|> try (oneOfStrings ["link=","alt=","page=","class="] <* many (noneOf "|]")) +imageOption = try $ char '|' *> opt + where + opt = try (oneOfStrings [ "border", "thumbnail", "frameless" + , "thumb", "upright", "left", "right" + , "center", "none", "baseline", "sub" + , "super", "top", "text-top", "middle" + , "bottom", "text-bottom" ]) + <|> try (string "frame") + <|> try (oneOfStrings ["link=","alt=","page=","class="] <* many (noneOf "|]")) collapseUnderscores :: String -> String collapseUnderscores [] = [] diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 678eecc52..8969c3176 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -812,9 +812,9 @@ substKey = try $ do res <- B.toList <$> directive' il <- case res of -- use alt unless :alt: attribute on image: - [Para [Image [Str "image"] (src,tit)]] -> + [Para [Image _ [Str "image"] (src,tit)]] -> return $ B.image src tit alt - [Para [Link [Image [Str "image"] (src,tit)] (src',tit')]] -> + [Para [Link [Image _ [Str "image"] (src,tit)] (src',tit')]] -> return $ B.link src' tit' (B.image src tit alt) [Para ils] -> return $ B.fromList ils _ -> mzero @@ -827,7 +827,8 @@ anonymousKey = try $ do src <- targetURI pos <- getPosition let key = toKey $ "_" ++ printf "%09d" (sourceLine pos) - updateState $ \s -> s { stateKeys = M.insert key (src,"") $ stateKeys s } + --TODO: parse width, height, class and name attributes + updateState $ \s -> s { stateKeys = M.insert key ((src,""), nullAttr) $ stateKeys s } stripTicks :: String -> String stripTicks = reverse . stripTick . reverse . stripTick @@ -841,7 +842,8 @@ regularKey = try $ do char ':' src <- targetURI let key = toKey $ stripTicks ref - updateState $ \s -> s { stateKeys = M.insert key (src,"") $ stateKeys s } + --TODO: parse width, height, class and name attributes + updateState $ \s -> s { stateKeys = M.insert key ((src,""), nullAttr) $ stateKeys s } -- -- tables @@ -1131,12 +1133,12 @@ referenceLink = try $ do if null anonKeys then mzero else return (head anonKeys) - (src,tit) <- case M.lookup key keyTable of - Nothing -> fail "no corresponding key" - Just target -> return target + ((src,tit), attr) <- case M.lookup key keyTable of + Nothing -> fail "no corresponding key" + Just val -> return val -- if anonymous link, remove key so it won't be used again when (isAnonKey key) $ updateState $ \s -> s{ stateKeys = M.delete key keyTable } - return $ B.link src tit label' + return $ B.linkWith src tit attr label' autoURI :: RSTParser Inlines autoURI = do diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index c09c2f2a0..a816af8b9 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -509,8 +509,8 @@ normalizeInlines (Quoted qt ils : ys) = Quoted qt (normalizeInlines ils) : normalizeInlines ys normalizeInlines (Link ils t : ys) = Link (normalizeInlines ils) t : normalizeInlines ys -normalizeInlines (Image ils t : ys) = - Image (normalizeInlines ils) t : normalizeInlines ys +normalizeInlines (Image attr ils t : ys) = + Image attr (normalizeInlines ils) t : normalizeInlines ys normalizeInlines (Cite cs ils : ys) = Cite cs (normalizeInlines ils) : normalizeInlines ys normalizeInlines (x : xs) = x : normalizeInlines xs diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index bac28e54f..8b36ef5c6 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(..)) @@ -127,8 +128,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 @@ -409,7 +410,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"] @@ -417,8 +418,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..c65b8de37 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -155,7 +155,7 @@ inlineToNodes (SmallCaps xs) = [node (INLINE_HTML (T.pack "</span>")) []]) ++ ) 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 1f8bbcdba..97f61dac8 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 ) @@ -136,10 +137,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 @@ -321,11 +326,30 @@ 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 _ (src, _)) = do + opts <- gets stOptions + let (_,cls,_) = attr + 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 3a9c1954a..18b1bec5f 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -223,7 +223,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 @@ -312,7 +312,7 @@ inlineToCustom lua (LineBreak) = callfunc lua "LineBreak" 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 f3b99e141..af289d45e 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -43,6 +43,7 @@ import Control.Applicative ((<$>)) 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 @@ -151,6 +152,22 @@ 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):ident + ++ roles ++ dims + where + (idStr,cls,_) = attr + ident = if null idStr + then [] + else [("id", idStr)] + roles = if null cls + then [] + else [("role", unwords cls)] + 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 @@ -166,7 +183,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 @@ -175,7 +192,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 @@ -335,13 +352,13 @@ inlineToDocbook opts (Link txt (src, _)) then inTags False "link" [("linkend", drop 1 src)] else inTags False "ulink" [("url", src)]) $ 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 diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index da4c78cef..a17be3ca0 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -537,7 +537,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 ) ] @@ -753,7 +752,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 @@ -761,7 +760,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 @@ -1103,7 +1102,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 @@ -1120,7 +1119,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 `" ++ @@ -1212,11 +1212,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 7ebe09db7..915821050 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(..)) @@ -127,7 +128,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 @@ -136,7 +137,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 @@ -474,7 +475,7 @@ inlineToDokuWiki opts (Link txt (src, _)) = do 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 ("", []) -> "" @@ -482,10 +483,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 8577c0fa2..950d5cde3 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -871,9 +871,9 @@ 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 _ (x@(Math _ _)) | WebTeX _ <- writerHTMLMathMethod opts = do raw <- makeSelfContained opts $ writeHtmlInline opts x diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 31fa4bee8..f8f007185 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 @@ -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 @@ -573,7 +573,7 @@ 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 (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 a2778ea97..436c5b343 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -34,6 +34,7 @@ import Text.Pandoc.Definition 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 @@ -407,11 +408,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", @@ -432,8 +455,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" @@ -801,16 +824,19 @@ inlineToHtml opts inline = return $ if null tit then link' else link' ! A.title (toValue tit) - (Image txt (s,tit)) | treatAsImage s -> do + (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) diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 14f398da9..49a9953b6 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) @@ -335,7 +335,7 @@ 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 +inlineToHaddock opts (Image _ alternate (source, tit)) = do linkhaddock <- inlineToHaddock opts (Link alternate (source, tit)) return $ "<" <> linkhaddock <> ">" -- haddock doesn't have notes, but we can fake it: diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 506edd182..76ad1c510 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -46,6 +46,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, @@ -335,15 +336,20 @@ blockToLaTeX (Div (identifier,classes,_) 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 capt <- inlineListToLaTeX txt - img <- inlineToLaTeX (Image txt (src,tit)) + img <- inlineToLaTeX (Image attr txt (src,tit)) + let (ident, _, _) = attr + idn <- toLabel ident + let label = if null ident + then empty + else "\\label" <> braces (text idn) return $ if inNote -- can't have figures in notes then "\\begin{center}" $$ img $+$ capt $$ "\\end{center}" else "\\begin{figure}[htbp]" $$ "\\centering" $$ img $$ - ("\\caption" <> braces capt) $$ "\\end{figure}" + ("\\caption" <> braces capt) $$ label $$ "\\end{figure}" -- . . . indicates pause in beamer slides blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do beamer <- writerBeamer `fmap` gets stOptions @@ -843,16 +849,31 @@ inlineToLaTeX (Link txt (src, _)) = src' <- stringToLaTeX URLString 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 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 f91367eb9..5a49428f6 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -350,7 +350,7 @@ 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 _ alternate (source, tit)) = do let txt = if (null alternate) || (alternate == [Str ""]) || (alternate == [Str source]) -- to prevent autolinks then [Str "image"] diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 804f4101d..f809e5d19 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -325,8 +325,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) @@ -916,7 +916,7 @@ inlineToMarkdown opts (Link txt (src, tit)) = do then linktext else "[" <> linktext <> "](" <> text src <> linktitle <> ")" -inlineToMarkdown opts (Image alternate (source, tit)) = do +inlineToMarkdown opts (Image attr alternate (source, tit)) = do plain <- gets stPlain let txt = if null alternate || alternate == [Str source] -- to prevent autolinks @@ -925,7 +925,11 @@ inlineToMarkdown opts (Image alternate (source, tit)) = do linkPart <- inlineToMarkdown opts (Link txt (source, tit)) return $ if plain then "[" <> linkPart <> "]" - else "!" <> linkPart + else "!" <> linkPart <> + if isEnabled Ext_common_link_attributes opts + && attr /= nullAttr + then attrsToMarkdown attr + else empty inlineToMarkdown opts (Note contents) = do modify (\st -> st{ stNotes = contents : stNotes st }) st <- get diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 2b7c47e24..5c51157ea 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 @@ -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 b87a391fb..f7df74246 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -41,7 +41,7 @@ import Control.Applicative ((<$>)) 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 @@ -127,7 +127,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 @@ -135,11 +135,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) @@ -151,7 +152,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 83e17c943..1935a630f 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -288,8 +288,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 @@ -344,10 +344,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 @@ -394,7 +394,7 @@ inlineToOpenDocument o ils 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 + | Image attr _ (s,t) <- ils = mkImg attr s t | Note l <- ils = mkNote l | otherwise = return empty where @@ -403,7 +403,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 90b396cae..ffd271810 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -117,12 +117,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 @@ -284,7 +284,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 151d3c2ae..4b68984d0 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) @@ -50,7 +51,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 @@ -136,17 +137,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 @@ -181,11 +187,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 @@ -380,7 +391,7 @@ inlineListToRST lst = isComplex (Superscript _) = True isComplex (Subscript _) = True isComplex (Link _ _) = True - isComplex (Image _ _) = True + isComplex (Image _ _ _) = True isComplex (Code _ _) = True isComplex (Math _ _) = True isComplex _ = False @@ -438,8 +449,8 @@ inlineToRST (Link [Str str] (src, _)) 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 useReferenceLinks <- get >>= return . writerReferenceLinks . stOptions @@ -456,8 +467,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 @@ -466,16 +477,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..c89e88fad 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 @@ -353,7 +353,7 @@ inlineToRTF Space = " " 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..a8e1e15a6 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) = @@ -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 126c1e62e..dde9a7177 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 ) @@ -115,9 +116,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 @@ -434,14 +435,28 @@ inlineToTextile opts (Link txt (src, _)) = do _ -> inlineListToTextile opts txt return $ "\"" ++ label ++ "\":" ++ src -inlineToTextile opts (Image alt (source, tit)) = do +inlineToTextile opts (Image attr 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 ++ "!" + (_, cls, _) = attr + 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 |