effc348 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Docx reader: Handle Alt text and titles in images.

effc348Jesse Rosenthal10 years ago

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

compare with master

unifiedsplit

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

317runToInlines (Endnote bps) = do

318 blksList <- smushBlocks <$> (mapM bodyPartToBlocks bps)

319 return $ note blksList

320−runToInlines (InlineDrawing fp bs ext) = do

320+runToInlines (InlineDrawing fp title alt bs ext) = do

321 mediaBag <- gets docxMediaBag

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

323− return $ imageWith (extentToAttr ext) fp "" ""

323+ return $ imageWith (extentToAttr ext) fp title $ text alt

324

325extentToAttr :: Extent -> Attr

326extentToAttr (Just (w, h)) =

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

401 unless inHdrBool

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

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

404−parPartToInlines (Drawing fp bs ext) = do

404+parPartToInlines (Drawing fp title alt bs ext) = do

405 mediaBag <- gets docxMediaBag

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

407− return $ imageWith (extentToAttr ext) fp "" ""

407+ return $ imageWith (extentToAttr ext) fp title $ text alt

408parPartToInlines (InternalHyperLink anchor runs) = do

409 ils <- smushInlines <$> mapM runToInlines runs

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

src/Text/Pandoc/Readers/Docx/Parse.hs+24−7

@@ -215,14 +215,14 @@ data ParPart = PlainRun Run

215 | BookMark BookMarkId Anchor

216 | InternalHyperLink Anchor [Run]

217 | ExternalHyperLink URL [Run]

218− | Drawing FilePath B.ByteString Extent

218+ | Drawing FilePath String String B.ByteString Extent -- title, alt

219 | PlainOMath [Exp]

220 deriving Show

221

222data Run = Run RunStyle [RunElem]

223 | Footnote [BodyPart]

224 | Endnote [BodyPart]

225− | InlineDrawing FilePath B.ByteString Extent

225+ | InlineDrawing FilePath String String B.ByteString Extent -- title, alt

226 deriving Show

227

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

@@ -649,12 +649,20 @@ elemToParPart :: NameSpaces -> Element -> D ParPart

649elemToParPart ns element

650 | isElem ns "w" "r" element

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

652+ let mbDocPr = findChild (elemName ns "wp" "inline") drawingElem >>=

653+ findChild (elemName ns "wp" "docPr")

654+ alt = case mbDocPr >>= findAttr (elemName ns "" "descr") of

655+ Just alt' -> alt'

656+ Nothing -> ""

657+ title = case mbDocPr >>= findAttr (elemName ns "" "title") of

658+ Just title' -> title'

659+ Nothing -> ""

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

660+ a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"

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

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

654 >>= findAttr (elemName ns "r" "embed")

662 >>= findAttr (elemName ns "r" "embed")

655 in

663 in

656 case drawing of

664 case drawing of

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

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

658 Nothing -> throwError WrongElem

666 Nothing -> throwError WrongElem

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

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

660elemToParPart ns element

668elemToParPart ns element

@@ -664,7 +672,8 @@ elemToParPart ns element

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

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

665 in

673 in

666 case drawing of

674 case drawing of

675+ -- Todo: check out title and attr for deprecated format.

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

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

668 Nothing -> throwError WrongElem

677 Nothing -> throwError WrongElem

669elemToParPart ns element

678elemToParPart ns element

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

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

@@ -751,13 +760,21 @@ elemToExtent drawingElem =

751childElemToRun :: NameSpaces -> Element -> D Run

760childElemToRun :: NameSpaces -> Element -> D Run

752childElemToRun ns element

761childElemToRun ns element

753 | isElem ns "w" "drawing" element =

762 | isElem ns "w" "drawing" element =

763+ let mbDocPr = findChild (elemName ns "wp" "inline") element >>=

764+ findChild (elemName ns "wp" "docPr")

765+ alt = case mbDocPr >>= findAttr (elemName ns "" "descr") of

766+ Just alt' -> alt'

767+ Nothing -> ""

768+ title = case mbDocPr >>= findAttr (elemName ns "" "title") of

769+ Just title' -> title'

770+ Nothing -> ""

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

771+ a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"

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

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

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

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

757 in

774 in

758 case drawing of

775 case drawing of

759 Just s -> expandDrawingId s >>=

776 Just s -> expandDrawingId s >>=

760− (\(fp, bs) -> return $ InlineDrawing fp bs $ elemToExtent element)

777+ (\(fp, bs) -> return $ InlineDrawing fp title alt bs $ elemToExtent element)

761 Nothing -> throwError WrongElem

778 Nothing -> throwError WrongElem

762childElemToRun ns element

779childElemToRun ns element

763 | isElem ns "w" "footnoteReference" element

780 | isElem ns "w" "footnoteReference" element