f3133a8 · typeable/pandoc

src/Text/Pandoc/CSS.hs+13−2

@@ -1,5 +1,6 @@

1−module Text.Pandoc.CSS ( foldOrElse,

2− pickStyleAttrProps

1+module Text.Pandoc.CSS ( foldOrElse

2+ , pickStyleAttrProps

3+ , pickStylesToKVs

34 )

45where

56

@@ -26,6 +27,16 @@ eitherToMaybe :: Either a b -> Maybe b

2627eitherToMaybe (Right x) = Just x

2728eitherToMaybe _ = Nothing

2829

30+-- | takes a list of keys/properties and a CSS string and

31+-- returns the corresponding key-value-pairs.

32+pickStylesToKVs :: [String] -> String -> [(String, String)]

33+pickStylesToKVs props styleAttr =

34+ case parse styleAttrParser "" styleAttr of

35+ Left _ -> []

36+ Right styles -> filter (\s -> fst s `elem` props) styles

37+

38+-- | takes a list of key/property synonyms and a CSS string and maybe

39+-- returns the value of the first match (in order of the supplied list)

2940pickStyleAttrProps :: [String] -> String -> Maybe String

3041pickStyleAttrProps lookupProps styleAttr = do

3142 styles <- eitherToMaybe $ parse styleAttrParser "" styleAttr

src/Text/Pandoc/Readers/Docx.hs+11−4

@@ -298,10 +298,17 @@ runToInlines (Footnote bps) = do

298298runToInlines (Endnote bps) = do

299299 blksList <- concatReduce <$> (mapM bodyPartToBlocks bps)

300300 return $ note blksList

301−runToInlines (InlineDrawing fp bs) = do

301+runToInlines (InlineDrawing fp bs ext) = do

302302 mediaBag <- gets docxMediaBag

303303 modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag }

304− return $ image fp "" ""

304+ return $ imageWith (extentToAttr ext) fp "" ""

305+

306+extentToAttr :: Extent -> Attr

307+extentToAttr (Just (w, h)) =

308+ ("", [], [("width", showDim w), ("height", showDim h)] )

309+ where

310+ showDim d = show (d / 914400) ++ "in"

311+extentToAttr _ = nullAttr

305312

306313parPartToInlines :: ParPart -> DocxContext Inlines

307314parPartToInlines (PlainRun r) = runToInlines r

@@ -348,10 +355,10 @@ parPartToInlines (BookMark _ anchor) =

348355 unless inHdrBool

349356 (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap})

350357 return $ spanWith (newAnchor, ["anchor"], []) mempty

351−parPartToInlines (Drawing fp bs) = do

358+parPartToInlines (Drawing fp bs ext) = do

352359 mediaBag <- gets docxMediaBag

353360 modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag }

354− return $ image fp "" ""

361+ return $ imageWith (extentToAttr ext) fp "" ""

355362parPartToInlines (InternalHyperLink anchor runs) = do

356363 ils <- concatReduce <$> mapM runToInlines runs

357364 return $ link ('#' : anchor) "" ils

src/Text/Pandoc/Readers/Docx/Parse.hs+21−6

@@ -35,6 +35,7 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)

3535 , Body(..)

3636 , BodyPart(..)

3737 , TblLook(..)

38+ , Extent

3839 , ParPart(..)

3940 , Run(..)

4041 , RunElem(..)

@@ -62,6 +63,7 @@ import Control.Monad.Reader

6263import Control.Applicative ((<|>))

6364import qualified Data.Map as M

6465import Text.Pandoc.Compat.Except

66+import Text.Pandoc.Shared (safeRead)

6567import Text.TeXMath.Readers.OMML (readOMML)

6668import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..))

6769import Text.TeXMath (Exp)

@@ -196,20 +198,23 @@ data Row = Row [Cell]

196198data Cell = Cell [BodyPart]

197199 deriving Show

198200

201+-- (width, height) in EMUs

202+type Extent = Maybe (Double, Double)

203+

199204data ParPart = PlainRun Run

200205 | Insertion ChangeId Author ChangeDate [Run]

201206 | Deletion ChangeId Author ChangeDate [Run]

202207 | BookMark BookMarkId Anchor

203208 | InternalHyperLink Anchor [Run]

204209 | ExternalHyperLink URL [Run]

205− | Drawing FilePath B.ByteString

210+ | Drawing FilePath B.ByteString Extent

206211 | PlainOMath [Exp]

207212 deriving Show

208213

209214data Run = Run RunStyle [RunElem]

210215 | Footnote [BodyPart]

211216 | Endnote [BodyPart]

212− | InlineDrawing FilePath B.ByteString

217+ | InlineDrawing FilePath B.ByteString Extent

213218 deriving Show

