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.hs93
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs3
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse/Styles.hs18
3 files changed, 59 insertions, 55 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index ddec0bdf8..c9aa2f7c5 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -261,46 +261,43 @@ resolveDependentRunStyle rPr
| otherwise = return rPr
runStyleToTransform :: PandocMonad m => RunStyle -> DocxContext m (Inlines -> Inlines)
-runStyleToTransform rPr
- | Just sn <- getStyleName <$> rParentStyle rPr
- , sn `elem` spansToKeep = do
- transform <- runStyleToTransform rPr{rParentStyle = Nothing}
- return $ spanWith ("", [normalizeToClassName sn], []) . transform
- | Just s <- rParentStyle rPr = do
- ei <- extraInfo spanWith s
- transform <- runStyleToTransform rPr{rParentStyle = Nothing}
- return $ ei . transform
- | Just True <- isItalic rPr = do
- transform <- runStyleToTransform rPr{isItalic = Nothing}
- return $ emph . transform
- | Just True <- isBold rPr = do
- transform <- runStyleToTransform rPr{isBold = Nothing}
- return $ strong . transform
- | Just True <- isSmallCaps rPr = do
- transform <- runStyleToTransform rPr{isSmallCaps = Nothing}
- return $ smallcaps . transform
- | Just True <- isStrike rPr = do
- transform <- runStyleToTransform rPr{isStrike = Nothing}
- return $ strikeout . transform
- | Just True <- isRTL rPr = do
- transform <- runStyleToTransform rPr{isRTL = Nothing}
- return $ spanWith ("",[],[("dir","rtl")]) . transform
- | Just False <- isRTL rPr = do
- transform <- runStyleToTransform rPr{isRTL = Nothing}
- inBidi <- asks docxInBidi
- return $ if inBidi
- then spanWith ("",[],[("dir","ltr")]) . transform
- else transform
- | Just SupScrpt <- rVertAlign rPr = do
- transform <- runStyleToTransform rPr{rVertAlign = Nothing}
- return $ superscript . transform
- | Just SubScrpt <- rVertAlign rPr = do
- transform <- runStyleToTransform rPr{rVertAlign = Nothing}
- return $ subscript . transform
- | Just "single" <- rUnderline rPr = do
- transform <- runStyleToTransform rPr{rUnderline = Nothing}
- return $ Pandoc.underline . transform
- | otherwise = return id
+runStyleToTransform rPr' = do
+ opts <- asks docxOptions
+ inBidi <- asks docxInBidi
+ let styles = isEnabled Ext_styles opts
+ ctl = (Just True == isRTL rPr') || (Just True == isForceCTL rPr')
+ italic rPr | ctl = isItalicCTL rPr
+ | otherwise = isItalic rPr
+ bold rPr | ctl = isBoldCTL rPr
+ | otherwise = isBold rPr
+ go rPr
+ | Just sn <- getStyleName <$> rParentStyle rPr
+ , sn `elem` spansToKeep =
+ spanWith ("", [normalizeToClassName sn], [])
+ . go rPr{rParentStyle = Nothing}
+ | styles, Just s <- rParentStyle rPr =
+ spanWith (extraAttr s) . go rPr{rParentStyle = Nothing}
+ | Just True <- italic rPr =
+ emph . go rPr{isItalic = Nothing, isItalicCTL = Nothing}
+ | Just True <- bold rPr =
+ strong . go rPr{isBold = Nothing, isBoldCTL = Nothing}
+ | Just True <- isSmallCaps rPr =
+ smallcaps . go rPr{isSmallCaps = Nothing}
+ | Just True <- isStrike rPr =
+ strikeout . go rPr{isStrike = Nothing}
+ | Just True <- isRTL rPr =
+ spanWith ("",[],[("dir","rtl")]) . go rPr{isRTL = Nothing}
+ | inBidi, Just False <- isRTL rPr =
+ spanWith ("",[],[("dir","ltr")]) . go rPr{isRTL = Nothing}
+ | Just SupScrpt <- rVertAlign rPr =
+ superscript . go rPr{rVertAlign = Nothing}
+ | Just SubScrpt <- rVertAlign rPr = do
+ subscript . go rPr{rVertAlign = Nothing}
+ | Just "single" <- rUnderline rPr = do
+ Pandoc.underline . go rPr{rUnderline = Nothing}
+ | otherwise = id
+ return $ go rPr'
+
runToInlines :: PandocMonad m => Run -> DocxContext m Inlines
runToInlines (Run rs runElems)
@@ -512,13 +509,8 @@ trimSps (Many ils) = Many $ Seq.dropWhileL isSp $Seq.dropWhileR isSp ils
isSp LineBreak = True
isSp _ = False
-extraInfo :: (Eq (StyleName a), PandocMonad m, HasStyleName a)
- => (Attr -> i -> i) -> a -> DocxContext m (i -> i)
-extraInfo f s = do
- opts <- asks docxOptions
- return $ if isEnabled Ext_styles opts
- then f ("", [], [("custom-style", fromStyleName $ getStyleName s)])
- else id
+extraAttr :: (Eq (StyleName a), HasStyleName a) => a -> Attr
+extraAttr s = ("", [], [("custom-style", fromStyleName $ getStyleName s)])
parStyleToTransform :: PandocMonad m => ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform pPr = case pStyle pPr of
@@ -534,8 +526,11 @@ parStyleToTransform pPr = case pStyle pPr of
| otherwise -> do
let pPr' = pPr { pStyle = cs }
transform <- parStyleToTransform pPr'
- ei <- extraInfo divWith c
- return $ ei . (if isBlockQuote c then blockQuote else id) . transform
+ styles <- asks (isEnabled Ext_styles . docxOptions)
+ return $
+ (if styles then divWith (extraAttr c) else id)
+ . (if isBlockQuote c then blockQuote else id)
+ . transform
[]
| Just left <- indentation pPr >>= leftParIndent -> do
let pPr' = pPr { indentation = Nothing }
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index 199ca6d03..eab4f4e0d 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -259,10 +259,13 @@ newtype Cell = Cell [BodyPart]
leftBiasedMergeRunStyle :: RunStyle -> RunStyle -> RunStyle
leftBiasedMergeRunStyle a b = RunStyle
{ isBold = isBold a <|> isBold b
+ , isBoldCTL = isBoldCTL a <|> isBoldCTL b
, isItalic = isItalic a <|> isItalic b
+ , isItalicCTL = isItalicCTL a <|> isItalicCTL b
, isSmallCaps = isSmallCaps a <|> isSmallCaps b
, isStrike = isStrike a <|> isStrike b
, isRTL = isRTL a <|> isRTL b
+ , isForceCTL = isForceCTL a <|> isForceCTL b
, rVertAlign = rVertAlign a <|> rVertAlign b
, rUnderline = rUnderline a <|> rUnderline b
, rParentStyle = rParentStyle a
diff --git a/src/Text/Pandoc/Readers/Docx/Parse/Styles.hs b/src/Text/Pandoc/Readers/Docx/Parse/Styles.hs
index bfbc65cb0..236167187 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse/Styles.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse/Styles.hs
@@ -44,7 +44,6 @@ module Text.Pandoc.Readers.Docx.Parse.Styles (
) where
import Codec.Archive.Zip
import Control.Applicative ((<|>))
-import Control.Monad.Except
import Data.Function (on)
import Data.String (IsString(..))
import qualified Data.Map as M
@@ -101,10 +100,13 @@ data CharStyle = CharStyle { cStyleId :: CharStyleId
} deriving (Show)
data RunStyle = RunStyle { isBold :: Maybe Bool
+ , isBoldCTL :: Maybe Bool
, isItalic :: Maybe Bool
+ , isItalicCTL :: Maybe Bool
, isSmallCaps :: Maybe Bool
, isStrike :: Maybe Bool
, isRTL :: Maybe Bool
+ , isForceCTL :: Maybe Bool
, rVertAlign :: Maybe VertAlign
, rUnderline :: Maybe String
, rParentStyle :: Maybe CharStyle
@@ -121,10 +123,13 @@ data ParStyle = ParStyle { headingLev :: Maybe (ParaStyleName, Int)
defaultRunStyle :: RunStyle
defaultRunStyle = RunStyle { isBold = Nothing
+ , isBoldCTL = Nothing
, isItalic = Nothing
+ , isItalicCTL = Nothing
, isSmallCaps = Nothing
, isStrike = Nothing
, isRTL = Nothing
+ , isForceCTL = Nothing
, rVertAlign = Nothing
, rUnderline = Nothing
, rParentStyle = Nothing
@@ -240,20 +245,21 @@ elemToCharStyle :: NameSpaces
elemToCharStyle ns element parentStyle
= CharStyle <$> (CharStyleId <$> findAttrTextByName ns "w" "styleId" element)
<*> getElementStyleName ns element
- <*> (Just $ elemToRunStyle ns element parentStyle)
+ <*> Just (elemToRunStyle ns element parentStyle)
elemToRunStyle :: NameSpaces -> Element -> Maybe CharStyle -> RunStyle
elemToRunStyle ns element parentStyle
| Just rPr <- findChildByName ns "w" "rPr" element =
RunStyle
{
- isBold = checkOnOff ns rPr (elemName ns "w" "b") `mplus`
- checkOnOff ns rPr (elemName ns "w" "bCs")
- , isItalic = checkOnOff ns rPr (elemName ns "w" "i") `mplus`
- checkOnOff ns rPr (elemName ns "w" "iCs")
+ isBold = checkOnOff ns rPr (elemName ns "w" "b")
+ , isBoldCTL = checkOnOff ns rPr (elemName ns "w" "bCs")
+ , isItalic = checkOnOff ns rPr (elemName ns "w" "i")
+ , isItalicCTL = checkOnOff ns rPr (elemName ns "w" "iCs")
, isSmallCaps = checkOnOff ns rPr (elemName ns "w" "smallCaps")
, isStrike = checkOnOff ns rPr (elemName ns "w" "strike")
, isRTL = checkOnOff ns rPr (elemName ns "w" "rtl")
+ , isForceCTL = checkOnOff ns rPr (elemName ns "w" "cs")
, rVertAlign =
findChildByName ns "w" "vertAlign" rPr >>=
findAttrByName ns "w" "val" >>=
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-27 07:53:40 +0000