From 53b2a5173f7b8e949f2fa3307ca79497e1327119 Mon Sep 17 00:00:00 2001 From: John Pye Date: Sun, 15 Feb 2026 13:26:57 +1100 Subject: [PATCH 1/6] first implemenation of direct StarMath writer --- pandoc.cabal | 3 + src/Text/Pandoc/Writers/ODT.hs | 52 +++- src/Text/Pandoc/Writers/StarMath.hs | 417 ++++++++++++++++++++++++++++ test/Tests/Writers/StarMath.hs | 145 ++++++++++ test/test-pandoc.hs | 2 + 5 files changed, 616 insertions(+), 3 deletions(-) create mode 100644 src/Text/Pandoc/Writers/StarMath.hs create mode 100644 test/Tests/Writers/StarMath.hs diff --git a/pandoc.cabal b/pandoc.cabal index 3640dc43cd24..b4c7307e226d 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -682,6 +682,7 @@ library Text.Pandoc.Writers.Muse, Text.Pandoc.Writers.CslJson, Text.Pandoc.Writers.Math, + Text.Pandoc.Writers.StarMath, Text.Pandoc.Writers.Shared, Text.Pandoc.Writers.OOXML, Text.Pandoc.Writers.AnnotatedTable, @@ -849,6 +850,7 @@ test-suite test-pandoc tasty-hunit >= 0.9 && < 0.11, tasty-quickcheck >= 0.8 && < 0.12, text >= 1.1.1.0 && < 2.2, + texmath >= 0.13.1 && < 0.14, temporary >= 1.1 && < 1.4, time >= 1.5 && < 1.16, xml >= 1.3.12 && < 1.4, @@ -913,6 +915,7 @@ test-suite test-pandoc Tests.Writers.Powerpoint Tests.Writers.OOXML Tests.Writers.Ms + Tests.Writers.StarMath Tests.Writers.AnnotatedTable Tests.Writers.BBCode diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 53c358309f13..7c78874c7a41 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -45,6 +45,7 @@ import Text.Pandoc.Writers.Shared (lookupMetaString, lookupMetaBlocks, import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toTextLazy) import Text.Pandoc.Walk import Text.Pandoc.Writers.OpenDocument (writeOpenDocument) +import Text.Pandoc.Writers.StarMath (writeStarMath) import Text.Pandoc.XML import Text.Pandoc.XML.Light import Text.TeXMath @@ -299,11 +300,15 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError transformPicMath _ (Math t math) = do entries <- gets stEntries let dt = if t == InlineMath then DisplayInline else DisplayBlock - case writeMathML dt <$> readTeX math of + case readTeX math of Left _ -> return $ Math t math - Right r -> do + Right exps -> do let conf = XL.useShortEmptyTags (const False) XL.defaultConfigPP - let mathml = XL.ppcTopElement conf r + let starMath = + writeStarMath dt exps <> "\n" <> starMathCommentFromTeX math + let mathmlElement = + addStarMathAnnotation starMath (writeMathML dt exps) + let mathml = XL.ppcTopElement conf mathmlElement epochtime <- floor `fmap` lift P.getPOSIXTime let dirname = "Formula-" ++ show (length entries) ++ "/" let fname = dirname ++ "content.xml" @@ -328,6 +333,47 @@ transformPicMath _ (Math t math) = do transformPicMath _ x = return x +starMathCommentFromTeX :: T.Text -> T.Text +starMathCommentFromTeX tex = + case T.lines normalized of + [] -> "%% TeX:" + (l : ls) -> + T.intercalate "\n" (("%% TeX: " <> l) : map ("%% " <>) ls) + where + normalized = T.replace "\r\n" "\n" (T.replace "\r" "\n" tex) + +addStarMathAnnotation :: T.Text -> XL.Element -> XL.Element +addStarMathAnnotation starMath e = + case XL.elContent e of + [XL.Elem sem] | XL.qName (XL.elName sem) == "semantics" -> + e { XL.elContent = [XL.Elem (withAnnotation sem)] } + _ -> + e { XL.elContent = [XL.Elem (mkSemantics (XL.elContent e))] } + where + mkSemantics cs = + XL.Element (mkMathQName "semantics") [] (cs ++ [XL.Elem annotation]) Nothing + + withAnnotation sem = + sem { XL.elContent = + filter (not . isStarMathAnnotation) (XL.elContent sem) + ++ [XL.Elem annotation] } + + annotation = + XL.Element (mkMathQName "annotation") + [XL.Attr (XL.QName "encoding" Nothing Nothing) "StarMath 5.0"] + [XL.Text (XL.CData XL.CDataText (T.unpack starMath) Nothing)] + Nothing + + isStarMathAnnotation (XL.Elem el) = + XL.qName (XL.elName el) == "annotation" && + any (\a -> XL.qName (XL.attrKey a) == "encoding" + && XL.attrVal a == "StarMath 5.0") + (XL.elAttribs el) + isStarMathAnnotation _ = False + + mkMathQName n = + XL.QName n (XL.qURI $ XL.elName e) (XL.qPrefix $ XL.elName e) + documentSettings :: Bool -> B.ByteString documentSettings isTextMode = fromStringLazy $ render Nothing $ text "" diff --git a/src/Text/Pandoc/Writers/StarMath.hs b/src/Text/Pandoc/Writers/StarMath.hs new file mode 100644 index 000000000000..459bd7085f5f --- /dev/null +++ b/src/Text/Pandoc/Writers/StarMath.hs @@ -0,0 +1,417 @@ +{-# LANGUAGE OverloadedStrings #-} +module Text.Pandoc.Writers.StarMath + ( writeStarMath + ) where + +import qualified Data.Text as T +import Text.TeXMath (DisplayType, writeTeX) +import Text.TeXMath.Types + ( Exp(..) + , Alignment(..) + , FractionType(..) + , TeXSymbolType(..) + ) + +-- | Render TeXMath expressions as StarMath syntax. +-- Falls back to TeX output for expressions that are not yet supported. +writeStarMath :: DisplayType -> [Exp] -> T.Text +writeStarMath _dt exps = + case renderExps exps of + Just rendered -> T.strip rendered + Nothing -> writeTeX exps + +renderExps :: [Exp] -> Maybe T.Text +renderExps = fmap T.concat . mapM renderExp + +renderExp :: Exp -> Maybe T.Text +renderExp e = + case e of + ENumber t -> Just t + EIdentifier t -> Just (renderIdentifier t) + EMathOperator t -> Just t + ESymbol t s -> Just (renderSymbol t s) + EText _ t -> Just (quoteText t) + ESpace _ -> Just " " + EGrouped xs -> ("{" <>) . (<> "}") <$> renderExps xs + EStyled _ xs -> renderExps xs + + EFraction frac num den -> do + num' <- renderExp num + den' <- renderExp den + pure $ case frac of + NoLineFrac -> "{" <> num' <> " / " <> den' <> "}" + _ -> "{" <> num' <> " over " <> den' <> "}" + + ESqrt x -> ("sqrt {" <>) . (<> "}") <$> renderExp x + ERoot idx rad -> do + idx' <- renderExp idx + rad' <- renderExp rad + pure $ "nroot {" <> idx' <> "} {" <> rad' <> "}" + + EDelimited op cl xs -> do + body <- renderDelimitedBody xs + let op' = delimToken DelimLeft op + let cl' = delimToken DelimRight cl + pure $ "left " <> op' <> " " <> body <> " right " <> cl' + + ESub base sub -> do + case largeOpName base of + Just op -> do + sub' <- renderLimitArg sub + pure $ op <> " from " <> sub' <> " " + Nothing -> do + base' <- renderExp base + sub' <- renderScriptArg sub + pure $ renderScriptBase base base' <> "_" <> sub' + + ESuper base sup -> do + case largeOpName base of + Just op -> do + sup' <- renderLimitArg sup + pure $ op <> " to " <> sup' <> " " + Nothing -> do + base' <- renderExp base + sup' <- renderScriptArg sup + pure $ renderScriptBase base base' <> "^" <> sup' + + ESubsup base sub sup -> do + case largeOpName base of + Just op -> do + sub' <- renderLimitArg sub + sup' <- renderLimitArg sup + pure $ op <> " from " <> sub' <> " to " <> sup' <> " " + Nothing -> do + base' <- renderExp base + sub' <- renderScriptArg sub + sup' <- renderScriptArg sup + pure $ renderScriptBase base base' <> "_" <> sub' <> "^" <> sup' + + EOver _ base over + | Just accent <- accentName over -> do + base' <- renderExp base + pure $ accent <> " " <> renderAccentArg base base' + | otherwise -> Nothing + + EUnder _ base under -> + case largeOpName base of + Just op -> do + under' <- renderLimitArg under + pure $ op <> " from " <> under' <> " " + Nothing -> Nothing + EUnderover _ base under over -> + case largeOpName base of + Just op -> do + under' <- renderLimitArg under + over' <- renderLimitArg over + pure $ op <> " from " <> under' <> " to " <> over' <> " " + Nothing -> Nothing + EArray aligns rows -> renderMatrix aligns rows + EPhantom{} -> Nothing + _ -> Nothing + +renderDelimitedPart :: Either T.Text Exp -> Maybe T.Text +renderDelimitedPart p = + case p of + Left t -> Just $ " " <> delimToken DelimMiddle t <> " " + Right x -> renderExp x + +renderDelimitedBody :: [Either T.Text Exp] -> Maybe T.Text +renderDelimitedBody xs = T.strip <$> (fmap T.concat $ mapM renderDelimitedPart xs) + +renderMatrix :: [Alignment] -> [[[Exp]]] -> Maybe T.Text +renderMatrix aligns rows + | not (all (== AlignCenter) aligns) = Nothing + | otherwise = do + rows' <- mapM renderMatrixRow rows + pure $ "matrix { " <> T.intercalate " ## " rows' <> " }" + +renderMatrixRow :: [[Exp]] -> Maybe T.Text +renderMatrixRow cells = do + cells' <- mapM renderMatrixCell cells + pure $ T.intercalate " # " cells' + +renderMatrixCell :: [Exp] -> Maybe T.Text +renderMatrixCell [] = Just "{}" +renderMatrixCell xs = do + rendered <- renderExps xs + let stripped = T.strip rendered + pure $ if T.null stripped then "{}" else stripped + +renderIdentifier :: T.Text -> T.Text +renderIdentifier ident = + case greekName ident of + Just name + | shouldItalicizeGreek ident -> "%i" <> name + | otherwise -> "%" <> name + Nothing -> ident + +-- Lowercase Greek identifiers are variables in TeX math and are usually italic. +shouldItalicizeGreek :: T.Text -> Bool +shouldItalicizeGreek ident = + case ident of + "α" -> True + "β" -> True + "γ" -> True + "δ" -> True + "ϵ" -> True + "ε" -> True + "ζ" -> True + "η" -> True + "θ" -> True + "ϑ" -> True + "ι" -> True + "κ" -> True + "λ" -> True + "μ" -> True + "ν" -> True + "ξ" -> True + "ο" -> True + "π" -> True + "ϖ" -> True + "ρ" -> True + "ϱ" -> True + "𝜚" -> True + "σ" -> True + "ς" -> True + "𝜍" -> True + "τ" -> True + "υ" -> True + "ϕ" -> True + "φ" -> True + "χ" -> True + "ψ" -> True + "ω" -> True + _ -> False + +greekName :: T.Text -> Maybe T.Text +greekName ident = + case ident of + "α" -> Just "alpha" + "β" -> Just "beta" + "γ" -> Just "gamma" + "δ" -> Just "delta" + "ϵ" -> Just "varepsilon" + "ε" -> Just "epsilon" + "ζ" -> Just "zeta" + "η" -> Just "eta" + "θ" -> Just "theta" + "ϑ" -> Just "vartheta" + "ι" -> Just "iota" + "κ" -> Just "kappa" + "λ" -> Just "lambda" + "μ" -> Just "mu" + "ν" -> Just "nu" + "ξ" -> Just "xi" + "ο" -> Just "omicron" + "π" -> Just "pi" + "ϖ" -> Just "varpi" + "ρ" -> Just "rho" + "ϱ" -> Just "varrho" + "𝜚" -> Just "varrho" + "σ" -> Just "sigma" + "ς" -> Just "varsigma" + "𝜍" -> Just "varsigma" + "τ" -> Just "tau" + "υ" -> Just "upsilon" + "ϕ" -> Just "phi" + "φ" -> Just "varphi" + "χ" -> Just "chi" + "ψ" -> Just "psi" + "ω" -> Just "omega" + "Γ" -> Just "GAMMA" + "Δ" -> Just "DELTA" + "Θ" -> Just "THETA" + "Λ" -> Just "LAMBDA" + "Ξ" -> Just "XI" + "Π" -> Just "PI" + "Σ" -> Just "SIGMA" + "Υ" -> Just "UPSILON" + "Φ" -> Just "PHI" + "Ψ" -> Just "PSI" + "Ω" -> Just "OMEGA" + _ -> Nothing + +renderScriptBase :: Exp -> T.Text -> T.Text +renderScriptBase e rendered0 = + let rendered = T.strip rendered0 + in + if isAtomic e + then rendered + else "{" <> rendered <> "}" + +renderScriptArg :: Exp -> Maybe T.Text +renderScriptArg e = do + rendered0 <- renderExp e + let rendered = T.strip rendered0 + pure $ if isAtomic e + then rendered + else "{" <> rendered <> "}" + +renderLimitArg :: Exp -> Maybe T.Text +renderLimitArg e = + case e of + EGrouped xs -> renderExps xs + _ -> T.strip <$> renderExp e + +renderAccentArg :: Exp -> T.Text -> T.Text +renderAccentArg e rendered0 = + let rendered = T.strip rendered0 + in + if isAtomic e + then rendered + else "{" <> rendered <> "}" + +isAtomic :: Exp -> Bool +isAtomic e = + case e of + ENumber{} -> True + EIdentifier{} -> True + EMathOperator{} -> True + EText{} -> True + ESymbol{} -> True + _ -> False + +accentName :: Exp -> Maybe T.Text +accentName e = + case e of + ESymbol Accent s -> accentFromChar s + ESymbol _ s -> accentFromChar s + _ -> Nothing + +accentFromChar :: T.Text -> Maybe T.Text +accentFromChar s = + case s of + "\775" -> Just "dot" -- COMBINING DOT ABOVE + "˙" -> Just "dot" -- DOT ABOVE + "\776" -> Just "ddot" -- COMBINING DIAERESIS + "¨" -> Just "ddot" -- DIAERESIS + "\770" -> Just "hat" -- COMBINING CIRCUMFLEX ACCENT + "ˆ" -> Just "hat" -- MODIFIER LETTER CIRCUMFLEX ACCENT + "\780" -> Just "check" -- COMBINING CARON + "ˇ" -> Just "check" -- CARON + "\771" -> Just "tilde" -- COMBINING TILDE + "˜" -> Just "tilde" -- SMALL TILDE + "\772" -> Just "bar" -- COMBINING MACRON + "\8254" -> Just "bar" -- OVERLINE + "¯" -> Just "bar" -- MACRON + "\8407" -> Just "vec" -- COMBINING RIGHT ARROW ABOVE + "→" -> Just "vec" -- RIGHTWARDS ARROW + "\774" -> Just "breve" -- COMBINING BREVE + "˘" -> Just "breve" -- BREVE + _ -> Nothing + +data DelimSide = DelimLeft | DelimRight | DelimMiddle + +delimToken :: DelimSide -> T.Text -> T.Text +delimToken side raw = + case raw of + "" -> "none" + "." -> "none" + "(" -> "(" + ")" -> ")" + "[" -> "[" + "]" -> "]" + "{" -> case side of + DelimLeft -> "lbrace" + DelimRight -> "rbrace" + DelimMiddle -> "{" + "}" -> case side of + DelimLeft -> "lbrace" + DelimRight -> "rbrace" + DelimMiddle -> "}" + "|" -> case side of + DelimLeft -> "lline" + DelimRight -> "rline" + DelimMiddle -> "mline" + "∣" -> case side of + DelimLeft -> "lline" + DelimRight -> "rline" + DelimMiddle -> "mline" + "∥" -> case side of + DelimLeft -> "ldline" + DelimRight -> "rdline" + DelimMiddle -> "mline" + "⟨" -> "langle" + "⟩" -> "rangle" + "⌊" -> "lfloor" + "⌋" -> "rfloor" + "⌈" -> "lceil" + "⌉" -> "rceil" + "⟦" -> "ldbracket" + "⟧" -> "rdbracket" + _ -> raw + +renderSymbol :: TeXSymbolType -> T.Text -> T.Text +renderSymbol _ s = + case s of + "∫" -> "int " + "∑" -> "sum " + "←" -> " leftarrow " + "→" -> " toward " + "↔" -> " leftrightarrow " + "⇐" -> " dlarrow " + "⇒" -> " drarrow " + "⇔" -> " dlrarrow " + "↑" -> " uparrow " + "↓" -> " downarrow " + "≤" -> " <= " + "≥" -> " >= " + "≠" -> " <> " + "≈" -> " approx " + "∼" -> " sim " + "≃" -> " simeq " + "≡" -> " equiv " + "∝" -> " prop " + "∥" -> " parallel " + "∣" -> " divides " + "∤" -> " ndivides " + "⊥" -> " ortho " + "⟂" -> " ortho " + "∈" -> " in " + "∉" -> " notin " + "∋" -> " owns " + "⊂" -> " subset " + "⊆" -> " subseteq " + "⊃" -> " supset " + "⊇" -> " supseteq " + "⊄" -> " nsubset " + "⊈" -> " nsubseteq " + "⊅" -> " nsupset " + "⊉" -> " nsupseteq " + "∪" -> " union " + "∩" -> " intersection " + "\\" -> " setminus " + "∧" -> " and " + "∨" -> " or " + "∀" -> "forall " + "∃" -> " exists " + "∄" -> " notexists " + "∂" -> " partial " + "∇" -> "nabla " + "∞" -> "infinity" + "∅" -> "emptyset" + "+" -> " + " + "-" -> " - " + "=" -> " = " + "," -> ", " + ";" -> "; " + ":" -> ": " + "/" -> " / " + "⋅" -> " cdot " + "·" -> " cdot " + "×" -> " times " + _ -> s + +largeOpName :: Exp -> Maybe T.Text +largeOpName e = + case e of + ESymbol _ "∫" -> Just "int" + ESymbol _ "∑" -> Just "sum" + _ -> Nothing + +quoteText :: T.Text -> T.Text +quoteText = ("\"" <>) . (<> "\"") . T.concatMap go + where + go '"' = "\\\"" + go '\\' = "\\\\" + go c = T.singleton c diff --git a/test/Tests/Writers/StarMath.hs b/test/Tests/Writers/StarMath.hs new file mode 100644 index 000000000000..cab07ab63bba --- /dev/null +++ b/test/Tests/Writers/StarMath.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.StarMath (tests) where + +import Data.Text (Text, unpack) +import Test.Tasty +import Test.Tasty.HUnit +import Text.TeXMath (DisplayType(..), readTeX, writeTeX) +import Text.Pandoc.Writers.StarMath (writeStarMath) + +tests :: [TestTree] +tests = + [ testCase "dot + text subscript" $ + star "\\dot{Q}_{\\text{dem}}(t)=\\dot{Q}_{\\text{eb}}(t)+\\dot{Q}_{\\text{dis}}(t)+\\dot{Q}_{\\text{boil}}(t)," + @?= + "{dot Q}_\"dem\"(t) = {dot Q}_\"eb\"(t) + {dot Q}_\"dis\"(t) + {dot Q}_\"boil\"(t)," + , testCase "common accents" $ + star "\\ddot{x}+\\hat{x}+\\tilde{x}+\\vec{x}+\\bar{x}" + @?= + "ddot x + hat x + tilde x + vec x + bar x" + , testCase "fraction" $ + star "\\frac{a+b}{c}" + @?= + "{{a + b} over c}" + , testCase "square root" $ + star "\\sqrt{x+1}" + @?= + "sqrt {{x + 1}}" + , testCase "nth root" $ + star "\\sqrt[3]{x}" + @?= + "nroot {3} {x}" + , testCase "subscript and superscript" $ + star "x_i^2" + @?= + "x_i^2" + , testCase "superscript with grouped base" $ + star "(a+b)^2" + @?= + "(a + b)^2" + , testCase "delimited fraction" $ + star "\\left(\\frac{a}{b}\\right)" + @?= + "left ( {a over b} right )" + , testCase "delimited braces" $ + star "\\left\\{\\frac{a}{b}\\right\\}" + @?= + "left lbrace {a over b} right rbrace" + , testCase "one-sided delimiter uses none" $ + star "\\left. x \\right|" + @?= + "left none x right rline" + , testCase "middle delimiter uses mline" $ + star "\\left( x \\middle| y \\right)" + @?= + "left ( x mline y right )" + , testCase "operator mapping cdot" $ + star "a\\cdot b" + @?= + "a cdot b" + , testCase "binomial (NoLineFrac)" $ + star "\\binom{n}{k}" + @?= + "left ( {n / k} right )" + , testCase "integral without limits" $ + star "\\int x\\,dx" + @?= + "int x dx" + , testCase "integral with lower and upper limits" $ + star "\\int_0^1 x\\,dx" + @?= + "int from 0 to 1 x dx" + , testCase "integral with infinite upper limit" $ + star "\\int_{0}^{\\infty} e^{-x}\\,dx" + @?= + "int from 0 to infinity e^{{−x}} dx" + , testCase "sum with lower and upper limits" $ + star "\\sum_{i=1}^{n} i" + @?= + "sum from i = 1 to n i" + , testCase "sum with symbolic term" $ + star "\\sum_{k=1}^{n} a_k" + @?= + "sum from k = 1 to n a_k" + , testCase "greek letter mapping" $ + star "\\alpha + \\beta + \\Gamma + \\Omega" + @?= + "%ialpha + %ibeta + %GAMMA + %OMEGA" + , testCase "greek variant mapping" $ + star "\\phi + \\varphi + \\epsilon + \\varepsilon + \\vartheta" + @?= + "%iphi + %ivarphi + %ivarepsilon + %iepsilon + %ivartheta" + , testCase "arrow mapping" $ + star "x \\to y, x \\leftarrow y, x \\Rightarrow y, x \\Leftrightarrow y" + @?= + "x toward y, x leftarrow y, x drarrow y, x dlrarrow y" + , testCase "set and relation symbol mapping" $ + star "A \\subseteq B, A \\cup B, x \\in A, x \\notin B" + @?= + "A subseteq B, A union B, x in A, x notin B" + , testCase "logic and calculus symbol mapping" $ + star "\\forall x \\exists y, \\nabla f = 0, \\partial_t u" + @?= + "forall x exists y, nabla f = 0, partial_tu" + , testCase "matrix environment" $ + star "\\begin{matrix}a&b\\\\c&d\\end{matrix}" + @?= + "matrix { a # b ## c # d }" + , testCase "pmatrix environment" $ + star "\\begin{pmatrix}a&b\\\\c&d\\end{pmatrix}" + @?= + "left ( matrix { a # b ## c # d } right )" + , testCase "bmatrix environment" $ + star "\\begin{bmatrix}a&b\\\\c&d\\end{bmatrix}" + @?= + "left [ matrix { a # b ## c # d } right ]" + , testCase "vmatrix environment" $ + star "\\begin{vmatrix}a&b\\\\c&d\\end{vmatrix}" + @?= + "left lline matrix { a # b ## c # d } right rline" + , testCase "Vmatrix environment" $ + star "\\begin{Vmatrix}a&b\\\\c&d\\end{Vmatrix}" + @?= + "left ldline matrix { a # b ## c # d } right rdline" + , testCase "fallback to TeX for non-centered array alignment" $ + case readTeX "\\begin{array}{lr}a&b\\\\c&d\\end{array}" of + Left err -> assertFailure ("readTeX failed: " ++ unpack err) + Right exps -> + writeStarMath DisplayBlock exps @?= writeTeX exps + , testCase "fallback to TeX for unsupported forms" $ + case readTeX "\\begin{cases}a&b\\\\c&d\\end{cases}" of + Left err -> assertFailure ("readTeX failed: " ++ unpack err) + Right exps -> + writeStarMath DisplayBlock exps @?= writeTeX exps + , testCase "fallback to TeX for under/over constructs" $ + case readTeX "\\underbrace{x+y}_{z}+\\overbrace{x+y}^{z}" of + Left err -> assertFailure ("readTeX failed: " ++ unpack err) + Right exps -> + writeStarMath DisplayBlock exps @?= writeTeX exps + ] + +star :: Text -> Text +star inp = + case readTeX inp of + Left err -> error ("readTeX failed in test: " ++ unpack err) + Right exps -> writeStarMath DisplayBlock exps diff --git a/test/test-pandoc.hs b/test/test-pandoc.hs index 9ae97d9c0af9..079f8fd75dba 100644 --- a/test/test-pandoc.hs +++ b/test/test-pandoc.hs @@ -49,6 +49,7 @@ import qualified Tests.Writers.Org import qualified Tests.Writers.Plain import qualified Tests.Writers.Powerpoint import qualified Tests.Writers.RST +import qualified Tests.Writers.StarMath import qualified Tests.Writers.AnnotatedTable import qualified Tests.Writers.TEI import qualified Tests.Writers.Markua @@ -84,6 +85,7 @@ tests pandocPath = testGroup "pandoc tests" , testGroup "FB2" Tests.Writers.FB2.tests , testGroup "PowerPoint" Tests.Writers.Powerpoint.tests , testGroup "Ms" Tests.Writers.Ms.tests + , testGroup "StarMath" Tests.Writers.StarMath.tests , testGroup "AnnotatedTable" Tests.Writers.AnnotatedTable.tests , testGroup "BBCode" Tests.Writers.BBCode.tests ] From 0093550d2ebbc8666c3c187f0c51b7da796efa14 Mon Sep 17 00:00:00 2001 From: John Pye Date: Sun, 15 Feb 2026 15:20:09 +1100 Subject: [PATCH 2/6] fixing various rendering errors for tex-to-starmath: - alignment of fractions within a stack - correct separation of 'min' from 'left' in \min \left(...\right) - translation of \quad and \qquad to ~ and ~~ respectively - handle, for now, \mathcal{J} as simply {ital J} (no better option?) - adding space after greek letters, as in '\lambda f_\text{l}' --- src/Text/Pandoc/Writers/StarMath.hs | 313 ++++++++++++++++++++++------ test/Tests/Writers/StarMath.hs | 59 +++++- 2 files changed, 306 insertions(+), 66 deletions(-) diff --git a/src/Text/Pandoc/Writers/StarMath.hs b/src/Text/Pandoc/Writers/StarMath.hs index 459bd7085f5f..c17192c568ed 100644 --- a/src/Text/Pandoc/Writers/StarMath.hs +++ b/src/Text/Pandoc/Writers/StarMath.hs @@ -9,6 +9,7 @@ import Text.TeXMath.Types ( Exp(..) , Alignment(..) , FractionType(..) + , TextType(..) , TeXSymbolType(..) ) @@ -20,36 +21,138 @@ writeStarMath _dt exps = Just rendered -> T.strip rendered Nothing -> writeTeX exps +data AlignContext = AlignDefault | AlignLeftCtx | AlignRightCtx + deriving (Eq) + renderExps :: [Exp] -> Maybe T.Text -renderExps = fmap T.concat . mapM renderExp +renderExps = renderExpsIn AlignDefault + +renderExpsIn :: AlignContext -> [Exp] -> Maybe T.Text +renderExpsIn ctx exps = do + rendered <- mapM (renderExpIn ctx) exps + let pieces = zip exps rendered + let merged = mergePieces pieces + pure $ if startsWithOperatorNeedingLhs exps + then "{} " <> T.stripStart merged + else merged + +mergePieces :: [(Exp, T.Text)] -> T.Text +mergePieces [] = "" +mergePieces ((e0, t0) : rest) = snd $ foldl' step (e0, t0) rest + where + step (prevE, acc) (curE, curT) = + if T.null curT + then (prevE, acc) + else + let sep = if needsSeparator prevE curE then " " else "" + in (curE, acc <> sep <> curT) + +needsSeparator :: Exp -> Exp -> Bool +needsSeparator prevE curE + | isGreekIdentifierExp prevE && isIdentifierLike curE = True + | isUnaryMinusSymbol prevE && isIdentifierLike curE = True + | isScripted prevE && not (isLargeOpScripted prevE) && + isIdentifierLike curE = True + | isCloseLike prevE && isIdentifierLike curE = True + | isIdentifierLike prevE && isWideSpace curE = True + | isIdentifierLike prevE && isDelimited curE = True + | otherwise = False + +isGreekIdentifierExp :: Exp -> Bool +isGreekIdentifierExp e = + case e of + EIdentifier t -> greekName t /= Nothing + _ -> False + +isIdentifierLike :: Exp -> Bool +isIdentifierLike e = + case e of + EIdentifier{} -> True + ENumber{} -> True + EMathOperator{} -> True + ESub{} -> True + ESuper{} -> True + ESubsup{} -> True + EStyled{} -> True + _ -> False + +isDelimited :: Exp -> Bool +isDelimited e = + case e of + EDelimited{} -> True + _ -> False -renderExp :: Exp -> Maybe T.Text -renderExp e = +isWideSpace :: Exp -> Bool +isWideSpace e = + case e of + ESpace w -> w >= 1 + _ -> False + +isCloseLike :: Exp -> Bool +isCloseLike e = + case e of + ESymbol Close _ -> True + EDelimited{} -> True + _ -> False + +isScripted :: Exp -> Bool +isScripted e = + case e of + ESub{} -> True + ESuper{} -> True + ESubsup{} -> True + _ -> False + +isUnaryMinusSymbol :: Exp -> Bool +isUnaryMinusSymbol e = + case e of + ESymbol t "-" -> t /= Bin + ESymbol t "−" -> t /= Bin + _ -> False + +isLargeOpScripted :: Exp -> Bool +isLargeOpScripted e = + case e of + ESub base _ -> largeOpName base /= Nothing + ESuper base _ -> largeOpName base /= Nothing + ESubsup base _ _ -> largeOpName base /= Nothing + _ -> False + +startsWithOperatorNeedingLhs :: [Exp] -> Bool +startsWithOperatorNeedingLhs exps = + case exps of + (ESymbol _ s : _) -> s `elem` ["×", "⋅", "·"] + _ -> False + +renderExpIn :: AlignContext -> Exp -> Maybe T.Text +renderExpIn ctx e = case e of ENumber t -> Just t EIdentifier t -> Just (renderIdentifier t) - EMathOperator t -> Just t + EMathOperator t -> Just ("func " <> t) ESymbol t s -> Just (renderSymbol t s) EText _ t -> Just (quoteText t) - ESpace _ -> Just " " - EGrouped xs -> ("{" <>) . (<> "}") <$> renderExps xs - EStyled _ xs -> renderExps xs + ESpace w -> Just (renderSpace w) + EGrouped xs -> ("{" <>) . (<> "}") <$> renderExpsIn ctx xs + EStyled sty xs -> renderStyled ctx sty xs EFraction frac num den -> do - num' <- renderExp num - den' <- renderExp den + num' <- renderExpIn AlignDefault num + den' <- renderExpIn AlignDefault den + let num'' = maybeCenterFractionArg ctx num' + let den'' = maybeCenterFractionArg ctx den' pure $ case frac of - NoLineFrac -> "{" <> num' <> " / " <> den' <> "}" - _ -> "{" <> num' <> " over " <> den' <> "}" + NoLineFrac -> "{" <> num'' <> " / " <> den'' <> "}" + _ -> "{" <> num'' <> " over " <> den'' <> "}" - ESqrt x -> ("sqrt {" <>) . (<> "}") <$> renderExp x + ESqrt x -> ("sqrt {" <>) . (<> "}") <$> renderExpIn ctx x ERoot idx rad -> do - idx' <- renderExp idx - rad' <- renderExp rad + idx' <- renderExpIn ctx idx + rad' <- renderExpIn ctx rad pure $ "nroot {" <> idx' <> "} {" <> rad' <> "}" EDelimited op cl xs -> do - body <- renderDelimitedBody xs + body <- renderDelimitedBody ctx xs let op' = delimToken DelimLeft op let cl' = delimToken DelimRight cl pure $ "left " <> op' <> " " <> body <> " right " <> cl' @@ -57,86 +160,177 @@ renderExp e = ESub base sub -> do case largeOpName base of Just op -> do - sub' <- renderLimitArg sub + sub' <- renderLimitArg ctx sub pure $ op <> " from " <> sub' <> " " Nothing -> do - base' <- renderExp base - sub' <- renderScriptArg sub + base' <- renderExpIn ctx base + sub' <- renderScriptArg ctx sub pure $ renderScriptBase base base' <> "_" <> sub' ESuper base sup -> do case largeOpName base of Just op -> do - sup' <- renderLimitArg sup + sup' <- renderLimitArg ctx sup pure $ op <> " to " <> sup' <> " " Nothing -> do - base' <- renderExp base - sup' <- renderScriptArg sup + base' <- renderExpIn ctx base + sup' <- renderScriptArg ctx sup pure $ renderScriptBase base base' <> "^" <> sup' ESubsup base sub sup -> do case largeOpName base of Just op -> do - sub' <- renderLimitArg sub - sup' <- renderLimitArg sup + sub' <- renderLimitArg ctx sub + sup' <- renderLimitArg ctx sup pure $ op <> " from " <> sub' <> " to " <> sup' <> " " Nothing -> do - base' <- renderExp base - sub' <- renderScriptArg sub - sup' <- renderScriptArg sup + base' <- renderExpIn ctx base + sub' <- renderScriptArg ctx sub + sup' <- renderScriptArg ctx sup pure $ renderScriptBase base base' <> "_" <> sub' <> "^" <> sup' EOver _ base over | Just accent <- accentName over -> do - base' <- renderExp base + base' <- renderExpIn ctx base pure $ accent <> " " <> renderAccentArg base base' | otherwise -> Nothing EUnder _ base under -> case largeOpName base of Just op -> do - under' <- renderLimitArg under + under' <- renderLimitArg ctx under pure $ op <> " from " <> under' <> " " Nothing -> Nothing EUnderover _ base under over -> case largeOpName base of Just op -> do - under' <- renderLimitArg under - over' <- renderLimitArg over + under' <- renderLimitArg ctx under + over' <- renderLimitArg ctx over pure $ op <> " from " <> under' <> " to " <> over' <> " " Nothing -> Nothing EArray aligns rows -> renderMatrix aligns rows EPhantom{} -> Nothing _ -> Nothing -renderDelimitedPart :: Either T.Text Exp -> Maybe T.Text -renderDelimitedPart p = +renderDelimitedBody :: AlignContext -> [Either T.Text Exp] -> Maybe T.Text +renderDelimitedBody ctx xs = do + chunks <- mapM (renderDelimitedChunk ctx) xs + pure $ T.strip (mergeDelimitedChunks chunks) + +data DelimitedChunk = DelimRaw T.Text | DelimExp Exp T.Text + +renderDelimitedChunk :: AlignContext -> Either T.Text Exp -> Maybe DelimitedChunk +renderDelimitedChunk ctx p = case p of - Left t -> Just $ " " <> delimToken DelimMiddle t <> " " - Right x -> renderExp x + Left t -> Just $ DelimRaw (" " <> delimToken DelimMiddle t <> " ") + Right x -> DelimExp x <$> renderExpIn ctx x -renderDelimitedBody :: [Either T.Text Exp] -> Maybe T.Text -renderDelimitedBody xs = T.strip <$> (fmap T.concat $ mapM renderDelimitedPart xs) +mergeDelimitedChunks :: [DelimitedChunk] -> T.Text +mergeDelimitedChunks [] = "" +mergeDelimitedChunks (c0:cs) = snd $ foldl' step (chunkExp c0, chunkText c0) cs + where + step (prevExp, acc) cur + | T.null curText = (prevExp, acc) + | otherwise = + case cur of + DelimRaw _ -> (Nothing, acc <> curText) + DelimExp curExp _ -> + let sep = case prevExp of + Just pe -> if needsSeparator pe curExp then " " else "" + Nothing -> "" + in (Just curExp, acc <> sep <> curText) + where + curText = chunkText cur + + chunkText c = + case c of + DelimRaw t -> t + DelimExp _ t -> t + + chunkExp c = + case c of + DelimRaw _ -> Nothing + DelimExp e _ -> Just e renderMatrix :: [Alignment] -> [[[Exp]]] -> Maybe T.Text -renderMatrix aligns rows - | not (all (== AlignCenter) aligns) = Nothing - | otherwise = do - rows' <- mapM renderMatrixRow rows - pure $ "matrix { " <> T.intercalate " ## " rows' <> " }" - -renderMatrixRow :: [[Exp]] -> Maybe T.Text -renderMatrixRow cells = do - cells' <- mapM renderMatrixCell cells +renderMatrix aligns rows = do + rows' <- mapM (renderMatrixRow aligns) rows + pure $ "matrix { " <> T.intercalate " ## " rows' <> " }" + +renderMatrixRow :: [Alignment] -> [[Exp]] -> Maybe T.Text +renderMatrixRow aligns cells = do + cells' <- sequence + [ renderMatrixCellWithAlign (columnAlign aligns i) c + | (i, c) <- zip [(0 :: Int)..] cells + ] pure $ T.intercalate " # " cells' -renderMatrixCell :: [Exp] -> Maybe T.Text -renderMatrixCell [] = Just "{}" -renderMatrixCell xs = do - rendered <- renderExps xs +renderMatrixCell :: AlignContext -> [Exp] -> Maybe T.Text +renderMatrixCell _ [] = Just "{}" +renderMatrixCell ctx xs = do + rendered <- renderExpsIn ctx xs let stripped = T.strip rendered pure $ if T.null stripped then "{}" else stripped +renderMatrixCellWithAlign :: Alignment -> [Exp] -> Maybe T.Text +renderMatrixCellWithAlign align xs = do + cell <- renderMatrixCell (alignmentContext align) xs + pure $ case align of + AlignLeft -> "alignl " <> cell + AlignRight -> "alignr " <> cell + _ -> cell + +columnAlign :: [Alignment] -> Int -> Alignment +columnAlign aligns i = + case drop i aligns of + (a : _) -> a + [] -> AlignCenter + +renderStyled :: AlignContext -> TextType -> [Exp] -> Maybe T.Text +renderStyled ctx sty xs = do + body <- renderExpsIn ctx xs + pure $ case sty of + TextItalic -> "ital " <> styleArg body + TextBold -> "bold " <> styleArg body + TextScript -> "ital " <> styleArg body + TextFraktur -> "ital " <> styleArg body + TextDoubleStruck -> "ital " <> styleArg body + _ -> body + where + styleArg t + | T.null t = "{}" + | T.length t == 1 = t + | otherwise = "{" <> t <> "}" + +alignmentContext :: Alignment -> AlignContext +alignmentContext a = + case a of + AlignLeft -> AlignLeftCtx + AlignRight -> AlignRightCtx + _ -> AlignDefault + +maybeCenterFractionArg :: AlignContext -> T.Text -> T.Text +maybeCenterFractionArg ctx t + | ctx == AlignLeftCtx || ctx == AlignRightCtx = "{alignc " <> asArg t <> "}" + | otherwise = t + where + asArg x = + let s = T.strip x + in if T.null s + then "{}" + else if T.length s == 1 + then s + else if T.head s == '{' && T.last s == '}' + then s + else "{" <> s <> "}" + +renderSpace :: Rational -> T.Text +renderSpace w + | w <= 0 = "" + | w >= 2 = "~~ " + | w >= 1 = "~ " + | otherwise = " " + renderIdentifier :: T.Text -> T.Text renderIdentifier ident = case greekName ident of @@ -239,19 +433,19 @@ renderScriptBase e rendered0 = then rendered else "{" <> rendered <> "}" -renderScriptArg :: Exp -> Maybe T.Text -renderScriptArg e = do - rendered0 <- renderExp e +renderScriptArg :: AlignContext -> Exp -> Maybe T.Text +renderScriptArg ctx e = do + rendered0 <- renderExpIn ctx e let rendered = T.strip rendered0 pure $ if isAtomic e then rendered else "{" <> rendered <> "}" -renderLimitArg :: Exp -> Maybe T.Text -renderLimitArg e = +renderLimitArg :: AlignContext -> Exp -> Maybe T.Text +renderLimitArg ctx e = case e of - EGrouped xs -> renderExps xs - _ -> T.strip <$> renderExp e + EGrouped xs -> renderExpsIn ctx xs + _ -> T.strip <$> renderExpIn ctx e renderAccentArg :: Exp -> T.Text -> T.Text renderAccentArg e rendered0 = @@ -342,7 +536,7 @@ delimToken side raw = _ -> raw renderSymbol :: TeXSymbolType -> T.Text -> T.Text -renderSymbol _ s = +renderSymbol t s = case s of "∫" -> "int " "∑" -> "sum " @@ -391,7 +585,10 @@ renderSymbol _ s = "∞" -> "infinity" "∅" -> "emptyset" "+" -> " + " - "-" -> " - " + "-" | t == Bin -> " - " + "-" -> "-" + "−" | t == Bin -> " - " + "−" -> "-" "=" -> " = " "," -> ", " ";" -> "; " diff --git a/test/Tests/Writers/StarMath.hs b/test/Tests/Writers/StarMath.hs index cab07ab63bba..3ec037835d1f 100644 --- a/test/Tests/Writers/StarMath.hs +++ b/test/Tests/Writers/StarMath.hs @@ -72,7 +72,7 @@ tests = , testCase "integral with infinite upper limit" $ star "\\int_{0}^{\\infty} e^{-x}\\,dx" @?= - "int from 0 to infinity e^{{−x}} dx" + "int from 0 to infinity e^{{- x}} dx" , testCase "sum with lower and upper limits" $ star "\\sum_{i=1}^{n} i" @?= @@ -100,7 +100,39 @@ tests = , testCase "logic and calculus symbol mapping" $ star "\\forall x \\exists y, \\nabla f = 0, \\partial_t u" @?= - "forall x exists y, nabla f = 0, partial_tu" + "forall x exists y, nabla f = 0, partial_t u" + , testCase "greek identifier spacing in products" $ + star "E_{k+1}=E_{k+\\frac12}-\\frac{\\dot{Q}_{\\text{dis},k}\\Delta t}{\\eta_{\\text{dis}}}," + @?= + "E_{{k + 1}} = E_{{k + {1 over 2}}} - {{{dot Q}_{{\"dis\", k}} %DELTA t} over %ieta_\"dis\"}," + , testCase "math operators rendered as functions" $ + star "E_{k+1}\\leftarrow\\min\\!\\left(E^{\\text{cap}}_{\\text{s}},\\max(0,E_{k+1})\\right)." + @?= + "E_{{k + 1}} leftarrow func min left ( E_\"s\"^\"cap\", func max(0, E_{{k + 1}}) right )." + , testCase "nested function with left delimiter spacing" $ + star "P_{\\text{ch}, k}=\\max\\!\\left(0,\\min\\!\\left(P'_{\\text{pv}, k},\\,P^{\\text{cap}}_{\\text{ch}},\\,P_{\\text{ch,head}, k}\\right)\\right)." + @?= + "P_{{\"ch\", k}} = func max left ( 0, func min left ( P_{{\"pv\", k}}^′, P_\"ch\"^\"cap\", P_{{\"ch,head\", k}} right ) right )." + , testCase "quad spacing command" $ + star "a,\\quad b" + @?= + "a, ~ b" + , testCase "qquad spacing command" $ + star "a,\\qquad b" + @?= + "a, ~~ b" + , testCase "greek token separator before scripted identifier" $ + star "f_{\\text{eff}}=(1-\\lambda)f_{\\text{m}}+\\lambda f_{\\text{l}}." + @?= + "f_\"eff\" = (1 - %ilambda) f_\"m\" + %ilambda f_\"l\"." + , testCase "mathcal styled token before left delimiter" $ + star "\\min\\ \\mathcal{J}\\left(P^{\\text{cap}}_{\\text{pv}},N_{\\text{u}},P^{\\text{cap}}_{\\text{eb}}\\right)" + @?= + "func min ital J left ( P_\"pv\"^\"cap\", N_\"u\", P_\"eb\"^\"cap\" right )" + , testCase "leading binary operator gets neutral lhs" $ + star "\\times\\Delta t" + @?= + "{} times %DELTA t" , testCase "matrix environment" $ star "\\begin{matrix}a&b\\\\c&d\\end{matrix}" @?= @@ -121,13 +153,24 @@ tests = star "\\begin{Vmatrix}a&b\\\\c&d\\end{Vmatrix}" @?= "left ldline matrix { a # b ## c # d } right rdline" - , testCase "fallback to TeX for non-centered array alignment" $ - case readTeX "\\begin{array}{lr}a&b\\\\c&d\\end{array}" of - Left err -> assertFailure ("readTeX failed: " ++ unpack err) - Right exps -> - writeStarMath DisplayBlock exps @?= writeTeX exps + , testCase "array with left/right alignment" $ + star "\\begin{array}{lr}a&b\\\\c&d\\end{array}" + @?= + "matrix { alignl a # alignr b ## alignl c # alignr d }" + , testCase "aligned array keeps fractions centered" $ + star "\\begin{array}{l}\\frac{AAA}{B}\\end{array}" + @?= + "matrix { alignl {{alignc {AAA}} over {alignc B}} }" + , testCase "cases environment" $ + star "\\begin{cases}a, & x>0\\\\ b, & x\\le 0\\end{cases}" + @?= + "left lbrace matrix { alignl a, # alignl x>0 ## alignl b, # alignl x <= 0 } right none" + , testCase "cases with negative log fraction" $ + star "t_{\\text{pb,disc}}=\\begin{cases}\\dfrac{C_{\\text{tot}}}{B}, & r=0,\\\\\\dfrac{-\\ln\\!\\left(1-rC_{\\text{tot}}/B\\right)}{\\ln(1+r)}, & r>0\\text{ and }1-rC_{\\text{tot}}/B>0,\\\\\\infty, & \\text{otherwise}.\\end{cases}" + @?= + "t_\"pb,disc\" = left lbrace matrix { alignl {{alignc {C_\"tot\"}} over {alignc B}}, # alignl r = 0, ## alignl {{alignc {- func ln left ( 1 - rC_\"tot\" / B right )}} over {alignc {func ln(1 + r)}}}, # alignl r>0\" and \"1 - rC_\"tot\" / B>0, ## alignl infinity, # alignl \"otherwise\". } right none" , testCase "fallback to TeX for unsupported forms" $ - case readTeX "\\begin{cases}a&b\\\\c&d\\end{cases}" of + case readTeX "\\phantom{x}+1" of Left err -> assertFailure ("readTeX failed: " ++ unpack err) Right exps -> writeStarMath DisplayBlock exps @?= writeTeX exps From 364a4c0c893debdbe1afc0918f32ad11031f77ba Mon Sep 17 00:00:00 2001 From: John Pye Date: Sun, 15 Feb 2026 17:38:53 +1100 Subject: [PATCH 3/6] added missng foldl import --- src/Text/Pandoc/Writers/StarMath.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Text/Pandoc/Writers/StarMath.hs b/src/Text/Pandoc/Writers/StarMath.hs index c17192c568ed..8bb07a083b1a 100644 --- a/src/Text/Pandoc/Writers/StarMath.hs +++ b/src/Text/Pandoc/Writers/StarMath.hs @@ -4,6 +4,7 @@ module Text.Pandoc.Writers.StarMath ) where import qualified Data.Text as T +import Data.List (foldl') import Text.TeXMath (DisplayType, writeTeX) import Text.TeXMath.Types ( Exp(..) From 4bebd3d4fbddcdb46d1649936234c0a7fb66c9be Mon Sep 17 00:00:00 2001 From: John Pye Date: Sun, 15 Feb 2026 17:54:30 +1100 Subject: [PATCH 4/6] removed foldl import --- src/Text/Pandoc/Writers/StarMath.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Text/Pandoc/Writers/StarMath.hs b/src/Text/Pandoc/Writers/StarMath.hs index 8bb07a083b1a..c17192c568ed 100644 --- a/src/Text/Pandoc/Writers/StarMath.hs +++ b/src/Text/Pandoc/Writers/StarMath.hs @@ -4,7 +4,6 @@ module Text.Pandoc.Writers.StarMath ) where import qualified Data.Text as T -import Data.List (foldl') import Text.TeXMath (DisplayType, writeTeX) import Text.TeXMath.Types ( Exp(..) From e6afcd5088bf404fcf72c87eb10ff250a4d29e3d Mon Sep 17 00:00:00 2001 From: John Pye Date: Sun, 15 Feb 2026 18:17:39 +1100 Subject: [PATCH 5/6] support 9.8/9.10 --- src/Text/Pandoc/Writers/StarMath.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Text/Pandoc/Writers/StarMath.hs b/src/Text/Pandoc/Writers/StarMath.hs index c17192c568ed..7600bc7e3473 100644 --- a/src/Text/Pandoc/Writers/StarMath.hs +++ b/src/Text/Pandoc/Writers/StarMath.hs @@ -4,6 +4,7 @@ module Text.Pandoc.Writers.StarMath ) where import qualified Data.Text as T +import qualified Data.List as List import Text.TeXMath (DisplayType, writeTeX) import Text.TeXMath.Types ( Exp(..) @@ -38,7 +39,7 @@ renderExpsIn ctx exps = do mergePieces :: [(Exp, T.Text)] -> T.Text mergePieces [] = "" -mergePieces ((e0, t0) : rest) = snd $ foldl' step (e0, t0) rest +mergePieces ((e0, t0) : rest) = snd $ List.foldl' step (e0, t0) rest where step (prevE, acc) (curE, curT) = if T.null curT @@ -227,7 +228,7 @@ renderDelimitedChunk ctx p = mergeDelimitedChunks :: [DelimitedChunk] -> T.Text mergeDelimitedChunks [] = "" -mergeDelimitedChunks (c0:cs) = snd $ foldl' step (chunkExp c0, chunkText c0) cs +mergeDelimitedChunks (c0:cs) = snd $ List.foldl' step (chunkExp c0, chunkText c0) cs where step (prevExp, acc) cur | T.null curText = (prevExp, acc) From e54b2bacb12ce767438ead96801efc9bf45e9016 Mon Sep 17 00:00:00 2001 From: John Pye Date: Mon, 9 Mar 2026 11:06:09 +1100 Subject: [PATCH 6/6] moved math parser to texmath --- cabal.project | 1 + pandoc.cabal | 2 - src/Text/Pandoc/Readers/LaTeX.hs | 22 + src/Text/Pandoc/Readers/LaTeX/Inline.hs | 6 + src/Text/Pandoc/Readers/LaTeX/Macro.hs | 69 ++- src/Text/Pandoc/Writers/ODT.hs | 1 - src/Text/Pandoc/Writers/StarMath.hs | 615 ------------------------ stack.yaml | 2 +- test/Tests/Readers/LaTeX.hs | 61 +++ test/Tests/Writers/StarMath.hs | 188 -------- test/test-pandoc.hs | 2 - 11 files changed, 152 insertions(+), 817 deletions(-) delete mode 100644 src/Text/Pandoc/Writers/StarMath.hs delete mode 100644 test/Tests/Writers/StarMath.hs diff --git a/cabal.project b/cabal.project index 298ce40707da..095bf7f0f200 100644 --- a/cabal.project +++ b/cabal.project @@ -2,6 +2,7 @@ packages: . pandoc-lua-engine pandoc-server pandoc-cli + ../texmath constraints: skylighting-format-blaze-html >= 0.1.2, skylighting-format-context >= 0.1.0.2 diff --git a/pandoc.cabal b/pandoc.cabal index b4c7307e226d..42bc47fe65e3 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -682,7 +682,6 @@ library Text.Pandoc.Writers.Muse, Text.Pandoc.Writers.CslJson, Text.Pandoc.Writers.Math, - Text.Pandoc.Writers.StarMath, Text.Pandoc.Writers.Shared, Text.Pandoc.Writers.OOXML, Text.Pandoc.Writers.AnnotatedTable, @@ -915,7 +914,6 @@ test-suite test-pandoc Tests.Writers.Powerpoint Tests.Writers.OOXML Tests.Writers.Ms - Tests.Writers.StarMath Tests.Writers.AnnotatedTable Tests.Writers.BBCode diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index a8af3cb86e68..d9395c76e3de 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -753,6 +753,7 @@ opt = do preamble :: PandocMonad m => LP m Blocks preamble = mconcat <$> many preambleBlock where preambleBlock = (mempty <$ spaces1) + <|> swallowSectionRedefinition <|> macroDef (rawBlock "latex") <|> filecontents <|> (mempty <$ blockCommand) @@ -761,6 +762,25 @@ preamble = mconcat <$> many preambleBlock anyTok return mempty) +swallowSectionRedefinition :: PandocMonad m => LP m Blocks +swallowSectionRedefinition = try $ withVerbatimMode $ do + Tok _ (CtrlSeq mtype) _ <- controlSeq "renewcommand" <|> + controlSeq "DeclareRobustCommand" + Tok _ (CtrlSeq name) _ <- do + optional (symbol '*') + anyControlSeq <|> + (symbol '{' *> spaces *> anyControlSeq <* spaces <* symbol '}') + guard $ name `elem` + [ "part", "chapter", "section", "subsection", "subsubsection" + , "paragraph", "subparagraph", "frametitle", "framesubtitle" + ] + when (mtype /= "DeclareRobustCommand") $ + void $ optional $ try bracketedToks + optional $ try bracketedToks + contents <- bracedOrToken + guard $ "startsection" `T.isInfixOf` T.strip (untokenize contents) + return mempty + rule :: PandocMonad m => LP m Blocks rule = do skipopts @@ -1121,6 +1141,8 @@ environments = M.union (tableEnvironments block inline) $ -- other , ("CSLReferences", braced >> braced >> env "CSLReferences" blocks) , ("otherlanguage", env "otherlanguage" otherlanguageEnv) + , ("multicols", env "multicols" (braced *> blocks)) + , ("multicols*", env "multicols*" (braced *> blocks)) ] otherlanguageEnv :: PandocMonad m => LP m Blocks diff --git a/src/Text/Pandoc/Readers/LaTeX/Inline.hs b/src/Text/Pandoc/Readers/LaTeX/Inline.hs index 55f5a0bf46e7..e74a8d90fc8a 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Inline.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Inline.hs @@ -300,6 +300,12 @@ charCommands = M.fromList , ("ps", pure $ str "PS." <> space) , ("TeX", lit "TeX") , ("LaTeX", lit "LaTeX") + , ("LaTeXe", lit "LaTeX2ε") + , ("BibTeX", lit "BibTeX") + , ("XeTeX", lit "XeTeX") + , ("XeLaTeX", lit "XeLaTeX") + , ("LuaTeX", lit "LuaTeX") + , ("LuaLaTeX", lit "LuaLaTeX") , ("bar", lit "|") , ("textless", lit "<") , ("textgreater", lit ">") diff --git a/src/Text/Pandoc/Readers/LaTeX/Macro.hs b/src/Text/Pandoc/Readers/LaTeX/Macro.hs index 29350cd1614e..7aafc63e4d80 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Macro.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Macro.hs @@ -25,8 +25,8 @@ macroDef constructor = do guardDisabled Ext_latex_macros) <|> return mempty where commandDef = do - nameMacroPairs <- newcommand <|> - checkGlobal (letmacro <|> edefmacro <|> defmacro <|> newif) + nameMacroPairs <- filter (not . shouldIgnoreLogoRedefinition) <$> + (newcommand <|> checkGlobal (letmacro <|> edefmacro <|> defmacro <|> newif)) guardDisabled Ext_latex_macros <|> mapM_ insertMacro nameMacroPairs environmentDef = do @@ -185,12 +185,65 @@ newcommand = do [ Tok pos Symbol "}", Tok pos Symbol "}" ]) _ -> contents' let macro = Macro GroupScope ExpandWhenUsed argspecs optarg contents - (do lookupMacro name - case mtype of - "providecommand" -> return [] - "renewcommand" -> return [(name, macro)] - _ -> [] <$ report (MacroAlreadyDefined txt pos)) - <|> pure [(name, macro)] + if shouldIgnoreSectionRedefinition mtype name contents + then return [] + else + (do lookupMacro name + case mtype of + "providecommand" -> return [] + "renewcommand" -> return [(name, macro)] + _ -> [] <$ report (MacroAlreadyDefined txt pos)) + <|> pure [(name, macro)] + +shouldIgnoreSectionRedefinition :: Text -> Text -> [Tok] -> Bool +shouldIgnoreSectionRedefinition mtype name contents = + mtype == "renewcommand" + && name `elem` + [ "part", "chapter", "section", "subsection", "subsubsection" + , "paragraph", "subparagraph", "frametitle", "framesubtitle" + ] + && ("@startsection" `T.isInfixOf` contentsText + || "\\startsection" `T.isInfixOf` contentsText + || "startsection" `T.isInfixOf` contentsText) + where + contentsText = T.strip (untokenize contents) + +shouldIgnoreLogoRedefinition :: (Text, Macro) -> Bool +shouldIgnoreLogoRedefinition (name, Macro _ _ _ _ contents) = + looksLikeLogoRedefinition name contents + +looksLikeLogoRedefinition :: Text -> [Tok] -> Bool +looksLikeLogoRedefinition name contents = + name `elem` logoNames + && any (`T.isInfixOf` body) typographyPrimitives + && any (`T.isInfixOf` body) (logoMarkers name) + where + body = T.toLower (T.strip (untokenize contents)) + logoNames = + [ "TeX", "LaTeX", "BibTeX" + , "XeTeX", "XeLaTeX", "LuaTeX", "LuaLaTeX" + ] + typographyPrimitives = + [ "\\kern", "\\lower", "\\hbox", "\\sc", "\\rm" + , "\\raise", "\\font", "\\mathchoice" + ] + +logoMarkers :: Text -> [Text] +logoMarkers "TeX" = + [ "t\\kern", "tex", "\\hbox{e}", "\\lower" ] +logoMarkers "LaTeX" = + [ "latex", "{a}", "l\\kern", "tex" ] +logoMarkers "BibTeX" = + [ "bib", "b\\kern", "{\\sc i", "\\hbox{e}", "tex" ] +logoMarkers "XeTeX" = + [ "xetex", "xe", "tex" ] +logoMarkers "XeLaTeX" = + [ "xelatex", "xela", "latex", "tex" ] +logoMarkers "LuaTeX" = + [ "luatex", "lua", "tex" ] +logoMarkers "LuaLaTeX" = + [ "lualatex", "luala", "latex", "tex" ] +logoMarkers _ = [] newenvironment :: PandocMonad m => LP m (Maybe (Text, Macro, Macro)) newenvironment = do diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 7c78874c7a41..e1bec57f472f 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -45,7 +45,6 @@ import Text.Pandoc.Writers.Shared (lookupMetaString, lookupMetaBlocks, import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toTextLazy) import Text.Pandoc.Walk import Text.Pandoc.Writers.OpenDocument (writeOpenDocument) -import Text.Pandoc.Writers.StarMath (writeStarMath) import Text.Pandoc.XML import Text.Pandoc.XML.Light import Text.TeXMath diff --git a/src/Text/Pandoc/Writers/StarMath.hs b/src/Text/Pandoc/Writers/StarMath.hs deleted file mode 100644 index 7600bc7e3473..000000000000 --- a/src/Text/Pandoc/Writers/StarMath.hs +++ /dev/null @@ -1,615 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Text.Pandoc.Writers.StarMath - ( writeStarMath - ) where - -import qualified Data.Text as T -import qualified Data.List as List -import Text.TeXMath (DisplayType, writeTeX) -import Text.TeXMath.Types - ( Exp(..) - , Alignment(..) - , FractionType(..) - , TextType(..) - , TeXSymbolType(..) - ) - --- | Render TeXMath expressions as StarMath syntax. --- Falls back to TeX output for expressions that are not yet supported. -writeStarMath :: DisplayType -> [Exp] -> T.Text -writeStarMath _dt exps = - case renderExps exps of - Just rendered -> T.strip rendered - Nothing -> writeTeX exps - -data AlignContext = AlignDefault | AlignLeftCtx | AlignRightCtx - deriving (Eq) - -renderExps :: [Exp] -> Maybe T.Text -renderExps = renderExpsIn AlignDefault - -renderExpsIn :: AlignContext -> [Exp] -> Maybe T.Text -renderExpsIn ctx exps = do - rendered <- mapM (renderExpIn ctx) exps - let pieces = zip exps rendered - let merged = mergePieces pieces - pure $ if startsWithOperatorNeedingLhs exps - then "{} " <> T.stripStart merged - else merged - -mergePieces :: [(Exp, T.Text)] -> T.Text -mergePieces [] = "" -mergePieces ((e0, t0) : rest) = snd $ List.foldl' step (e0, t0) rest - where - step (prevE, acc) (curE, curT) = - if T.null curT - then (prevE, acc) - else - let sep = if needsSeparator prevE curE then " " else "" - in (curE, acc <> sep <> curT) - -needsSeparator :: Exp -> Exp -> Bool -needsSeparator prevE curE - | isGreekIdentifierExp prevE && isIdentifierLike curE = True - | isUnaryMinusSymbol prevE && isIdentifierLike curE = True - | isScripted prevE && not (isLargeOpScripted prevE) && - isIdentifierLike curE = True - | isCloseLike prevE && isIdentifierLike curE = True - | isIdentifierLike prevE && isWideSpace curE = True - | isIdentifierLike prevE && isDelimited curE = True - | otherwise = False - -isGreekIdentifierExp :: Exp -> Bool -isGreekIdentifierExp e = - case e of - EIdentifier t -> greekName t /= Nothing - _ -> False - -isIdentifierLike :: Exp -> Bool -isIdentifierLike e = - case e of - EIdentifier{} -> True - ENumber{} -> True - EMathOperator{} -> True - ESub{} -> True - ESuper{} -> True - ESubsup{} -> True - EStyled{} -> True - _ -> False - -isDelimited :: Exp -> Bool -isDelimited e = - case e of - EDelimited{} -> True - _ -> False - -isWideSpace :: Exp -> Bool -isWideSpace e = - case e of - ESpace w -> w >= 1 - _ -> False - -isCloseLike :: Exp -> Bool -isCloseLike e = - case e of - ESymbol Close _ -> True - EDelimited{} -> True - _ -> False - -isScripted :: Exp -> Bool -isScripted e = - case e of - ESub{} -> True - ESuper{} -> True - ESubsup{} -> True - _ -> False - -isUnaryMinusSymbol :: Exp -> Bool -isUnaryMinusSymbol e = - case e of - ESymbol t "-" -> t /= Bin - ESymbol t "−" -> t /= Bin - _ -> False - -isLargeOpScripted :: Exp -> Bool -isLargeOpScripted e = - case e of - ESub base _ -> largeOpName base /= Nothing - ESuper base _ -> largeOpName base /= Nothing - ESubsup base _ _ -> largeOpName base /= Nothing - _ -> False - -startsWithOperatorNeedingLhs :: [Exp] -> Bool -startsWithOperatorNeedingLhs exps = - case exps of - (ESymbol _ s : _) -> s `elem` ["×", "⋅", "·"] - _ -> False - -renderExpIn :: AlignContext -> Exp -> Maybe T.Text -renderExpIn ctx e = - case e of - ENumber t -> Just t - EIdentifier t -> Just (renderIdentifier t) - EMathOperator t -> Just ("func " <> t) - ESymbol t s -> Just (renderSymbol t s) - EText _ t -> Just (quoteText t) - ESpace w -> Just (renderSpace w) - EGrouped xs -> ("{" <>) . (<> "}") <$> renderExpsIn ctx xs - EStyled sty xs -> renderStyled ctx sty xs - - EFraction frac num den -> do - num' <- renderExpIn AlignDefault num - den' <- renderExpIn AlignDefault den - let num'' = maybeCenterFractionArg ctx num' - let den'' = maybeCenterFractionArg ctx den' - pure $ case frac of - NoLineFrac -> "{" <> num'' <> " / " <> den'' <> "}" - _ -> "{" <> num'' <> " over " <> den'' <> "}" - - ESqrt x -> ("sqrt {" <>) . (<> "}") <$> renderExpIn ctx x - ERoot idx rad -> do - idx' <- renderExpIn ctx idx - rad' <- renderExpIn ctx rad - pure $ "nroot {" <> idx' <> "} {" <> rad' <> "}" - - EDelimited op cl xs -> do - body <- renderDelimitedBody ctx xs - let op' = delimToken DelimLeft op - let cl' = delimToken DelimRight cl - pure $ "left " <> op' <> " " <> body <> " right " <> cl' - - ESub base sub -> do - case largeOpName base of - Just op -> do - sub' <- renderLimitArg ctx sub - pure $ op <> " from " <> sub' <> " " - Nothing -> do - base' <- renderExpIn ctx base - sub' <- renderScriptArg ctx sub - pure $ renderScriptBase base base' <> "_" <> sub' - - ESuper base sup -> do - case largeOpName base of - Just op -> do - sup' <- renderLimitArg ctx sup - pure $ op <> " to " <> sup' <> " " - Nothing -> do - base' <- renderExpIn ctx base - sup' <- renderScriptArg ctx sup - pure $ renderScriptBase base base' <> "^" <> sup' - - ESubsup base sub sup -> do - case largeOpName base of - Just op -> do - sub' <- renderLimitArg ctx sub - sup' <- renderLimitArg ctx sup - pure $ op <> " from " <> sub' <> " to " <> sup' <> " " - Nothing -> do - base' <- renderExpIn ctx base - sub' <- renderScriptArg ctx sub - sup' <- renderScriptArg ctx sup - pure $ renderScriptBase base base' <> "_" <> sub' <> "^" <> sup' - - EOver _ base over - | Just accent <- accentName over -> do - base' <- renderExpIn ctx base - pure $ accent <> " " <> renderAccentArg base base' - | otherwise -> Nothing - - EUnder _ base under -> - case largeOpName base of - Just op -> do - under' <- renderLimitArg ctx under - pure $ op <> " from " <> under' <> " " - Nothing -> Nothing - EUnderover _ base under over -> - case largeOpName base of - Just op -> do - under' <- renderLimitArg ctx under - over' <- renderLimitArg ctx over - pure $ op <> " from " <> under' <> " to " <> over' <> " " - Nothing -> Nothing - EArray aligns rows -> renderMatrix aligns rows - EPhantom{} -> Nothing - _ -> Nothing - -renderDelimitedBody :: AlignContext -> [Either T.Text Exp] -> Maybe T.Text -renderDelimitedBody ctx xs = do - chunks <- mapM (renderDelimitedChunk ctx) xs - pure $ T.strip (mergeDelimitedChunks chunks) - -data DelimitedChunk = DelimRaw T.Text | DelimExp Exp T.Text - -renderDelimitedChunk :: AlignContext -> Either T.Text Exp -> Maybe DelimitedChunk -renderDelimitedChunk ctx p = - case p of - Left t -> Just $ DelimRaw (" " <> delimToken DelimMiddle t <> " ") - Right x -> DelimExp x <$> renderExpIn ctx x - -mergeDelimitedChunks :: [DelimitedChunk] -> T.Text -mergeDelimitedChunks [] = "" -mergeDelimitedChunks (c0:cs) = snd $ List.foldl' step (chunkExp c0, chunkText c0) cs - where - step (prevExp, acc) cur - | T.null curText = (prevExp, acc) - | otherwise = - case cur of - DelimRaw _ -> (Nothing, acc <> curText) - DelimExp curExp _ -> - let sep = case prevExp of - Just pe -> if needsSeparator pe curExp then " " else "" - Nothing -> "" - in (Just curExp, acc <> sep <> curText) - where - curText = chunkText cur - - chunkText c = - case c of - DelimRaw t -> t - DelimExp _ t -> t - - chunkExp c = - case c of - DelimRaw _ -> Nothing - DelimExp e _ -> Just e - -renderMatrix :: [Alignment] -> [[[Exp]]] -> Maybe T.Text -renderMatrix aligns rows = do - rows' <- mapM (renderMatrixRow aligns) rows - pure $ "matrix { " <> T.intercalate " ## " rows' <> " }" - -renderMatrixRow :: [Alignment] -> [[Exp]] -> Maybe T.Text -renderMatrixRow aligns cells = do - cells' <- sequence - [ renderMatrixCellWithAlign (columnAlign aligns i) c - | (i, c) <- zip [(0 :: Int)..] cells - ] - pure $ T.intercalate " # " cells' - -renderMatrixCell :: AlignContext -> [Exp] -> Maybe T.Text -renderMatrixCell _ [] = Just "{}" -renderMatrixCell ctx xs = do - rendered <- renderExpsIn ctx xs - let stripped = T.strip rendered - pure $ if T.null stripped then "{}" else stripped - -renderMatrixCellWithAlign :: Alignment -> [Exp] -> Maybe T.Text -renderMatrixCellWithAlign align xs = do - cell <- renderMatrixCell (alignmentContext align) xs - pure $ case align of - AlignLeft -> "alignl " <> cell - AlignRight -> "alignr " <> cell - _ -> cell - -columnAlign :: [Alignment] -> Int -> Alignment -columnAlign aligns i = - case drop i aligns of - (a : _) -> a - [] -> AlignCenter - -renderStyled :: AlignContext -> TextType -> [Exp] -> Maybe T.Text -renderStyled ctx sty xs = do - body <- renderExpsIn ctx xs - pure $ case sty of - TextItalic -> "ital " <> styleArg body - TextBold -> "bold " <> styleArg body - TextScript -> "ital " <> styleArg body - TextFraktur -> "ital " <> styleArg body - TextDoubleStruck -> "ital " <> styleArg body - _ -> body - where - styleArg t - | T.null t = "{}" - | T.length t == 1 = t - | otherwise = "{" <> t <> "}" - -alignmentContext :: Alignment -> AlignContext -alignmentContext a = - case a of - AlignLeft -> AlignLeftCtx - AlignRight -> AlignRightCtx - _ -> AlignDefault - -maybeCenterFractionArg :: AlignContext -> T.Text -> T.Text -maybeCenterFractionArg ctx t - | ctx == AlignLeftCtx || ctx == AlignRightCtx = "{alignc " <> asArg t <> "}" - | otherwise = t - where - asArg x = - let s = T.strip x - in if T.null s - then "{}" - else if T.length s == 1 - then s - else if T.head s == '{' && T.last s == '}' - then s - else "{" <> s <> "}" - -renderSpace :: Rational -> T.Text -renderSpace w - | w <= 0 = "" - | w >= 2 = "~~ " - | w >= 1 = "~ " - | otherwise = " " - -renderIdentifier :: T.Text -> T.Text -renderIdentifier ident = - case greekName ident of - Just name - | shouldItalicizeGreek ident -> "%i" <> name - | otherwise -> "%" <> name - Nothing -> ident - --- Lowercase Greek identifiers are variables in TeX math and are usually italic. -shouldItalicizeGreek :: T.Text -> Bool -shouldItalicizeGreek ident = - case ident of - "α" -> True - "β" -> True - "γ" -> True - "δ" -> True - "ϵ" -> True - "ε" -> True - "ζ" -> True - "η" -> True - "θ" -> True - "ϑ" -> True - "ι" -> True - "κ" -> True - "λ" -> True - "μ" -> True - "ν" -> True - "ξ" -> True - "ο" -> True - "π" -> True - "ϖ" -> True - "ρ" -> True - "ϱ" -> True - "𝜚" -> True - "σ" -> True - "ς" -> True - "𝜍" -> True - "τ" -> True - "υ" -> True - "ϕ" -> True - "φ" -> True - "χ" -> True - "ψ" -> True - "ω" -> True - _ -> False - -greekName :: T.Text -> Maybe T.Text -greekName ident = - case ident of - "α" -> Just "alpha" - "β" -> Just "beta" - "γ" -> Just "gamma" - "δ" -> Just "delta" - "ϵ" -> Just "varepsilon" - "ε" -> Just "epsilon" - "ζ" -> Just "zeta" - "η" -> Just "eta" - "θ" -> Just "theta" - "ϑ" -> Just "vartheta" - "ι" -> Just "iota" - "κ" -> Just "kappa" - "λ" -> Just "lambda" - "μ" -> Just "mu" - "ν" -> Just "nu" - "ξ" -> Just "xi" - "ο" -> Just "omicron" - "π" -> Just "pi" - "ϖ" -> Just "varpi" - "ρ" -> Just "rho" - "ϱ" -> Just "varrho" - "𝜚" -> Just "varrho" - "σ" -> Just "sigma" - "ς" -> Just "varsigma" - "𝜍" -> Just "varsigma" - "τ" -> Just "tau" - "υ" -> Just "upsilon" - "ϕ" -> Just "phi" - "φ" -> Just "varphi" - "χ" -> Just "chi" - "ψ" -> Just "psi" - "ω" -> Just "omega" - "Γ" -> Just "GAMMA" - "Δ" -> Just "DELTA" - "Θ" -> Just "THETA" - "Λ" -> Just "LAMBDA" - "Ξ" -> Just "XI" - "Π" -> Just "PI" - "Σ" -> Just "SIGMA" - "Υ" -> Just "UPSILON" - "Φ" -> Just "PHI" - "Ψ" -> Just "PSI" - "Ω" -> Just "OMEGA" - _ -> Nothing - -renderScriptBase :: Exp -> T.Text -> T.Text -renderScriptBase e rendered0 = - let rendered = T.strip rendered0 - in - if isAtomic e - then rendered - else "{" <> rendered <> "}" - -renderScriptArg :: AlignContext -> Exp -> Maybe T.Text -renderScriptArg ctx e = do - rendered0 <- renderExpIn ctx e - let rendered = T.strip rendered0 - pure $ if isAtomic e - then rendered - else "{" <> rendered <> "}" - -renderLimitArg :: AlignContext -> Exp -> Maybe T.Text -renderLimitArg ctx e = - case e of - EGrouped xs -> renderExpsIn ctx xs - _ -> T.strip <$> renderExpIn ctx e - -renderAccentArg :: Exp -> T.Text -> T.Text -renderAccentArg e rendered0 = - let rendered = T.strip rendered0 - in - if isAtomic e - then rendered - else "{" <> rendered <> "}" - -isAtomic :: Exp -> Bool -isAtomic e = - case e of - ENumber{} -> True - EIdentifier{} -> True - EMathOperator{} -> True - EText{} -> True - ESymbol{} -> True - _ -> False - -accentName :: Exp -> Maybe T.Text -accentName e = - case e of - ESymbol Accent s -> accentFromChar s - ESymbol _ s -> accentFromChar s - _ -> Nothing - -accentFromChar :: T.Text -> Maybe T.Text -accentFromChar s = - case s of - "\775" -> Just "dot" -- COMBINING DOT ABOVE - "˙" -> Just "dot" -- DOT ABOVE - "\776" -> Just "ddot" -- COMBINING DIAERESIS - "¨" -> Just "ddot" -- DIAERESIS - "\770" -> Just "hat" -- COMBINING CIRCUMFLEX ACCENT - "ˆ" -> Just "hat" -- MODIFIER LETTER CIRCUMFLEX ACCENT - "\780" -> Just "check" -- COMBINING CARON - "ˇ" -> Just "check" -- CARON - "\771" -> Just "tilde" -- COMBINING TILDE - "˜" -> Just "tilde" -- SMALL TILDE - "\772" -> Just "bar" -- COMBINING MACRON - "\8254" -> Just "bar" -- OVERLINE - "¯" -> Just "bar" -- MACRON - "\8407" -> Just "vec" -- COMBINING RIGHT ARROW ABOVE - "→" -> Just "vec" -- RIGHTWARDS ARROW - "\774" -> Just "breve" -- COMBINING BREVE - "˘" -> Just "breve" -- BREVE - _ -> Nothing - -data DelimSide = DelimLeft | DelimRight | DelimMiddle - -delimToken :: DelimSide -> T.Text -> T.Text -delimToken side raw = - case raw of - "" -> "none" - "." -> "none" - "(" -> "(" - ")" -> ")" - "[" -> "[" - "]" -> "]" - "{" -> case side of - DelimLeft -> "lbrace" - DelimRight -> "rbrace" - DelimMiddle -> "{" - "}" -> case side of - DelimLeft -> "lbrace" - DelimRight -> "rbrace" - DelimMiddle -> "}" - "|" -> case side of - DelimLeft -> "lline" - DelimRight -> "rline" - DelimMiddle -> "mline" - "∣" -> case side of - DelimLeft -> "lline" - DelimRight -> "rline" - DelimMiddle -> "mline" - "∥" -> case side of - DelimLeft -> "ldline" - DelimRight -> "rdline" - DelimMiddle -> "mline" - "⟨" -> "langle" - "⟩" -> "rangle" - "⌊" -> "lfloor" - "⌋" -> "rfloor" - "⌈" -> "lceil" - "⌉" -> "rceil" - "⟦" -> "ldbracket" - "⟧" -> "rdbracket" - _ -> raw - -renderSymbol :: TeXSymbolType -> T.Text -> T.Text -renderSymbol t s = - case s of - "∫" -> "int " - "∑" -> "sum " - "←" -> " leftarrow " - "→" -> " toward " - "↔" -> " leftrightarrow " - "⇐" -> " dlarrow " - "⇒" -> " drarrow " - "⇔" -> " dlrarrow " - "↑" -> " uparrow " - "↓" -> " downarrow " - "≤" -> " <= " - "≥" -> " >= " - "≠" -> " <> " - "≈" -> " approx " - "∼" -> " sim " - "≃" -> " simeq " - "≡" -> " equiv " - "∝" -> " prop " - "∥" -> " parallel " - "∣" -> " divides " - "∤" -> " ndivides " - "⊥" -> " ortho " - "⟂" -> " ortho " - "∈" -> " in " - "∉" -> " notin " - "∋" -> " owns " - "⊂" -> " subset " - "⊆" -> " subseteq " - "⊃" -> " supset " - "⊇" -> " supseteq " - "⊄" -> " nsubset " - "⊈" -> " nsubseteq " - "⊅" -> " nsupset " - "⊉" -> " nsupseteq " - "∪" -> " union " - "∩" -> " intersection " - "\\" -> " setminus " - "∧" -> " and " - "∨" -> " or " - "∀" -> "forall " - "∃" -> " exists " - "∄" -> " notexists " - "∂" -> " partial " - "∇" -> "nabla " - "∞" -> "infinity" - "∅" -> "emptyset" - "+" -> " + " - "-" | t == Bin -> " - " - "-" -> "-" - "−" | t == Bin -> " - " - "−" -> "-" - "=" -> " = " - "," -> ", " - ";" -> "; " - ":" -> ": " - "/" -> " / " - "⋅" -> " cdot " - "·" -> " cdot " - "×" -> " times " - _ -> s - -largeOpName :: Exp -> Maybe T.Text -largeOpName e = - case e of - ESymbol _ "∫" -> Just "int" - ESymbol _ "∑" -> Just "sum" - _ -> Nothing - -quoteText :: T.Text -> T.Text -quoteText = ("\"" <>) . (<> "\"") . T.concatMap go - where - go '"' = "\\\"" - go '\\' = "\\\\" - go c = T.singleton c diff --git a/stack.yaml b/stack.yaml index 1ac06cfd1557..a5b6b35eda6a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,6 +5,7 @@ flags: old-random: false packages: - '.' +- '../texmath' - 'pandoc-cli' - 'pandoc-lua-engine' - 'pandoc-server' @@ -24,7 +25,6 @@ extra-deps: - typst-symbols-0.1.9.1 - citeproc-0.13 - djot-0.1.3 -- texmath-0.13.1 - skylighting-format-blaze-html-0.1.2 - git: https://github.com/jgm/typst-hs commit: 1e2ecd62451ddfc9139c680a3aa5fe2637299a7f diff --git a/test/Tests/Readers/LaTeX.hs b/test/Tests/Readers/LaTeX.hs index e789795ff298..d300fddaf88d 100644 --- a/test/Tests/Readers/LaTeX.hs +++ b/test/Tests/Readers/LaTeX.hs @@ -52,6 +52,41 @@ tests = [ testGroup "basic" "some text" =?> para "some text" , "emphasized" =: "\\emph{emphasized}" =?> para (emph "emphasized") + , "BibTeX command" =: + "\\BibTeX" =?> para "BibTeX" + , "LaTeXe command" =: + "\\LaTeXe" =?> para "LaTeX2ε" + , "XeTeX command" =: + "\\XeTeX" =?> para "XeTeX" + , "XeLaTeX command" =: + "\\XeLaTeX" =?> para "XeLaTeX" + , "LuaTeX command" =: + "\\LuaTeX" =?> para "LuaTeX" + , "LuaLaTeX command" =: + "\\LuaLaTeX" =?> para "LuaLaTeX" + , "classic BibTeX logo macro is normalized" =: + T.unlines + [ "\\def\\BibTeX{{\\rm B\\kern-.05em{\\sc i\\kern-.025em b}\\kern-.08em" + , " T\\kern-.1667em\\lower.7ex\\hbox{E}\\kern-.125emX}}" + , "\\BibTeX" + ] =?> para "BibTeX" + , "custom BibTeX redefinition is preserved" =: + T.unlines + [ "\\renewcommand{\\BibTeX}{BIB}" + , "\\BibTeX" + ] =?> para "BIB" + , "multicols swallows column count" =: + T.unlines + [ "\\begin{multicols}{3}" + , "Hi" + , "\\end{multicols}" + ] =?> para "Hi" + , "multicols* swallows column count" =: + T.unlines + [ "\\begin{multicols*}{2}" + , "Hi" + , "\\end{multicols*}" + ] =?> para "Hi" ] , testGroup "headers" @@ -67,6 +102,32 @@ tests = [ testGroup "basic" , "link" =: "\\section{text \\href{/url}{link}}" =?> headerWith ("text-link",[],[]) 1 ("text" <> space <> link "/url" "" "link") + , "@startsection redefinition preserves heading semantics" =: + T.unlines + [ "\\makeatletter" + , "\\renewcommand{\\section}{\\@startsection{section}{1}{0mm}%" + , " {-1ex plus -.5ex minus -.2ex}%" + , " {0.5ex plus .2ex}%" + , " {\\normalfont\\large\\bfseries}}" + , "\\makeatother" + , "" + , "\\section{Document classes}" + ] =?> headerWith ("document-classes",[],[]) 1 "Document classes" + , "@startsection in document preamble preserves heading semantics" =: + T.unlines + [ "\\documentclass{article}" + , "\\makeatletter" + , "\\renewcommand{\\section}{\\@startsection{section}{1}{0mm}%" + , " {-1ex plus -.5ex minus -.2ex}%" + , " {0.5ex plus .2ex}%" + , " {\\normalfont\\large\\bfseries}}" + , "\\makeatother" + , "\\begin{document}" + , "\\section{Document classes}" + , "Text." + , "\\end{document}" + ] =?> (headerWith ("document-classes",[],[]) 1 "Document classes" + <> para "Text.") ] , testGroup "math" diff --git a/test/Tests/Writers/StarMath.hs b/test/Tests/Writers/StarMath.hs deleted file mode 100644 index 3ec037835d1f..000000000000 --- a/test/Tests/Writers/StarMath.hs +++ /dev/null @@ -1,188 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Tests.Writers.StarMath (tests) where - -import Data.Text (Text, unpack) -import Test.Tasty -import Test.Tasty.HUnit -import Text.TeXMath (DisplayType(..), readTeX, writeTeX) -import Text.Pandoc.Writers.StarMath (writeStarMath) - -tests :: [TestTree] -tests = - [ testCase "dot + text subscript" $ - star "\\dot{Q}_{\\text{dem}}(t)=\\dot{Q}_{\\text{eb}}(t)+\\dot{Q}_{\\text{dis}}(t)+\\dot{Q}_{\\text{boil}}(t)," - @?= - "{dot Q}_\"dem\"(t) = {dot Q}_\"eb\"(t) + {dot Q}_\"dis\"(t) + {dot Q}_\"boil\"(t)," - , testCase "common accents" $ - star "\\ddot{x}+\\hat{x}+\\tilde{x}+\\vec{x}+\\bar{x}" - @?= - "ddot x + hat x + tilde x + vec x + bar x" - , testCase "fraction" $ - star "\\frac{a+b}{c}" - @?= - "{{a + b} over c}" - , testCase "square root" $ - star "\\sqrt{x+1}" - @?= - "sqrt {{x + 1}}" - , testCase "nth root" $ - star "\\sqrt[3]{x}" - @?= - "nroot {3} {x}" - , testCase "subscript and superscript" $ - star "x_i^2" - @?= - "x_i^2" - , testCase "superscript with grouped base" $ - star "(a+b)^2" - @?= - "(a + b)^2" - , testCase "delimited fraction" $ - star "\\left(\\frac{a}{b}\\right)" - @?= - "left ( {a over b} right )" - , testCase "delimited braces" $ - star "\\left\\{\\frac{a}{b}\\right\\}" - @?= - "left lbrace {a over b} right rbrace" - , testCase "one-sided delimiter uses none" $ - star "\\left. x \\right|" - @?= - "left none x right rline" - , testCase "middle delimiter uses mline" $ - star "\\left( x \\middle| y \\right)" - @?= - "left ( x mline y right )" - , testCase "operator mapping cdot" $ - star "a\\cdot b" - @?= - "a cdot b" - , testCase "binomial (NoLineFrac)" $ - star "\\binom{n}{k}" - @?= - "left ( {n / k} right )" - , testCase "integral without limits" $ - star "\\int x\\,dx" - @?= - "int x dx" - , testCase "integral with lower and upper limits" $ - star "\\int_0^1 x\\,dx" - @?= - "int from 0 to 1 x dx" - , testCase "integral with infinite upper limit" $ - star "\\int_{0}^{\\infty} e^{-x}\\,dx" - @?= - "int from 0 to infinity e^{{- x}} dx" - , testCase "sum with lower and upper limits" $ - star "\\sum_{i=1}^{n} i" - @?= - "sum from i = 1 to n i" - , testCase "sum with symbolic term" $ - star "\\sum_{k=1}^{n} a_k" - @?= - "sum from k = 1 to n a_k" - , testCase "greek letter mapping" $ - star "\\alpha + \\beta + \\Gamma + \\Omega" - @?= - "%ialpha + %ibeta + %GAMMA + %OMEGA" - , testCase "greek variant mapping" $ - star "\\phi + \\varphi + \\epsilon + \\varepsilon + \\vartheta" - @?= - "%iphi + %ivarphi + %ivarepsilon + %iepsilon + %ivartheta" - , testCase "arrow mapping" $ - star "x \\to y, x \\leftarrow y, x \\Rightarrow y, x \\Leftrightarrow y" - @?= - "x toward y, x leftarrow y, x drarrow y, x dlrarrow y" - , testCase "set and relation symbol mapping" $ - star "A \\subseteq B, A \\cup B, x \\in A, x \\notin B" - @?= - "A subseteq B, A union B, x in A, x notin B" - , testCase "logic and calculus symbol mapping" $ - star "\\forall x \\exists y, \\nabla f = 0, \\partial_t u" - @?= - "forall x exists y, nabla f = 0, partial_t u" - , testCase "greek identifier spacing in products" $ - star "E_{k+1}=E_{k+\\frac12}-\\frac{\\dot{Q}_{\\text{dis},k}\\Delta t}{\\eta_{\\text{dis}}}," - @?= - "E_{{k + 1}} = E_{{k + {1 over 2}}} - {{{dot Q}_{{\"dis\", k}} %DELTA t} over %ieta_\"dis\"}," - , testCase "math operators rendered as functions" $ - star "E_{k+1}\\leftarrow\\min\\!\\left(E^{\\text{cap}}_{\\text{s}},\\max(0,E_{k+1})\\right)." - @?= - "E_{{k + 1}} leftarrow func min left ( E_\"s\"^\"cap\", func max(0, E_{{k + 1}}) right )." - , testCase "nested function with left delimiter spacing" $ - star "P_{\\text{ch}, k}=\\max\\!\\left(0,\\min\\!\\left(P'_{\\text{pv}, k},\\,P^{\\text{cap}}_{\\text{ch}},\\,P_{\\text{ch,head}, k}\\right)\\right)." - @?= - "P_{{\"ch\", k}} = func max left ( 0, func min left ( P_{{\"pv\", k}}^′, P_\"ch\"^\"cap\", P_{{\"ch,head\", k}} right ) right )." - , testCase "quad spacing command" $ - star "a,\\quad b" - @?= - "a, ~ b" - , testCase "qquad spacing command" $ - star "a,\\qquad b" - @?= - "a, ~~ b" - , testCase "greek token separator before scripted identifier" $ - star "f_{\\text{eff}}=(1-\\lambda)f_{\\text{m}}+\\lambda f_{\\text{l}}." - @?= - "f_\"eff\" = (1 - %ilambda) f_\"m\" + %ilambda f_\"l\"." - , testCase "mathcal styled token before left delimiter" $ - star "\\min\\ \\mathcal{J}\\left(P^{\\text{cap}}_{\\text{pv}},N_{\\text{u}},P^{\\text{cap}}_{\\text{eb}}\\right)" - @?= - "func min ital J left ( P_\"pv\"^\"cap\", N_\"u\", P_\"eb\"^\"cap\" right )" - , testCase "leading binary operator gets neutral lhs" $ - star "\\times\\Delta t" - @?= - "{} times %DELTA t" - , testCase "matrix environment" $ - star "\\begin{matrix}a&b\\\\c&d\\end{matrix}" - @?= - "matrix { a # b ## c # d }" - , testCase "pmatrix environment" $ - star "\\begin{pmatrix}a&b\\\\c&d\\end{pmatrix}" - @?= - "left ( matrix { a # b ## c # d } right )" - , testCase "bmatrix environment" $ - star "\\begin{bmatrix}a&b\\\\c&d\\end{bmatrix}" - @?= - "left [ matrix { a # b ## c # d } right ]" - , testCase "vmatrix environment" $ - star "\\begin{vmatrix}a&b\\\\c&d\\end{vmatrix}" - @?= - "left lline matrix { a # b ## c # d } right rline" - , testCase "Vmatrix environment" $ - star "\\begin{Vmatrix}a&b\\\\c&d\\end{Vmatrix}" - @?= - "left ldline matrix { a # b ## c # d } right rdline" - , testCase "array with left/right alignment" $ - star "\\begin{array}{lr}a&b\\\\c&d\\end{array}" - @?= - "matrix { alignl a # alignr b ## alignl c # alignr d }" - , testCase "aligned array keeps fractions centered" $ - star "\\begin{array}{l}\\frac{AAA}{B}\\end{array}" - @?= - "matrix { alignl {{alignc {AAA}} over {alignc B}} }" - , testCase "cases environment" $ - star "\\begin{cases}a, & x>0\\\\ b, & x\\le 0\\end{cases}" - @?= - "left lbrace matrix { alignl a, # alignl x>0 ## alignl b, # alignl x <= 0 } right none" - , testCase "cases with negative log fraction" $ - star "t_{\\text{pb,disc}}=\\begin{cases}\\dfrac{C_{\\text{tot}}}{B}, & r=0,\\\\\\dfrac{-\\ln\\!\\left(1-rC_{\\text{tot}}/B\\right)}{\\ln(1+r)}, & r>0\\text{ and }1-rC_{\\text{tot}}/B>0,\\\\\\infty, & \\text{otherwise}.\\end{cases}" - @?= - "t_\"pb,disc\" = left lbrace matrix { alignl {{alignc {C_\"tot\"}} over {alignc B}}, # alignl r = 0, ## alignl {{alignc {- func ln left ( 1 - rC_\"tot\" / B right )}} over {alignc {func ln(1 + r)}}}, # alignl r>0\" and \"1 - rC_\"tot\" / B>0, ## alignl infinity, # alignl \"otherwise\". } right none" - , testCase "fallback to TeX for unsupported forms" $ - case readTeX "\\phantom{x}+1" of - Left err -> assertFailure ("readTeX failed: " ++ unpack err) - Right exps -> - writeStarMath DisplayBlock exps @?= writeTeX exps - , testCase "fallback to TeX for under/over constructs" $ - case readTeX "\\underbrace{x+y}_{z}+\\overbrace{x+y}^{z}" of - Left err -> assertFailure ("readTeX failed: " ++ unpack err) - Right exps -> - writeStarMath DisplayBlock exps @?= writeTeX exps - ] - -star :: Text -> Text -star inp = - case readTeX inp of - Left err -> error ("readTeX failed in test: " ++ unpack err) - Right exps -> writeStarMath DisplayBlock exps diff --git a/test/test-pandoc.hs b/test/test-pandoc.hs index 079f8fd75dba..9ae97d9c0af9 100644 --- a/test/test-pandoc.hs +++ b/test/test-pandoc.hs @@ -49,7 +49,6 @@ import qualified Tests.Writers.Org import qualified Tests.Writers.Plain import qualified Tests.Writers.Powerpoint import qualified Tests.Writers.RST -import qualified Tests.Writers.StarMath import qualified Tests.Writers.AnnotatedTable import qualified Tests.Writers.TEI import qualified Tests.Writers.Markua @@ -85,7 +84,6 @@ tests pandocPath = testGroup "pandoc tests" , testGroup "FB2" Tests.Writers.FB2.tests , testGroup "PowerPoint" Tests.Writers.Powerpoint.tests , testGroup "Ms" Tests.Writers.Ms.tests - , testGroup "StarMath" Tests.Writers.StarMath.tests , testGroup "AnnotatedTable" Tests.Writers.AnnotatedTable.tests , testGroup "BBCode" Tests.Writers.BBCode.tests ]