@@ -82,17 +82,17 @@ import Text.Pandoc.Walk
8282import Text.Pandoc.Readers.Docx.Parse
8383import Text.Pandoc.Readers.Docx.Lists
8484import Text.Pandoc.Readers.Docx.Reducible
85−import Text.Pandoc.Readers.Docx.TexChar
8685import Text.Pandoc.Shared
8786import Text.Pandoc.MediaBag (insertMedia, MediaBag)
8887import Data.Maybe (mapMaybe, fromMaybe)
89−import Data.List (delete, stripPrefix, (\\), intercalate, intersect)
88+import Data.List (delete, stripPrefix, (\\), intersperse, intersect)
9089import Data.Monoid
90+import Text.TeXMath (writeTeX)
91+import qualified Text.TeXMath.Types as TM
9192import qualified Data.ByteString.Lazy as B
9293import qualified Data.Map as M
9394import Control.Monad.Reader
9495import Control.Monad.State
95−import Text.Printf (printf)
9696
9797readDocx :: ReaderOptions
9898 -> B.ByteString
@@ -381,158 +381,192 @@ parPartToInlines (ExternalHyperLink target runs) = do
381381 ils <- concatMapM runToInlines runs
382382 return [Link ils (target, "")]
383383parPartToInlines (PlainOMath omath) = do
384− s <- oMathToTexString omath
385− return [Math InlineMath s]
386−
387−oMathToTexString :: OMath -> DocxContext String
388−oMathToTexString (OMath omathElems) = do
389− ss <- mapM oMathElemToTexString omathElems
390− return $ intercalate " " ss
391−oMathElemToTexString :: OMathElem -> DocxContext String
392−oMathElemToTexString (Accent style base) | Just c <- accentChar style = do
393− baseString <- baseToTexString base
394− return $ case lookupTexChar c of
395− s@('\\' : _) -> printf "%s{%s}" s baseString
396− _ -> printf "\\acute{%s}" baseString -- we default.
397−oMathElemToTexString (Accent _ base) =
398− baseToTexString base >>= (\s -> return $ printf "\\acute{%s}" s)
399−oMathElemToTexString (Bar style base) = do
400− baseString <- baseToTexString base
384+ e <- oMathToExps omath
385+ return [Math InlineMath (writeTeX e)]
386+
387+oMathToExps :: OMath -> DocxContext [TM.Exp]
388+oMathToExps (OMath oMathElems) = concatMapM oMathElemToExps oMathElems
389+
390+oMathElemToExps :: OMathElem -> DocxContext [TM.Exp]
391+oMathElemToExps (Accent style base) = do
392+ baseExp <- baseToExp base
393+ let chr = case accentChar style of
394+ Just c -> c
395+ Nothing -> '\180' -- default to acute.
396+ return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
397+oMathElemToExps(Bar style base) = do
398+ baseExp <- baseToExp base
401399 return $ case barPos style of
402− Top -> printf "\\overline{%s}" baseString
403− Bottom -> printf "\\underline{%s}" baseString
404−oMathElemToTexString (Box base) = baseToTexString base
405−oMathElemToTexString (BorderBox base) =
406− baseToTexString base >>= (\s -> return $ printf "\\boxed{%s}" s)
407−oMathElemToTexString (Delimiter dPr bases) = do
408− let beg = fromMaybe '(' (delimBegChar dPr)
400+ Top -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
401+ Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
402+oMathElemToExps (Box base) =
403+ (\e -> return [e]) =<< baseToExp base
404+oMathElemToExps (BorderBox base) =
405+ -- TODO: This should be "\\boxed" somehow
406+ (\e -> return [e]) =<< baseToExp base
407+oMathElemToExps (Delimiter dPr bases) = do
408+ baseExps <- mapM baseToExp bases
409+ let inDelimExps = map Right baseExps
410+ beg = fromMaybe '(' (delimBegChar dPr)
409411 end = fromMaybe ')' (delimEndChar dPr)
410412 sep = fromMaybe '|' (delimSepChar dPr)
411− left = "\\left" ++ lookupTexChar beg
412− right = "\\right" ++ lookupTexChar end
413− mid = "\\middle" ++ lookupTexChar sep
414− baseStrings <- mapM baseToTexString bases
415− return $ printf "%s %s %s"
416− left
417− (intercalate (" " ++ mid ++ " ") baseStrings)
418− right
419−oMathElemToTexString (EquationArray bases) = do
420− baseStrings <- mapM baseToTexString bases
421− inSub <- gets docxInTexSubscript
422− return $
423− if inSub
424− then
425− printf "\\substack{%s}" (intercalate "\\\\ " baseStrings)
426− else
427− printf
428− "\\begin{aligned}\n%s\n\\end{aligned}"
429− (intercalate "\\\\\n" baseStrings)
430−oMathElemToTexString (Fraction num denom) = do
431− numString <- concatMapM oMathElemToTexString num
432− denString <- concatMapM oMathElemToTexString denom
433− return $ printf "\\frac{%s}{%s}" numString denString
434−oMathElemToTexString (Function fname base) = do
435− fnameString <- concatMapM oMathElemToTexString fname
436− baseString <- baseToTexString base
437− return $ printf "%s %s" fnameString baseString
438−oMathElemToTexString (Group style base)
439− | Just c <- groupChr style
440− , grouper <- lookupTexChar c
441− , notElem grouper ["\\overbrace", "\\underbrace"]
442− = do
443− baseString <- baseToTexString base
444− return $ case groupPos style of
445− Just Top -> printf "\\overset{%s}{%s}" grouper baseString
446− _ -> printf "\\underset{%s}{%s}" grouper baseString
447−oMathElemToTexString (Group style base) = do
448− baseString <- baseToTexString base
449− return $ case groupPos style of
450− Just Top -> printf "\\overbrace{%s}" baseString
451− _ -> printf "\\underbrace{%s}" baseString
452−oMathElemToTexString (LowerLimit base limElems) = do
453− baseString <- baseToTexString base
454− lim <- concatMapM oMathElemToTexString limElems
455− -- we want to make sure to replace the `\rightarrow` with `\to`
456− let arrowToTo :: String -> String
457− arrowToTo "" = ""
458− arrowToTo s | Just s' <- stripPrefix "\\rightarrow" s =
459− "\\to" ++ arrowToTo s'
460− arrowToTo (c:cs) = c : arrowToTo cs
461− lim' = arrowToTo lim
462− return $ case baseString of
463− "lim" -> printf "\\lim_{%s}" lim'
464− "max" -> printf "\\max_{%s}" lim'
465− "min" -> printf "\\min_{%s}" lim'
466− _ -> printf "\\operatorname*{%s}_{%s}" baseString lim'
467−oMathElemToTexString (UpperLimit base limElems) = do
468− baseString <- baseToTexString base
469− lim <- concatMapM oMathElemToTexString limElems
470− -- we want to make sure to replace the `\rightarrow` with `\to`
471− let arrowToTo :: String -> String
472− arrowToTo "" = ""
473− arrowToTo s | Just s' <- stripPrefix "\\rightarrow" s =
474− "\\to" ++ arrowToTo s'
475− arrowToTo (c:cs) = c : arrowToTo cs
476− lim' = arrowToTo lim
477− return $ case baseString of
478− "lim" -> printf "\\lim^{%s}" lim'
479− "max" -> printf "\\max^{%s}" lim'
480− "min" -> printf "\\min^{%s}" lim'
481− _ -> printf "\\operatorname*{%s}^{%s}" baseString lim'
482−oMathElemToTexString (Matrix bases) = do
483− let rowString :: [Base] -> DocxContext String
484− rowString bs = liftM (intercalate " & ") (mapM baseToTexString bs)
485−
486− s <- liftM (intercalate " \\\\\n")(mapM rowString bases)
487− return $ printf "\\begin{matrix}\n%s\n\\end{matrix}" s
488−oMathElemToTexString (NAry style sub sup base) | Just c <- nAryChar style = do
489− subString <- withDState (\s -> s{docxInTexSubscript = True}) $
490− concatMapM oMathElemToTexString sub
491− supString <- concatMapM oMathElemToTexString sup
492− baseString <- baseToTexString base
493− return $ case M.lookup c uniconvMap of
494− Just s@('\\':_) -> printf "%s_{%s}^{%s}{%s}"
495− s subString supString baseString
496− _ -> printf "\\operatorname*{%s}_{%s}^{%s}{%s}"
497− [c] subString supString baseString
498−oMathElemToTexString (NAry _ sub sup base) = do
499− subString <- concatMapM oMathElemToTexString sub
500− supString <- concatMapM oMathElemToTexString sup
501− baseString <- baseToTexString base
502− return $ printf "\\int_{%s}^{%s}{%s}"
503− subString supString baseString
504−oMathElemToTexString (Phantom base) = do
505− baseString <- baseToTexString base
506− return $ printf "\\phantom{%s}" baseString
507−oMathElemToTexString (Radical degree base) = do
508− degString <- concatMapM oMathElemToTexString degree
509− baseString <- baseToTexString base
510− return $ case trim degString of
511− "" -> printf "\\sqrt{%s}" baseString
512− _ -> printf "\\sqrt[%s]{%s}" degString baseString
513−oMathElemToTexString (PreSubSuper sub sup base) = do
514− subString <- concatMapM oMathElemToTexString sub
515− supString <- concatMapM oMathElemToTexString sup
516− baseString <- baseToTexString base
517− return $ printf "_{%s}^{%s}%s" subString supString baseString
518−oMathElemToTexString (Sub base sub) = do
519− baseString <- baseToTexString base
520− subString <- concatMapM oMathElemToTexString sub
521− return $ printf "%s_{%s}" baseString subString
522−oMathElemToTexString (SubSuper base sub sup) = do
523− baseString <- baseToTexString base
524− subString <- concatMapM oMathElemToTexString sub
525− supString <- concatMapM oMathElemToTexString sup
526− return $ printf "%s_{%s}^{%s}" baseString subString supString
527−oMathElemToTexString (Super base sup) = do
528− baseString <- baseToTexString base
529− supString <- concatMapM oMathElemToTexString sup
530− return $ printf "%s^{%s}" baseString supString
531−oMathElemToTexString (OMathRun _ run) = return $ stringToTex $ runToString run
532−
533−baseToTexString :: Base -> DocxContext String
534−baseToTexString (Base mathElems) =
535− concatMapM oMathElemToTexString mathElems
413+ exps = intersperse (Left [sep]) inDelimExps
414+ return [TM.EDelimited [beg] [end] exps]
415+oMathElemToExps (EquationArray bases) = do
416+ let f b = do bs <- baseToExp' b
417+ return [bs]
418+ baseExps <- mapM f bases
419+ return [TM.EArray [] baseExps]
420+oMathElemToExps (Fraction num denom) = do
421+ numExp <- concatMapM oMathElemToExps num >>= (return . TM.EGrouped)
422+ denExp <- concatMapM oMathElemToExps denom >>= (return . TM.EGrouped)
423+ return [TM.EFraction TM.NormalFrac numExp denExp]
424+oMathElemToExps (Function fname base) = do
425+ -- We need a string for the fname, but omml gives it to us as a
426+ -- series of oMath elems. We're going to filter out the oMathRuns,
427+ -- which should work for us most of the time.
428+ let f :: OMathElem -> String
429+ f (OMathRun _ run) = runToString run
430+ f _ = ""
431+ fnameString = concatMap f fname
432+ baseExp <- baseToExp base
433+ return [TM.EMathOperator fnameString, baseExp]
434+oMathElemToExps (Group style base)
435+ | Just Top <- groupPos style = do
436+ baseExp <- baseToExp base
437+ let chr = case groupChr style of
438+ Just c -> c
439+ Nothing -> '\65079' -- default to overbrace
440+ return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
441+ | otherwise = do
442+ baseExp <- baseToExp base
443+ let chr = case groupChr style of
444+ Just c -> c
445+ Nothing -> '\65080' -- default to underbrace
446+ return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
447+oMathElemToExps (LowerLimit base limElems) = do
448+ baseExp <- baseToExp base
449+ lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
450+ return [TM.EUnder True lim baseExp]
451+oMathElemToExps (UpperLimit base limElems) = do
452+ baseExp <- baseToExp base
453+ lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
454+ return [TM.EOver True lim baseExp]
455+oMathElemToExps (Matrix bases) = do
456+ rows <- mapM (mapM (\b -> baseToExp' b)) bases
457+ return [TM.EArray [TM.AlignCenter] rows]
458+oMathElemToExps (NAry style sub sup base) = do
459+ subExps <- concatMapM oMathElemToExps sub
460+ supExps <- concatMapM oMathElemToExps sup
461+ baseExp <- baseToExp base
462+ let opChar = case nAryChar style of
463+ Just c -> c
464+ -- default to integral
465+ Nothing -> '\8747'
466+ return [ TM.ESubsup
467+ (TM.ESymbol TM.Op [opChar])
468+ (TM.EGrouped subExps)
469+ (TM.EGrouped supExps)
470+ , baseExp]
471+oMathElemToExps (Phantom base) =
472+ (\e -> return [TM.EPhantom e]) =<< baseToExp base
473+oMathElemToExps (Radical degree base) = do
474+ degExps <- concatMapM oMathElemToExps degree
475+ baseExp <- baseToExp base
476+ return $ case degExps of
477+ [] -> [TM.ESqrt baseExp]
478+ ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
479+oMathElemToExps (PreSubSuper sub sup base) = do
480+ subExps <- concatMapM oMathElemToExps sub
481+ supExps <- concatMapM oMathElemToExps sup
482+ baseExp <- baseToExp base
483+ return [ TM.ESubsup
484+ (TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
485+ , baseExp]
486+oMathElemToExps (Sub base sub) = do
487+ baseExp <- baseToExp base
488+ subExps <- concatMapM oMathElemToExps sub
489+ return [TM.ESub baseExp (TM.EGrouped subExps)]
490+oMathElemToExps (SubSuper base sub sup) = do
491+ baseExp <- baseToExp base
492+ subExps <- concatMapM oMathElemToExps sub
493+ supExps <- concatMapM oMathElemToExps sup
494+ return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
495+oMathElemToExps (Super base sup) = do
496+ baseExp <- baseToExp base
497+ supExps <- concatMapM oMathElemToExps sup
498+ return [TM.ESuper baseExp (TM.EGrouped supExps)]
499+oMathElemToExps (OMathRun sty run@(Run _ _))
500+ | NoStyle <- oMathRunTextStyle sty =
501+ return $ [TM.EIdentifier $ runToString run]
502+ | Nothing <- oMathRunStyleToTextType sty =
503+ return $ [TM.EIdentifier $ runToString run]
504+ | Just textType <- oMathRunStyleToTextType sty =
505+ return $ if oMathLit sty
506+ then [TM.EText textType (runToString run)]
507+ else [TM.EStyled textType [TM.EIdentifier $ runToString run]]
508+oMathElemToExps (OMathRun _ _) = return []
509+
510+oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType
511+oMathRunStyleToTextType mrPr
512+ | Normal <- oMathRunTextStyle mrPr =
513+ Just $ TM.TextNormal
514+ | Styled scr sty <- oMathRunTextStyle mrPr
515+ ,Just OBold <- sty
516+ , Just OSansSerif <- scr =
517+ Just $ TM.TextSansSerifBold
518+ | Styled scr sty <- oMathRunTextStyle mrPr
519+ , Just OBoldItalic <- sty
520+ , Just OSansSerif <- scr =
521+ Just $ TM.TextSansSerifBoldItalic
522+ | Styled scr sty <- oMathRunTextStyle mrPr
523+ , Just OBold <- sty
524+ , Just OScript <- scr =
525+ Just $ TM.TextBoldScript
526+ | Styled scr sty <- oMathRunTextStyle mrPr
527+ , Just OBold <- sty
528+ , Just OFraktur <- scr =
529+ Just $ TM.TextBoldFraktur
530+ | Styled scr sty <- oMathRunTextStyle mrPr
531+ , Just OItalic <- sty
532+ , Just OSansSerif <- scr =
533+ Just $ TM.TextSansSerifItalic
534+ | Styled _ sty <- oMathRunTextStyle mrPr
535+ , Just OBold <- sty =
536+ Just $ TM.TextBold
537+ | Styled _ sty <- oMathRunTextStyle mrPr
538+ , Just OItalic <- sty =
539+ Just $ TM.TextItalic
540+ | Styled scr _ <- oMathRunTextStyle mrPr
541+ , Just OMonospace <- scr =
542+ Just $ TM.TextMonospace
543+ | Styled scr _ <- oMathRunTextStyle mrPr
544+ , Just OSansSerif <- scr =
545+ Just $ TM.TextSansSerif
546+ | Styled scr _ <- oMathRunTextStyle mrPr
547+ , Just ODoubleStruck <- scr =
548+ Just $ TM.TextDoubleStruck
549+ | Styled scr _ <- oMathRunTextStyle mrPr
550+ , Just OScript <- scr =
551+ Just $ TM.TextDoubleStruck
552+ | Styled scr _ <- oMathRunTextStyle mrPr
553+ , Just OFraktur <- scr =
554+ Just $ TM.TextFraktur
555+ | Styled _ sty <- oMathRunTextStyle mrPr
556+ , Just OBoldItalic <- sty =
557+ Just $ TM.TextBoldItalic
558+ | otherwise = Nothing
559+
560+
561+
562+baseToExp :: Base -> DocxContext TM.Exp
563+baseToExp (Base mathElems) =
564+ concatMapM oMathElemToExps mathElems >>= (return . TM.EGrouped)
565+
566+-- an ungrouped version of baseToExp
567+baseToExp' :: Base -> DocxContext [TM.Exp]
568+baseToExp' (Base mathElems) =
569+ concatMapM oMathElemToExps mathElems
536570
537571
538572isAnchorSpan :: Inline -> Bool
@@ -659,9 +693,10 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
659693
660694 return [Table caption alignments widths hdrCells cells]
661695bodyPartToBlocks (OMathPara _ maths) = do
662− omaths <- mapM oMathToTexString maths
663− return [Para $ map (\s -> Math DisplayMath s) omaths]
664−
696+ omaths <- mapM oMathToExps maths
697+ return [Para $
698+ map (\m -> Math DisplayMath (writeTeX m))
699+ omaths]
665700
666701-- replace targets with generated anchors.
667702rewriteLink :: Inline -> DocxContext Inline