aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Readers')
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs15
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs27
-rw-r--r--src/Text/Pandoc/Readers/RST.hs21
-rw-r--r--src/Text/Pandoc/Readers/Textile.hs5
4 files changed, 47 insertions, 21 deletions
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/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
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 ')')))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 21:59:09 +0000