effc348 · typeable/pandoc

git.iko.soy/typeable/pandoc

Docx reader: Handle Alt text and titles in images.

We use the "description" field as alt text and the "title" field as title. These can be accessed through the "Format Picture" dialog in Word.

commiteffc348965f20f4131ac3b0357303c548d851308 authorJesse Rosenthal <jrosenthal@jhu.edu> dateWed 2 Nov 2016, 11:56 (10 years ago) parent1138ae6

2 files changed+28−11

compare with master

unifiedsplit

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

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

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

317317runToInlines (Endnote bps) = do

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

319319 return $ note blksList

320−runToInlines (InlineDrawing fp bs ext) = do

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

321321 mediaBag <- gets docxMediaBag

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

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

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

324324

325325extentToAttr :: Extent -> Attr

326326extentToAttr (Just (w, h)) =

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

401401 unless inHdrBool

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

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

404−parPartToInlines (Drawing fp bs ext) = do

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

405405 mediaBag <- gets docxMediaBag

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

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

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

408408parPartToInlines (InternalHyperLink anchor runs) = do

409409 ils <- smushInlines <$> mapM runToInlines runs

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

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

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

215215 | BookMark BookMarkId Anchor

216216 | InternalHyperLink Anchor [Run]

217217 | ExternalHyperLink URL [Run]

218− | Drawing FilePath B.ByteString Extent

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

219219 | PlainOMath [Exp]

220220 deriving Show

221221

222222data Run = Run RunStyle [RunElem]

223223 | Footnote [BodyPart]

224224 | Endnote [BodyPart]

225− | InlineDrawing FilePath B.ByteString Extent

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

226226 deriving Show

227227

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

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

649649elemToParPart ns element

650650 | isElem ns "w" "r" element

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

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

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 -> ""

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

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

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

655663 in

656664 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)

658666 Nothing -> throwError WrongElem

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

660668elemToParPart ns element

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

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

665673 in

666674 case drawing of

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

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

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

668677 Nothing -> throwError WrongElem

669678elemToParPart ns element

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

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

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

752761childElemToRun ns element

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

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

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 -> ""

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

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

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

757774 in

758775 case drawing of

759776 Just s -> expandDrawingId s >>=

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

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

761778 Nothing -> throwError WrongElem

762779childElemToRun ns element

763780 | isElem ns "w" "footnoteReference" element