aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/ImageSize.hs153
-rw-r--r--src/Text/Pandoc/Options.hs5
-rw-r--r--src/Text/Pandoc/PDF.hs12
-rw-r--r--src/Text/Pandoc/Parsing.hs16
-rw-r--r--src/Text/Pandoc/Pretty.hs2
-rw-r--r--src/Text/Pandoc/Readers/CommonMark.hs4
-rw-r--r--src/Text/Pandoc/Readers/DocBook.hs24
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs4
-rw-r--r--src/Text/Pandoc/Readers/EPUB.hs12
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs26
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs29
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs57
-rw-r--r--src/Text/Pandoc/Readers/MediaWiki.hs30
-rw-r--r--src/Text/Pandoc/Readers/RST.hs18
-rw-r--r--src/Text/Pandoc/Shared.hs8
-rw-r--r--src/Text/Pandoc/Writers/AsciiDoc.hs24
-rw-r--r--src/Text/Pandoc/Writers/CommonMark.hs4
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs41
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs6
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs35
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs24
-rw-r--r--src/Text/Pandoc/Writers/DokuWiki.hs24
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs12
-rw-r--r--src/Text/Pandoc/Writers/FB2.hs16
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs67
-rw-r--r--src/Text/Pandoc/Writers/Haddock.hs10
-rw-r--r--src/Text/Pandoc/Writers/ICML.hs95
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs47
-rw-r--r--src/Text/Pandoc/Writers/Man.hs6
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs51
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs33
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs17
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs16
-rw-r--r--src/Text/Pandoc/Writers/Org.hs8
-rw-r--r--src/Text/Pandoc/Writers/RST.hs68
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs14
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs25
-rw-r--r--src/Text/Pandoc/Writers/Textile.hs29
38 files changed, 728 insertions, 344 deletions
diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs
index a38a9dcd1..5c775c908 100644
--- a/src/Text/Pandoc/ImageSize.hs
+++ b/src/Text/Pandoc/ImageSize.hs
@@ -29,16 +29,36 @@ Portability : portable
Functions for determining the size of a PNG, JPEG, or GIF image.
-}
-module Text.Pandoc.ImageSize ( ImageType(..), imageType, imageSize,
- sizeInPixels, sizeInPoints ) where
+module Text.Pandoc.ImageSize ( ImageType(..)
+ , imageType
+ , imageSize
+ , sizeInPixels
+ , sizeInPoints
+ , desiredSizeInPoints
+ , Dimension(..)
+ , Direction(..)
+ , dimension
+ , inInch
+ , inPoints
+ , numUnit
+ , showInInch
+ , showInPixel
+ , showFl
+ ) where
import Data.ByteString (ByteString, unpack)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL
+import Data.Char (isDigit)
import Control.Monad
import Data.Bits
import Data.Binary
import Data.Binary.Get
import Text.Pandoc.Shared (safeRead, hush)
+import Data.Default (Default)
+import Numeric (showFFloat)
+import Text.Read (readMaybe)
+import Text.Pandoc.Definition
+import Text.Pandoc.Options
import qualified Data.Map as M
import Text.Pandoc.Compat.Except
import Control.Monad.Trans
@@ -48,6 +68,20 @@ import Data.Maybe (fromMaybe)
-- algorithms borrowed from wwwis.pl
data ImageType = Png | Gif | Jpeg | Pdf | Eps deriving Show
+data Direction = Width | Height
+instance Show Direction where
+ show Width = "width"
+ show Height = "height"
+
+data Dimension = Pixel Integer
+ | Centimeter Double
+ | Inch Double
+ | Percent Double
+instance Show Dimension where
+ show (Pixel a) = show a ++ "px"
+ show (Centimeter a) = showFl a ++ "cm"
+ show (Inch a) = showFl a ++ "in"
+ show (Percent a) = show a ++ "%"
data ImageSize = ImageSize{
pxX :: Integer
@@ -55,7 +89,11 @@ data ImageSize = ImageSize{
, dpiX :: Integer
, dpiY :: Integer
} deriving (Read, Show, Eq)
+instance Default ImageSize where
+ def = ImageSize 300 200 72 72
+showFl :: (RealFloat a) => a -> String
+showFl a = showFFloat (Just 5) a ""
imageType :: ByteString -> Maybe ImageType
imageType img = case B.take 4 img of
@@ -87,8 +125,93 @@ defaultSize = (72, 72)
sizeInPixels :: ImageSize -> (Integer, Integer)
sizeInPixels s = (pxX s, pxY s)
-sizeInPoints :: ImageSize -> (Integer, Integer)
-sizeInPoints s = (pxX s * 72 `div` dpiX s, pxY s * 72 `div` dpiY s)
+-- | Calculate (height, width) in points using the image file's dpi metadata,
+-- using 72 Points == 1 Inch.
+sizeInPoints :: ImageSize -> (Double, Double)
+sizeInPoints s = (pxXf * 72 / dpiXf, pxYf * 72 / dpiYf)
+ where
+ pxXf = fromIntegral $ pxX s
+ pxYf = fromIntegral $ pxY s
+ dpiXf = fromIntegral $ dpiX s
+ dpiYf = fromIntegral $ dpiY s
+
+-- | Calculate (height, width) in points, considering the desired dimensions in the
+-- attribute, while falling back on the image file's dpi metadata if no dimensions
+-- are specified in the attribute (or only dimensions in percentages).
+desiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> (Double, Double)
+desiredSizeInPoints opts attr s =
+ case (getDim Width, getDim Height) of
+ (Just w, Just h) -> (w, h)
+ (Just w, Nothing) -> (w, w / ratio)
+ (Nothing, Just h) -> (h * ratio, h)
+ (Nothing, Nothing) -> sizeInPoints s
+ where
+ ratio = fromIntegral (pxX s) / fromIntegral (pxY s)
+ getDim dir = case (dimension dir attr) of
+ Just (Percent _) -> Nothing
+ Just dim -> Just $ inPoints opts dim
+ Nothing -> Nothing
+
+inPoints :: WriterOptions -> Dimension -> Double
+inPoints opts dim = 72 * inInch opts dim
+
+inInch :: WriterOptions -> Dimension -> Double
+inInch opts dim =
+ case dim of
+ (Pixel a) -> fromIntegral a / (fromIntegral $ writerDpi opts)
+ (Centimeter a) -> a * 0.3937007874
+ (Inch a) -> a
+ (Percent _) -> 0
+
+-- | Convert a Dimension to a String denoting its equivalent in inches, for example "2.00000".
+-- Note: Dimensions in percentages are converted to the empty string.
+showInInch :: WriterOptions -> Dimension -> String
+showInInch _ (Percent _) = ""
+showInInch opts dim = showFl $ inInch opts dim
+
+-- | Convert a Dimension to a String denoting its equivalent in pixels, for example "600".
+-- Note: Dimensions in percentages are converted to the empty string.
+showInPixel :: WriterOptions -> Dimension -> String
+showInPixel opts dim =
+ case dim of
+ (Pixel a) -> show a
+ (Centimeter a) -> show (floor $ dpi * a * 0.3937007874 :: Int)
+ (Inch a) -> show (floor $ dpi * a :: Int)
+ (Percent _) -> ""
+ where
+ dpi = fromIntegral $ writerDpi opts
+
+-- | Maybe split a string into a leading number and trailing unit, e.g. "3cm" to Just (3.0, "cm")
+numUnit :: String -> Maybe (Double, String)
+numUnit s =
+ let (nums, unit) = span (\c -> isDigit c || ('.'==c)) s
+ in case readMaybe nums of
+ Just n -> Just (n, unit)
+ Nothing -> Nothing
+
+-- | Read a Dimension from an Attr attribute.
+-- `dimension Width attr` might return `Just (Pixel 3)` or for example `Just (Centimeter 2.0)`, etc.
+dimension :: Direction -> Attr -> Maybe Dimension
+dimension dir (_, _, kvs) =
+ case dir of
+ Width -> extractDim "width"
+ Height -> extractDim "height"
+ where
+ extractDim key =
+ case lookup key kvs of
+ Just str ->
+ case numUnit str of
+ Just (num, unit) -> toDim num unit
+ Nothing -> Nothing
+ Nothing -> Nothing
+ toDim a "cm" = Just $ Centimeter a
+ toDim a "mm" = Just $ Centimeter (a / 10)
+ toDim a "in" = Just $ Inch a
+ toDim a "inch" = Just $ Inch a
+ toDim a "%" = Just $ Percent a
+ toDim a "px" = Just $ Pixel (floor a::Integer)
+ toDim a "" = Just $ Pixel (floor a::Integer)
+ toDim _ _ = Nothing
epsSize :: ByteString -> Maybe ImageSize
epsSize img = do
@@ -278,21 +401,21 @@ exifHeader hdr = do
return (tag, payload)
entries <- sequence $ replicate (fromIntegral numentries) ifdEntry
subentries <- case lookup ExifOffset entries of
- Just (UnsignedLong offset) -> do
+ Just (UnsignedLong offset') -> do
pos <- lift bytesRead
- lift $ skip (fromIntegral offset - (fromIntegral pos - 8))
+ lift $ skip (fromIntegral offset' - (fromIntegral pos - 8))
numsubentries <- lift getWord16
sequence $
replicate (fromIntegral numsubentries) ifdEntry
_ -> return []
let allentries = entries ++ subentries
- (width, height) <- case (lookup ExifImageWidth allentries,
- lookup ExifImageHeight allentries) of
- (Just (UnsignedLong w), Just (UnsignedLong h)) ->
- return (fromIntegral w, fromIntegral h)
- _ -> return defaultSize
- -- we return a default width and height when
- -- the exif header doesn't contain these
+ (wdth, hght) <- case (lookup ExifImageWidth allentries,
+ lookup ExifImageHeight allentries) of
+ (Just (UnsignedLong w), Just (UnsignedLong h)) ->
+ return (fromIntegral w, fromIntegral h)
+ _ -> return defaultSize
+ -- we return a default width and height when
+ -- the exif header doesn't contain these
let resfactor = case lookup ResolutionUnit allentries of
Just (UnsignedShort 1) -> (100 / 254)
_ -> 1
@@ -301,8 +424,8 @@ exifHeader hdr = do
let yres = maybe 72 (\(UnsignedRational x) -> floor $ x * resfactor)
$ lookup YResolution allentries
return $ ImageSize{
- pxX = width
- , pxY = height
+ pxX = wdth
+ , pxY = hght
, dpiX = xres
, dpiY = yres }
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index 158303acd..1dc3bad3a 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -86,6 +86,7 @@ data Extension =
| Ext_markdown_attribute -- ^ Interpret text inside HTML as markdown
-- iff container has attribute 'markdown'
| Ext_escaped_line_breaks -- ^ Treat a backslash at EOL as linebreak
+ | Ext_common_link_attributes -- ^ link and image attributes
| Ext_link_attributes -- ^ MMD style reference link attributes
| Ext_autolink_bare_uris -- ^ Make all absolute URIs into links
| Ext_fancy_lists -- ^ Enable fancy list numbers and delimiters
@@ -155,6 +156,7 @@ pandocExtensions = Set.fromList
, Ext_subscript
, Ext_auto_identifiers
, Ext_header_attributes
+ , Ext_common_link_attributes
, Ext_implicit_header_references
, Ext_line_blocks
, Ext_shortcut_reference_links
@@ -188,6 +190,7 @@ phpMarkdownExtraExtensions = Set.fromList
, Ext_definition_lists
, Ext_intraword_underscores
, Ext_header_attributes
+ , Ext_common_link_attributes
, Ext_abbreviations
, Ext_shortcut_reference_links
]
@@ -335,6 +338,7 @@ data WriterOptions = WriterOptions
, writerSectionDivs :: Bool -- ^ Put sections in div tags in HTML
, writerExtensions :: Set Extension -- ^ Markdown extensions that can be used
, writerReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst
+ , writerDpi :: Int -- ^ Dpi for pixel to/from inch/cm conversions
, writerWrapText :: Bool -- ^ Wrap text to line length
, writerColumns :: Int -- ^ Characters in a line (for text wrapping)
, writerEmailObfuscation :: ObfuscationMethod -- ^ How to obfuscate emails
@@ -381,6 +385,7 @@ instance Default WriterOptions where
, writerSectionDivs = False
, writerExtensions = pandocExtensions
, writerReferenceLinks = False
+ , writerDpi = 96
, writerWrapText = True
, writerColumns = 72
, writerEmailObfuscation = JavascriptObfuscation
diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs
index ab94a289a..38e8b8a9d 100644
--- a/src/Text/Pandoc/PDF.hs
+++ b/src/Text/Pandoc/PDF.hs
@@ -86,10 +86,10 @@ handleImage' :: WriterOptions
-> FilePath
-> Inline
-> IO Inline
-handleImage' opts tmpdir (Image ils (src,tit)) = do
+handleImage' opts tmpdir (Image attr ils (src,tit)) = do
exists <- doesFileExist src
if exists
- then return $ Image ils (src,tit)
+ then return $ Image attr ils (src,tit)
else do
res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
case res of
@@ -99,20 +99,20 @@ handleImage' opts tmpdir (Image ils (src,tit)) = do
let basename = showDigest $ sha1 $ BL.fromChunks [contents]
let fname = tmpdir </> basename <.> ext
BS.writeFile fname contents
- return $ Image ils (fname,tit)
+ return $ Image attr ils (fname,tit)
_ -> do
warn $ "Could not find image `" ++ src ++ "', skipping..."
- return $ Image ils (src,tit)
+ return $ Image attr ils (src,tit)
handleImage' _ _ x = return x
convertImages :: FilePath -> Inline -> IO Inline
-convertImages tmpdir (Image ils (src, tit)) = do
+convertImages tmpdir (Image attr ils (src, tit)) = do
img <- convertImage tmpdir src
newPath <-
case img of
Left e -> src <$ warn e
Right fp -> return fp
- return (Image ils (newPath, tit))
+ return (Image attr ils (newPath, tit))
convertImages _ x = return x
-- Convert formats which do not work well in pdf to png
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 02d114e0f..c79c8fffc 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -164,7 +164,8 @@ module Text.Pandoc.Parsing ( anyLine,
setSourceLine,
newPos,
addWarning,
- (<+?>)
+ (<+?>),
+ extractIdClass
)
where
@@ -1066,7 +1067,7 @@ toKey = Key . map toLower . unwords . words . unbracket
where unbracket ('[':xs) | "]" `isSuffixOf` xs = take (length xs - 1) xs
unbracket xs = xs
-type KeyTable = M.Map Key Target
+type KeyTable = M.Map Key (Target, Attr)
type SubstTable = M.Map Key Inlines
@@ -1264,3 +1265,14 @@ addWarning mbpos msg =
infixr 5 <+?>
(<+?>) :: (Monoid a, Monad m) => ParserT s st m a -> ParserT s st m a -> ParserT s st m a
a <+?> b = a >>= flip fmap (try b <|> return mempty) . (<>)
+
+extractIdClass :: Attr -> Attr
+extractIdClass (ident, cls, kvs) = (ident', cls', kvs')
+ where
+ ident' = case (lookup "id" kvs) of
+ Just v -> v
+ Nothing -> ident
+ cls' = case (lookup "class" kvs) of
+ Just cl -> words cl
+ Nothing -> cls
+ kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs
index 5771f3a89..88b7dd09e 100644
--- a/src/Text/Pandoc/Pretty.hs
+++ b/src/Text/Pandoc/Pretty.hs
@@ -171,7 +171,7 @@ infixr 5 $$
else x <> cr <> y
infixr 5 $+$
--- | @a $$ b@ puts @a@ above @b@, with a blank line between.
+-- | @a $+$ b@ puts @a@ above @b@, with a blank line between.
($+$) :: Doc -> Doc -> Doc
($+$) x y = if isEmpty x
then y
diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs
index 51a35c8ad..7f752c446 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -113,7 +113,7 @@ addInline (Node _ EMPH nodes) =
addInline (Node _ STRONG nodes) =
(Strong (addInlines nodes) :)
addInline (Node _ (LINK url title) nodes) =
- (Link (addInlines nodes) (unpack url, unpack title) :)
+ (Link nullAttr (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 f679ddb57..e8fe92e27 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -635,11 +635,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
@@ -649,7 +658,7 @@ getMediaobject e = do
let (caption, title) = if isNull figTitle
then (getCaption e, "")
else (return figTitle, "fig:")
- liftM (image imageUrl title) caption
+ liftM (imageWith attr imageUrl title) caption
getBlocks :: Element -> DB Blocks
getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)
@@ -968,7 +977,8 @@ parseInline (Elem e) =
Just h -> h
_ -> ('#' : attrValue "linkend" e)
let ils' = if ils == mempty then str href else ils
- return $ link href "" ils'
+ let attr = (attrValue "id" e, words $ attrValue "role" e, [])
+ return $ linkWith attr href "" ils'
"foreignphrase" -> emph <$> innerInlines
"emphasis" -> case attrValue "role" e of
"bold" -> strong <$> innerInlines
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 9f1c7af0a..439e2d3e4 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -539,10 +539,10 @@ bodyPartToBlocks (OMathPara e) = do
-- replace targets with generated anchors.
rewriteLink' :: Inline -> DocxContext Inline
-rewriteLink' l@(Link ils ('#':target, title)) = do
+rewriteLink' l@(Link attr ils ('#':target, title)) = do
anchorMap <- gets docxAnchorMap
return $ case M.lookup target anchorMap of
- Just newTarget -> (Link ils ('#':newTarget, title))
+ Just newTarget -> (Link attr ils ('#':newTarget, title))
Nothing -> l
rewriteLink' il = return il
diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs
index b8698fe26..79aa540f6 100644
--- a/src/Text/Pandoc/Readers/EPUB.hs
+++ b/src/Text/Pandoc/Readers/EPUB.hs
@@ -100,12 +100,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
@@ -190,14 +190,14 @@ fixInlineIRs s (Span as v) =
Span (fixAttrs s as) v
fixInlineIRs s (Code as code) =
Code (fixAttrs s as) code
-fixInlineIRs s (Link t ('#':url, tit)) =
- Link t (addHash s url, tit)
+fixInlineIRs s (Link attr t ('#':url, tit)) =
+ Link attr t (addHash s url, tit)
fixInlineIRs _ v = v
prependHash :: [String] -> Inline -> Inline
-prependHash ps l@(Link is (url, tit))
+prependHash ps l@(Link attr is (url, tit))
| or [s `isPrefixOf` url | s <- ps] =
- Link is ('#':url, tit)
+ Link attr is ('#':url, tit)
| otherwise = l
prependHash _ i = i
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index ce10a289e..85e9a0743 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -601,16 +601,8 @@ pLineBreak = do
return B.linebreak
pLink :: TagParser Inlines
-pLink = pRelLink <|> pAnchor
-
-pAnchor :: TagParser Inlines
-pAnchor = try $ do
- tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "id"))
- return $ B.spanWith (fromAttrib "id" tag , [], []) mempty
-
-pRelLink :: TagParser Inlines
-pRelLink = try $ do
- tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
+pLink = try $ do
+ tag <- pSatisfy $ tagOpenLit "a" (const True)
mbBaseHref <- baseHref <$> getState
let url' = fromAttrib "href" tag
let url = case (isURI url', mbBaseHref) of
@@ -618,11 +610,9 @@ pRelLink = try $ do
_ -> url'
let title = fromAttrib "title" tag
let uid = fromAttrib "id" tag
- let spanC = case uid of
- [] -> id
- s -> B.spanWith (s, [], [])
+ let cls = words $ fromAttrib "class" tag
lab <- trimInlines . mconcat <$> manyTill inline (pCloses "a")
- return $ spanC $ B.link (escapeURI url) title lab
+ return $ B.linkWith (uid, cls, []) (escapeURI url) title lab
pImage :: TagParser Inlines
pImage = do
@@ -634,7 +624,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 (uid, cls, kvs) (escapeURI url) title (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 b9645d034..673deba14 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -54,6 +54,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.
@@ -398,7 +399,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
@@ -528,7 +530,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)
, ("Cite", citation "cite" AuthorInText False)
@@ -590,14 +594,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 attr (addExtension src defaultExt) "" alt
+ _ -> return $ imageWith attr src "" alt
inNote :: Inlines -> Inlines
inNote ils =
@@ -978,7 +987,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
@@ -1005,11 +1014,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 7e811a966..fd16a5f75 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -368,23 +368,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
@@ -517,9 +520,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
@@ -560,16 +563,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
@@ -980,11 +983,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)
@@ -1719,16 +1722,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 :: (Attr -> String -> String -> 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 attr src tit <$> lab
-- a link like [this][ref] or [this][] or [this]
-referenceLink :: (String -> String -> Inlines -> Inlines)
+referenceLink :: (Attr -> String -> String -> Inlines -> Inlines)
-> (F Inlines, String) -> MarkdownParser (F Inlines)
referenceLink constructor (lab, raw) = do
sp <- (True <$ lookAhead (char ' ')) <|> return False
@@ -1740,7 +1745,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
@@ -1757,10 +1762,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 nullAttr src tit <$> lab
+ Nothing -> makeFallback
else makeFallback
- Just (src,tit) -> constructor src tit <$> lab
+ Just ((src,tit), attr) -> constructor attr src tit <$> lab
dropBrackets :: String -> String
dropBrackets = reverse . dropRB . reverse . dropLB
@@ -1794,9 +1799,9 @@ image = try $ do
char '!'
(lab,raw) <- reference
defaultExt <- getOption readerDefaultImageExtension
- let constructor src = case takeExtension src of
- "" -> B.image (addExtension src defaultExt)
- _ -> B.image src
+ let constructor attr' src = case takeExtension src of
+ "" -> B.imageWith attr' (addExtension src defaultExt)
+ _ -> B.imageWith attr' src
regLink constructor lab <|> referenceLink constructor (lab,raw)
note :: MarkdownParser (F Inlines)
@@ -1947,7 +1952,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 ffac51e7b..24b3f5c7e 100644
--- a/src/Text/Pandoc/Readers/MediaWiki.hs
+++ b/src/Text/Pandoc/Readers/MediaWiki.hs
@@ -576,21 +576,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 attr fname ("fig:" ++ stringify caption) 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 199e7f3f8..0e5bb2a87 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 attr src tit label'
autoURI :: RSTParser Inlines
autoURI = do
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 448a582aa..96dbec6f6 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -523,10 +523,10 @@ normalizeInlines (Note bs : ys) = Note (normalizeBlocks bs) :
normalizeInlines ys
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 (Link attr ils t : ys) =
+ Link attr (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 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