214219

215220data RunElem = TextRun String | LnBrk | Tab | SoftHyphen | NoBreakHyphen

@@ -619,13 +624,13 @@ expandDrawingId s = do

619624elemToParPart :: NameSpaces -> Element -> D ParPart

620625elemToParPart ns element

621626 | isElem ns "w" "r" element

622− , Just _ <- findChild (elemName ns "w" "drawing") element =

627+ , Just drawingElem <- findChild (elemName ns "w" "drawing") element =

623628 let a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"

624629 drawing = findElement (QName "blip" (Just a_ns) (Just "a")) element

625630 >>= findAttr (QName "embed" (lookup "r" ns) (Just "r"))

626631 in

627632 case drawing of

628− Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs)

633+ Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs $ elemToExtent drawingElem)

629634 Nothing -> throwError WrongElem

630635-- The below is an attempt to deal with images in deprecated vml format.

631636elemToParPart ns element

@@ -635,7 +640,7 @@ elemToParPart ns element

635640 >>= findAttr (elemName ns "r" "id")

636641 in

637642 case drawing of

638− Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs)

643+ Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs Nothing)

639644 Nothing -> throwError WrongElem

640645elemToParPart ns element

641646 | isElem ns "w" "r" element =

@@ -687,6 +692,16 @@ lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s)

687692lookupEndnote :: String -> Notes -> Maybe Element

688693lookupEndnote s (Notes _ _ ens) = ens >>= (M.lookup s)

689694

695+elemToExtent :: Element -> Extent

696+elemToExtent drawingElem =

697+ case (getDim "cx", getDim "cy") of

698+ (Just w, Just h) -> Just (w, h)

699+ _ -> Nothing

700+ where

701+ wp_ns = "http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing"

702+ getDim at = findElement (QName "extent" (Just wp_ns) (Just "wp")) drawingElem

703+ >>= findAttr (QName at Nothing Nothing) >>= safeRead

704+

690705elemToRun :: NameSpaces -> Element -> D Run

691706elemToRun ns element

692707 | isElem ns "w" "r" element

@@ -697,7 +712,7 @@ elemToRun ns element

697712 in

698713 case drawing of

699714 Just s -> expandDrawingId s >>=

700− (\(fp, bs) -> return $ InlineDrawing fp bs)

715+ (\(fp, bs) -> return $ InlineDrawing fp bs $ elemToExtent drawingElem)

701716 Nothing -> throwError WrongElem

702717elemToRun ns element

703718 | isElem ns "w" "r" element

src/Text/Pandoc/Readers/RST.hs+14−7

@@ -541,6 +541,12 @@ directive' = do

541541 body <- option "" $ try $ blanklines >> indentedBlock

542542 optional blanklines

543543 let body' = body ++ "\n\n"

544+ imgAttr cl = ("", classes, getAtt "width" ++ getAtt "height")

545+ where

546+ classes = words $ maybe "" trim $ lookup cl fields

547+ getAtt k = case lookup k fields of

548+ Just v -> [(k, filter (not . isSpace) v)]

549+ Nothing -> []

544550 case label of

545551 "raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body)

546552 "role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields

@@ -590,15 +596,16 @@ directive' = do

590596 "figure" -> do

591597 (caption, legend) <- parseFromString extractCaption body'

592598 let src = escapeURI $ trim top

593− return $ B.para (B.image src "fig:" caption) <> legend

599+ return $ B.para (B.imageWith (imgAttr "figclass") src "fig:" caption) <> legend

594600 "image" -> do

595601 let src = escapeURI $ trim top

596602 let alt = B.str $ maybe "image" trim $ lookup "alt" fields

603+ let attr = imgAttr "class"

597604 return $ B.para

598605 $ case lookup "target" fields of

599606 Just t -> B.link (escapeURI $ trim t) ""

600− $ B.image src "" alt

601− Nothing -> B.image src "" alt

607+ $ B.imageWith attr src "" alt

608+ Nothing -> B.imageWith attr src "" alt

602609 "class" -> do

603610 let attrs = ("", (splitBy isSpace $ trim top), map (\(k,v) -> (k, trimr v)) fields)

604611 -- directive content or the first immediately following element

@@ -812,10 +819,10 @@ substKey = try $ do

812819 res <- B.toList <$> directive'

813820 il <- case res of

814821 -- use alt unless :alt: attribute on image:

815− [Para [Image _ [Str "image"] (src,tit)]] ->

816− return $ B.image src tit alt

817− [Para [Link _ [Image _ [Str "image"] (src,tit)] (src',tit')]] ->

818− return $ B.link src' tit' (B.image src tit alt)

822+ [Para [Image attr [Str "image"] (src,tit)]] ->

823+ return $ B.imageWith attr src tit alt

