From d4748038d76dd430f7c760e73487172a3264c5de Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Tue, 12 Aug 2014 22:04:07 -0400
Subject: Docx Reader: Fix font style parsing.

Before we just checked for the existence of a tag. Now, we make sure to
check for its on/off value.
---
 src/Text/Pandoc/Readers/Docx/Parse.hs | 39 ++++++++++++++++++++++++-----------
 1 file changed, 27 insertions(+), 12 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index 175bf2784..32b0f8d93 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -652,30 +652,45 @@ elemToParagraphStyle ns element
       }
 elemToParagraphStyle _ _ =  defaultParagraphStyle
 
+checkOnOff :: NameSpaces -> Element -> QName -> Bool
+checkOnOff ns rPr tag
+  | Just t <-  findChild tag rPr
+  , Just val <- findAttr (elemName ns "w" "val") t =
+    case val of
+      "true" -> True
+      "false" -> False
+      "on"    -> True
+      "off"   -> False
+      "1"     -> True
+      "0"     -> False
+      _       -> False
+  | Just _ <- findChild tag rPr = True
+checkOnOff _ _ _ = False
+
 
 elemToRunStyle :: NameSpaces -> Element -> RunStyle
 elemToRunStyle ns element
   | Just rPr <- findChild (elemName ns "w" "rPr") element =
     RunStyle
       {
-        isBold = isJust $ findChild (QName "b" (lookup "w" ns) (Just "w")) rPr
-      , isItalic = isJust $ findChild (QName "i" (lookup "w" ns) (Just "w")) rPr
-      , isSmallCaps = isJust $ findChild (QName "smallCaps" (lookup "w" ns) (Just "w")) rPr
-      , isStrike = isJust $ findChild (QName "strike" (lookup "w" ns) (Just "w")) rPr
+        isBold = checkOnOff ns rPr (elemName ns "w" "b")
+      , isItalic = checkOnOff ns rPr (elemName ns "w" "i")
+      , isSmallCaps = checkOnOff ns rPr (elemName ns "w" "smallCaps")
+      , isStrike = checkOnOff ns rPr (elemName ns "w" "strike")
       , isSuperScript =
         (Just "superscript" ==
-        (findChild (QName "vertAlign" (lookup "w" ns) (Just "w")) rPr >>=
-         findAttr (QName "val" (lookup "w" ns) (Just "w"))))
+         (findChild (elemName ns "w" "vertAlign") rPr >>=
+          findAttr (elemName ns "w" "val")))
       , isSubScript =
         (Just "subscript" ==
-        (findChild (QName "vertAlign" (lookup "w" ns) (Just "w")) rPr >>=
-         findAttr (QName "val" (lookup "w" ns) (Just "w"))))
+         (findChild (elemName ns "w" "vertAlign") rPr >>=
+          findAttr (elemName ns "w" "val")))
       , rUnderline =
-        findChild (QName "u" (lookup "w" ns) (Just "w")) rPr >>=
-        findAttr (QName "val" (lookup "w" ns) (Just "w"))
+          findChild (elemName ns "w" "u") rPr >>=
+          findAttr (elemName ns "w" "val")
       , rStyle =
-        findChild (QName "rStyle" (lookup "w" ns) (Just "w")) rPr >>=
-        findAttr (QName "val" (lookup "w" ns) (Just "w"))
+          findChild (elemName ns "w" "rStyle") rPr >>=
+          findAttr (elemName ns "w" "val")
         }
 elemToRunStyle _ _ = defaultRunStyle
 
-- 
cgit v1.2.3