diff options
Diffstat (limited to 'src/Text')
39 files changed, 729 insertions, 345 deletions
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index e49fef3b5..ee4284979 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -266,7 +266,7 @@ writers = [ ,("html" , PureStringWriter writeHtmlString) ,("html5" , PureStringWriter $ \o -> writeHtmlString o{ writerHtml5 = True }) - ,("icml" , PureStringWriter writeICML) + ,("icml" , IOStringWriter writeICML) ,("s5" , PureStringWriter $ \o -> writeHtmlString o{ writerSlideVariant = S5Slides , writerTableOfContents = False }) 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 |