824+ [Para [Link _ [Image attr [Str "image"] (src,tit)] (src',tit')]] ->

825+ return $ B.link src' tit' (B.imageWith attr src tit alt)

819826 [Para ils] -> return $ B.fromList ils

820827 _ -> mzero

821828 let key = toKey $ stripFirstAndLast ref

src/Text/Pandoc/Readers/Textile.hs+1−4

@@ -537,11 +537,8 @@ image :: Parser [Char] ParserState Inlines

537537image = try $ do

538538 char '!' >> notFollowedBy space

539539 (ident, cls, kvs) <- attributes

540− let getAtt k styles = case pickStyleAttrProps [k] styles of

541− Just v -> [(k, v)]

542− Nothing -> []

543540 let attr = case lookup "style" kvs of

544− Just stls -> (ident, cls, getAtt "width" stls ++ getAtt "height" stls)

541+ Just stls -> (ident, cls, pickStylesToKVs ["width", "height"] stls)

545542 Nothing -> (ident, cls, kvs)

546543 src <- manyTill anyChar' (lookAhead $ oneOf "!(")

547544 alt <- option "" (try $ (char '(' >> manyTill anyChar' (char ')')))

src/Text/Pandoc/Writers/ODT.hs+25−13

@@ -40,7 +40,7 @@ import Codec.Archive.Zip

4040import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) )

4141import Text.Pandoc.Shared ( stringify, fetchItem', warn,

4242 getDefaultReferenceODT )

43−import Text.Pandoc.ImageSize ( imageSize, desiredSizeInPoints )

43+import Text.Pandoc.ImageSize

4444import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType )

4545import Text.Pandoc.Definition

4646import Text.Pandoc.Walk

@@ -125,22 +125,36 @@ writeODT opts doc@(Pandoc meta _) = do

125125 $ addEntryToArchive metaEntry archive'

126126 return $ fromArchive archive''

127127

128+-- | transform both Image and Math elements

128129transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline

129−transformPicMath opts entriesRef (Image attr lab (src,t)) = do

130+transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do

130131 res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

131132 case res of

132133 Left (_ :: E.SomeException) -> do

133134 warn $ "Could not find image `" ++ src ++ "', skipping..."

134135 return $ Emph lab

135136 Right (img, mbMimeType) -> do

136− (w,h) <- case imageSize img of

137− Right size -> return $

138− desiredSizeInPoints opts attr size

139− Left msg -> do

140− warn $ "Could not determine image size in `" ++

141− src ++ "': " ++ msg

142− return (0,0)

143− let tit' = show w ++ "x" ++ show h

137+ (ptX, ptY) <- case imageSize img of

138+ Right s -> return $ sizeInPoints s

139+ Left msg -> do

140+ warn $ "Could not determine image size in `" ++

141+ src ++ "': " ++ msg

142+ return (100, 100)

143+ let dims =

144+ case (getDim Width, getDim Height) of

145+ (Just w, Just h) -> [("width", show w), ("height", show h)]

146+ (Just w@(Percent _), Nothing) -> [("width", show w), ("style:rel-height", "scale")]

147+ (Nothing, Just h@(Percent _)) -> [("style:rel-width", "scale"), ("height", show h)]

148+ (Just w@(Inch i), Nothing) -> [("width", show w), ("height", show (i / ratio) ++ "in")]

149+ (Nothing, Just h@(Inch i)) -> [("width", show (i * ratio) ++ "in"), ("height", show h)]

150+ _ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")]

151+ where

152+ ratio = ptX / ptY

153+ getDim dir = case (dimension dir attr) of

154+ Just (Percent i) -> Just $ Percent i

155+ Just dim -> Just $ Inch $ inInch opts dim

156+ Nothing -> Nothing

157+ let newattr = (id', cls, dims)

144158 entries <- readIORef entriesRef

145159 let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)

146160 (mbMimeType >>= extensionFromMimeType)

@@ -149,9 +163,7 @@ transformPicMath opts entriesRef (Image attr lab (src,t)) = do

149163 epochtime <- floor `fmap` getPOSIXTime

150164 let entry = toEntry newsrc epochtime $ toLazy img

151165 modifyIORef entriesRef (entry:)

152− let fig | "fig:" `isPrefixOf` t = "fig:"

153− | otherwise = ""

