Tex to StarMath: better math/formula rendering in LibreOffice .odt output

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
 

pandoc.cabal

@@ -849,6 +849,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,

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

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

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

src/Text/Pandoc/Writers/ODT.hs

@@ -299,11 +299,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 +332,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 "<?xml version=\"1.0\" encoding=\"utf-8\"?>"

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

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"