From 30644b291b7a23c4e41b69611a8ee5c8d386c3c3 Mon Sep 17 00:00:00 2001 From: mb21 Date: Thu, 3 Dec 2015 11:50:54 +0100 Subject: RST reader: image attributes --- src/Text/Pandoc/Readers/RST.hs | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 85f34d9d8..7be0cd392 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -541,6 +541,12 @@ directive' = do body <- option "" $ try $ blanklines >> indentedBlock optional blanklines let body' = body ++ "\n\n" + imgAttr cl = ("", classes, getAtt "width" ++ getAtt "height") + where + classes = words $ maybe "" trim $ lookup cl fields + getAtt k = case lookup k fields of + Just v -> [(k, filter (not . isSpace) v)] + Nothing -> [] case label of "raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body) "role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields @@ -590,15 +596,16 @@ directive' = do "figure" -> do (caption, legend) <- parseFromString extractCaption body' let src = escapeURI $ trim top - return $ B.para (B.image src "fig:" caption) <> legend + return $ B.para (B.imageWith (imgAttr "figclass") src "fig:" caption) <> legend "image" -> do let src = escapeURI $ trim top let alt = B.str $ maybe "image" trim $ lookup "alt" fields + let attr = imgAttr "class" return $ B.para $ case lookup "target" fields of Just t -> B.link (escapeURI $ trim t) "" - $ B.image src "" alt - Nothing -> B.image src "" alt + $ B.imageWith attr src "" alt + Nothing -> B.imageWith attr src "" alt "class" -> do let attrs = ("", (splitBy isSpace $ trim top), map (\(k,v) -> (k, trimr v)) fields) -- directive content or the first immediately following element @@ -812,10 +819,10 @@ substKey = try $ do res <- B.toList <$> directive' il <- case res of -- use alt unless :alt: attribute on image: - [Para [Image _ [Str "image"] (src,tit)]] -> - return $ B.image src tit alt - [Para [Link _ [Image _ [Str "image"] (src,tit)] (src',tit')]] -> - return $ B.link src' tit' (B.image src tit alt) + [Para [Image attr [Str "image"] (src,tit)]] -> + return $ B.imageWith attr src tit alt + [Para [Link _ [Image attr [Str "image"] (src,tit)] (src',tit')]] -> + return $ B.link src' tit' (B.imageWith attr src tit alt) [Para ils] -> return $ B.fromList ils _ -> mzero let key = toKey $ stripFirstAndLast ref -- cgit v1.2.3 From 2060f5fe83db613f878c712378a68cb88f452669 Mon Sep 17 00:00:00 2001 From: mb21 Date: Sat, 5 Dec 2015 14:12:20 +0100 Subject: new function to extract multiple properties at once in CSS.hs and use it in Textile reader --- src/Text/Pandoc/CSS.hs | 15 +++++++++++++-- src/Text/Pandoc/Readers/Textile.hs | 5 +---- 2 files changed, 14 insertions(+), 6 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/CSS.hs b/src/Text/Pandoc/CSS.hs index 2287a5958..f479ed9d0 100644 --- a/src/Text/Pandoc/CSS.hs +++ b/src/Text/Pandoc/CSS.hs @@ -1,5 +1,6 @@ -module Text.Pandoc.CSS ( foldOrElse, - pickStyleAttrProps +module Text.Pandoc.CSS ( foldOrElse + , pickStyleAttrProps + , pickStylesToKVs ) where @@ -26,6 +27,16 @@ eitherToMaybe :: Either a b -> Maybe b eitherToMaybe (Right x) = Just x eitherToMaybe _ = Nothing +-- | takes a list of keys/properties and a CSS string and +-- returns the corresponding key-value-pairs. +pickStylesToKVs :: [String] -> String -> [(String, String)] +pickStylesToKVs props styleAttr = + case parse styleAttrParser "" styleAttr of + Left _ -> [] + Right styles -> filter (\s -> fst s `elem` props) styles + +-- | takes a list of key/property synonyms and a CSS string and maybe +-- returns the value of the first match (in order of the supplied list) pickStyleAttrProps :: [String] -> String -> Maybe String pickStyleAttrProps lookupProps styleAttr = do styles <- eitherToMaybe $ parse styleAttrParser "" styleAttr diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 502595e0b..355285f54 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -537,11 +537,8 @@ image :: Parser [Char] ParserState Inlines image = try $ do char '!' >> notFollowedBy space (ident, cls, kvs) <- attributes - let getAtt k styles = case pickStyleAttrProps [k] styles of - Just v -> [(k, v)] - Nothing -> [] let attr = case lookup "style" kvs of - Just stls -> (ident, cls, getAtt "width" stls ++ getAtt "height" stls) + Just stls -> (ident, cls, pickStylesToKVs ["width", "height"] stls) Nothing -> (ident, cls, kvs) src <- manyTill anyChar' (lookAhead $ oneOf "!(") alt <- option "" (try $ (char '(' >> manyTill anyChar' (char ')'))) -- cgit v1.2.3 From 37931cb0c56c8ae770f696a31f7beba1d6cb0f08 Mon Sep 17 00:00:00 2001 From: mb21 Date: Sun, 6 Dec 2015 00:41:04 +0100 Subject: Docx reader: image attributes --- src/Text/Pandoc/Readers/Docx.hs | 15 +++++++++++---- src/Text/Pandoc/Readers/Docx/Parse.hs | 27 +++++++++++++++++++++------ tests/docx/image_no_embed.native | 2 +- tests/docx/image_no_embed_writer.native | 2 +- tests/docx/inline_images.native | 4 ++-- tests/docx/inline_images_writer.native | 4 ++-- 6 files changed, 38 insertions(+), 16 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 3e934d272..44f67ce75 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -298,10 +298,17 @@ runToInlines (Footnote bps) = do runToInlines (Endnote bps) = do blksList <- concatReduce <$> (mapM bodyPartToBlocks bps) return $ note blksList -runToInlines (InlineDrawing fp bs) = do +runToInlines (InlineDrawing fp bs ext) = do mediaBag <- gets docxMediaBag modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag } - return $ image fp "" "" + return $ imageWith (extentToAttr ext) fp "" "" + +extentToAttr :: Extent -> Attr +extentToAttr (Just (w, h)) = + ("", [], [("width", showDim w), ("height", showDim h)] ) + where + showDim d = show (d / 914400) ++ "in" +extentToAttr _ = nullAttr parPartToInlines :: ParPart -> DocxContext Inlines parPartToInlines (PlainRun r) = runToInlines r @@ -348,10 +355,10 @@ parPartToInlines (BookMark _ anchor) = unless inHdrBool (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap}) return $ spanWith (newAnchor, ["anchor"], []) mempty -parPartToInlines (Drawing fp bs) = do +parPartToInlines (Drawing fp bs ext) = do mediaBag <- gets docxMediaBag modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag } - return $ image fp "" "" + return $ imageWith (extentToAttr ext) fp "" "" parPartToInlines (InternalHyperLink anchor runs) = do ils <- concatReduce <$> mapM runToInlines runs return $ link ('#' : anchor) "" ils diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 91655d2b4..eec8b12c9 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -35,6 +35,7 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..) , Body(..) , BodyPart(..) , TblLook(..) + , Extent , ParPart(..) , Run(..) , RunElem(..) @@ -62,6 +63,7 @@ import Control.Monad.Reader import Control.Applicative ((<|>)) import qualified Data.Map as M import Text.Pandoc.Compat.Except +import Text.Pandoc.Shared (safeRead) import Text.TeXMath.Readers.OMML (readOMML) import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..)) import Text.TeXMath (Exp) @@ -196,20 +198,23 @@ data Row = Row [Cell] data Cell = Cell [BodyPart] deriving Show +-- (width, height) in EMUs +type Extent = Maybe (Double, Double) + data ParPart = PlainRun Run | Insertion ChangeId Author ChangeDate [Run] | Deletion ChangeId Author ChangeDate [Run] | BookMark BookMarkId Anchor | InternalHyperLink Anchor [Run] | ExternalHyperLink URL [Run] - | Drawing FilePath B.ByteString + | Drawing FilePath B.ByteString Extent | PlainOMath [Exp] deriving Show data Run = Run RunStyle [RunElem] | Footnote [BodyPart] | Endnote [BodyPart] - | InlineDrawing FilePath B.ByteString + | InlineDrawing FilePath B.ByteString Extent deriving Show data RunElem = TextRun String | LnBrk | Tab | SoftHyphen | NoBreakHyphen @@ -619,13 +624,13 @@ expandDrawingId s = do elemToParPart :: NameSpaces -> Element -> D ParPart elemToParPart ns element | isElem ns "w" "r" element - , Just _ <- findChild (elemName ns "w" "drawing") element = + , Just drawingElem <- findChild (elemName ns "w" "drawing") element = let a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main" drawing = findElement (QName "blip" (Just a_ns) (Just "a")) element >>= findAttr (QName "embed" (lookup "r" ns) (Just "r")) in case drawing of - Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs) + Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs $ elemToExtent drawingElem) Nothing -> throwError WrongElem -- The below is an attempt to deal with images in deprecated vml format. elemToParPart ns element @@ -635,7 +640,7 @@ elemToParPart ns element >>= findAttr (elemName ns "r" "id") in case drawing of - Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs) + Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs Nothing) Nothing -> throwError WrongElem elemToParPart ns element | isElem ns "w" "r" element = @@ -687,6 +692,16 @@ lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s) lookupEndnote :: String -> Notes -> Maybe Element lookupEndnote s (Notes _ _ ens) = ens >>= (M.lookup s) +elemToExtent :: Element -> Extent +elemToExtent drawingElem = + case (getDim "cx", getDim "cy") of + (Just w, Just h) -> Just (w, h) + _ -> Nothing + where + wp_ns = "http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing" + getDim at = findElement (QName "extent" (Just wp_ns) (Just "wp")) drawingElem + >>= findAttr (QName at Nothing Nothing) >>= safeRead + elemToRun :: NameSpaces -> Element -> D Run elemToRun ns element | isElem ns "w" "r" element @@ -697,7 +712,7 @@ elemToRun ns element in case drawing of Just s -> expandDrawingId s >>= - (\(fp, bs) -> return $ InlineDrawing fp bs) + (\(fp, bs) -> return $ InlineDrawing fp bs $ elemToExtent drawingElem) Nothing -> throwError WrongElem elemToRun ns element | isElem ns "w" "r" element diff --git a/tests/docx/image_no_embed.native b/tests/docx/image_no_embed.native index 9af018a0d..28eb918aa 100644 --- a/tests/docx/image_no_embed.native +++ b/tests/docx/image_no_embed.native @@ -1,2 +1,2 @@ [Para [Str "An",Space,Str "image:"] -,Para [Image ("",[],[]) [] ("media/image1.jpg","")]] +,Para [Image ("",[],[("width","6.5in"),("height","5.508333333333334in")]) [] ("media/image1.jpg","")]] diff --git a/tests/docx/image_no_embed_writer.native b/tests/docx/image_no_embed_writer.native index fb0f4f0a1..6f1914743 100644 --- a/tests/docx/image_no_embed_writer.native +++ b/tests/docx/image_no_embed_writer.native @@ -1,2 +1,2 @@ [Para [Str "An",Space,Str "image:"] -,Para [Image ("",[],[]) [] ("media/rId25.jpg","")]] +,Para [Image ("",[],[("width","0.4166666666666667in"),("height","0.4166666666666667in")]) [] ("media/rId25.jpg","")]] diff --git a/tests/docx/inline_images.native b/tests/docx/inline_images.native index aa7231d97..a361dc68c 100644 --- a/tests/docx/inline_images.native +++ b/tests/docx/inline_images.native @@ -1,2 +1,2 @@ -[Para [Str "This",Space,Str "picture",Space,Image ("",[],[]) [] ("media/image1.jpg",""),Space,Str "is",Space,Str "an",Space,Str "identicon."] -,Para [Str "Here",Space,Str "is",Space,Link ("",[],[]) [Str "one",Space,Image ("",[],[]) [] ("media/image2.jpg",""),Space,Str "that"] ("http://www.google.com",""),Space,Str "links."]] +[Para [Str "This",Space,Str "picture",Space,Image ("",[],[("width","0.8888888888888888in"),("height","0.8888888888888888in")]) [] ("media/image1.jpg",""),Space,Str "is",Space,Str "an",Space,Str "identicon."] +,Para [Str "Here",Space,Str "is",Space,Link ("",[],[]) [Str "one",Space,Image ("",[],[("width","0.8888888888888888in"),("height","0.8888888888888888in")]) [] ("media/image2.jpg",""),Space,Str "that"] ("http://www.google.com",""),Space,Str "links."]] diff --git a/tests/docx/inline_images_writer.native b/tests/docx/inline_images_writer.native index afefe0ebc..e5dfa5b58 100644 --- a/tests/docx/inline_images_writer.native +++ b/tests/docx/inline_images_writer.native @@ -1,2 +1,2 @@ -[Para [Str "This",Space,Str "picture",Space,Image ("",[],[]) [] ("media/rId26.jpg",""),Space,Str "is",Space,Str "an",Space,Str "identicon."] -,Para [Str "Here",Space,Str "is",Space,Link ("",[],[]) [Str "one",Space,Image ("",[],[]) [] ("media/rId27.jpg",""),Space,Str "that"] ("http://www.google.com",""),Space,Str "links."]] +[Para [Str "This",Space,Str "picture",Space,Image ("",[],[("width","0.4166666666666667in"),("height","0.4166666666666667in")]) [] ("media/rId26.jpg",""),Space,Str "is",Space,Str "an",Space,Str "identicon."] +,Para [Str "Here",Space,Str "is",Space,Link ("",[],[]) [Str "one",Space,Image ("",[],[("width","0.4166666666666667in"),("height","0.4166666666666667in")]) [] ("media/rId26.jpg",""),Space,Str "that"] ("http://www.google.com",""),Space,Str "links."]] -- cgit v1.2.3 From df68f254592566ed2ed5dc258f0e645a0a6e5f8e Mon Sep 17 00:00:00 2001 From: mb21 Date: Fri, 11 Dec 2015 11:25:49 +0100 Subject: ODT/OpenDocument writer: improved image attributes - support for percentage widths/heights - use Attr instead of title to get dimensions from ODT walker to writeOpenDocument --- src/Text/Pandoc/Writers/ODT.hs | 38 ++++++++++++++++++++++----------- src/Text/Pandoc/Writers/OpenDocument.hs | 23 ++++++++------------ 2 files changed, 34 insertions(+), 27 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 6df199fc9..ce4d456a3 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(..), WrapOption(..) ) import Text.Pandoc.Shared ( stringify, fetchItem', warn, getDefaultReferenceODT ) -import Text.Pandoc.ImageSize ( imageSize, desiredSizeInPoints ) +import Text.Pandoc.ImageSize import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType ) import Text.Pandoc.Definition import Text.Pandoc.Walk @@ -125,22 +125,36 @@ writeODT opts doc@(Pandoc meta _) = do $ addEntryToArchive metaEntry archive' return $ fromArchive archive'' +-- | transform both Image and Math elements transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline -transformPicMath opts entriesRef (Image attr lab (src,t)) = do +transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case res of Left (_ :: E.SomeException) -> do warn $ "Could not find image `" ++ src ++ "', skipping..." return $ Emph lab Right (img, mbMimeType) -> do - (w,h) <- case imageSize img of - 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 + (ptX, ptY) <- case imageSize img of + Right s -> return $ sizeInPoints s + Left msg -> do + warn $ "Could not determine image size in `" ++ + src ++ "': " ++ msg + return (100, 100) + let dims = + case (getDim Width, getDim Height) of + (Just w, Just h) -> [("width", show w), ("height", show h)] + (Just w@(Percent _), Nothing) -> [("width", show w), ("style:rel-height", "scale")] + (Nothing, Just h@(Percent _)) -> [("style:rel-width", "scale"), ("height", show h)] + (Just w@(Inch i), Nothing) -> [("width", show w), ("height", show (i / ratio) ++ "in")] + (Nothing, Just h@(Inch i)) -> [("width", show (i * ratio) ++ "in"), ("height", show h)] + _ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")] + where + ratio = ptX / ptY + getDim dir = case (dimension dir attr) of + Just (Percent i) -> Just $ Percent i + Just dim -> Just $ Inch $ inInch opts dim + Nothing -> Nothing + let newattr = (id', cls, dims) entries <- readIORef entriesRef let extension = fromMaybe (takeExtension $ takeWhile (/='?') src) (mbMimeType >>= extensionFromMimeType) @@ -149,9 +163,7 @@ transformPicMath opts entriesRef (Image attr lab (src,t)) = do epochtime <- floor `fmap` getPOSIXTime let entry = toEntry newsrc epochtime $ toLazy img modifyIORef entriesRef (entry:) - let fig | "fig:" `isPrefixOf` t = "fig:" - | otherwise = "" - return $ Image attr lab (newsrc, fig++tit') + return $ Image newattr lab (newsrc, t) 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 8e55a4016..e0434c630 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -39,7 +39,7 @@ import Text.Pandoc.Pretty import Text.Printf ( printf ) import Control.Arrow ( (***), (>>>) ) import Control.Monad.State hiding ( when ) -import Data.Char (chr, isDigit) +import Data.Char (chr) import qualified Data.Map as Map import Text.Pandoc.Writers.Shared @@ -405,11 +405,17 @@ inlineToOpenDocument o ils , ("xlink:href" , s ) , ("office:name", t ) ] . inSpanTags "Definition" - mkImg _ s t = do + mkImg (_, _, kvs) s _ = do id' <- gets stImageId modify (\st -> st{ stImageId = id' + 1 }) + let getDims [] = [] + getDims (("width", w) :xs) = ("svg:width", w) : getDims xs + getDims (("height", h):xs) = ("svg:height", h) : getDims xs + getDims (x@("style:rel-width", _) :xs) = x : getDims xs + getDims (x@("style:rel-height", _):xs) = x : getDims xs + getDims (_:xs) = getDims xs return $ inTags False "draw:frame" - (("draw:name", "img" ++ show id'):attrsFromTitle t) $ + (("draw:name", "img" ++ show id') : getDims kvs) $ selfClosingTag "draw:image" [ ("xlink:href" , s ) , ("xlink:type" , "simple") , ("xlink:show" , "embed" ) @@ -425,17 +431,6 @@ inlineToOpenDocument o ils addNote nn return nn --- a title of the form "120x140" will be interpreted as image --- size in points. -attrsFromTitle :: String -> [(String,String)] -attrsFromTitle s = if null xs || null ys - then [] - else [("svg:width",xs ++ "pt"),("svg:height",ys ++ "pt")] - where (xs,rest) = span isDigit s - ys = case rest of - ('x':zs) | all isDigit zs -> zs - _ -> "" - bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc])) bulletListStyle l = let doStyles i = inTags True "text:list-level-style-bullet" -- cgit v1.2.3