154− return $ Image attr lab (newsrc, fig++tit')

166+ return $ Image newattr lab (newsrc, t)

155167transformPicMath _ entriesRef (Math t math) = do

156168 entries <- readIORef entriesRef

157169 let dt = if t == InlineMath then DisplayInline else DisplayBlock

src/Text/Pandoc/Writers/OpenDocument.hs+9−14

@@ -39,7 +39,7 @@ import Text.Pandoc.Pretty

3939import Text.Printf ( printf )

4040import Control.Arrow ( (***), (>>>) )

4141import Control.Monad.State hiding ( when )

42−import Data.Char (chr, isDigit)

42+import Data.Char (chr)

4343import qualified Data.Map as Map

4444import Text.Pandoc.Writers.Shared

4545

@@ -405,11 +405,17 @@ inlineToOpenDocument o ils

405405 , ("xlink:href" , s )

406406 , ("office:name", t )

407407 ] . inSpanTags "Definition"

408− mkImg _ s t = do

408+ mkImg (_, _, kvs) s _ = do

409409 id' <- gets stImageId

410410 modify (\st -> st{ stImageId = id' + 1 })

411+ let getDims [] = []

412+ getDims (("width", w) :xs) = ("svg:width", w) : getDims xs

413+ getDims (("height", h):xs) = ("svg:height", h) : getDims xs

414+ getDims (x@("style:rel-width", _) :xs) = x : getDims xs

415+ getDims (x@("style:rel-height", _):xs) = x : getDims xs

416+ getDims (_:xs) = getDims xs

411417 return $ inTags False "draw:frame"

412− (("draw:name", "img" ++ show id'):attrsFromTitle t) $

418+ (("draw:name", "img" ++ show id') : getDims kvs) $

413419 selfClosingTag "draw:image" [ ("xlink:href" , s )

414420 , ("xlink:type" , "simple")

415421 , ("xlink:show" , "embed" )

@@ -425,17 +431,6 @@ inlineToOpenDocument o ils

425431 addNote nn

426432 return nn

427433

428−-- a title of the form "120x140" will be interpreted as image

429−-- size in points.

430−attrsFromTitle :: String -> [(String,String)]

431−attrsFromTitle s = if null xs || null ys

432− then []

433− else [("svg:width",xs ++ "pt"),("svg:height",ys ++ "pt")]

434− where (xs,rest) = span isDigit s

435− ys = case rest of

436− ('x':zs) | all isDigit zs -> zs

437− _ -> ""

438−

439434bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc]))

440435bulletListStyle l =

441436 let doStyles i = inTags True "text:list-level-style-bullet"

tests/docx/image_no_embed.native+1−1

@@ -1,2 +1,2 @@

11[Para [Str "An",Space,Str "image:"]

2−,Para [Image ("",[],[]) [] ("media/image1.jpg","")]]

2+,Para [Image ("",[],[("width","6.5in"),("height","5.508333333333334in")]) [] ("media/image1.jpg","")]]

tests/docx/image_no_embed_writer.native+1−1

@@ -1,2 +1,2 @@

11[Para [Str "An",Space,Str "image:"]

2−,Para [Image ("",[],[]) [] ("media/rId25.jpg","")]]

2+,Para [Image ("",[],[("width","0.4166666666666667in"),("height","0.4166666666666667in")]) [] ("media/rId25.jpg","")]]

tests/docx/inline_images.native+2−2

@@ -1,2 +1,2 @@

1−[Para [Str "This",Space,Str "picture",Space,Image ("",[],[]) [] ("media/image1.jpg",""),Space,Str "is",Space,Str "an",Space,Str "identicon."]

2−,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."]]

1+[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."]

2+,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."]]

tests/docx/inline_images_writer.native+2−2

@@ -1,2 +1,2 @@

1−[Para [Str "This",Space,Str "picture",Space,Image ("",[],[]) [] ("media/rId26.jpg",""),Space,Str "is",Space,Str "an",Space,Str "identicon."]

2−,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."]]

1+[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."]

2+,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."]]

tests/rst-reader.native+1−1

@@ -221,7 +221,7 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa

221221,Header 1 ("images",[],[]) [Str "Images"]

222222,Para [Str "From",Space,Quoted DoubleQuote [Str "Voyage",Space,Str "dans",Space,Str "la",Space,Str "Lune"],Space,Str "by",Space,Str "Georges",Space,Str "Melies",Space,Str "(1902):"]

223223,Para [Image ("",[],[]) [Str "image"] ("lalune.jpg","")]

224−,Para [Image ("",[],[]) [Str "Voyage dans la Lune"] ("lalune.jpg","")]

224+,Para [Image ("",[],[("height","2343")]) [Str "Voyage dans la Lune"] ("lalune.jpg","")]

225225,Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "movie",Space,Image ("",[],[]) [Str "movie"] ("movie.jpg",""),Space,Str "icon."]

226226,Para [Str "And",Space,Str "an",Space,Link ("",[],[]) [Image ("",[],[]) [Str "A movie"] ("movie.jpg","")] ("/url",""),Str "."]

227227,Header 1 ("comments",[],[]) [Str "Comments"]