diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -4,4 +4,4 @@ main = defaultMainWithHooks $ simpleUserHooks { runTests = runTestSuite } -runTestSuite _ _ _ _ = system "cd tests && ./runtests.sh" >>= exitWith +runTestSuite _ _ _ _ = system "cd tests && sh runtests.sh" >>= exitWith diff --git a/Text/TeXMath/Macros.hs b/Text/TeXMath/Macros.hs new file mode 100644 --- /dev/null +++ b/Text/TeXMath/Macros.hs @@ -0,0 +1,172 @@ +{- +Copyright (C) 2010 John MacFarlane + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | Functions for parsing LaTeX macro definitions and applying macros + to LateX expressions. +-} + +module Text.TeXMath.Macros ( Macro(..) + , pMacroDefinition + , pSkipSpaceComments + , applyMacros + ) +where + +import Data.Char (isDigit, isLetter) +import Control.Monad +import Text.ParserCombinators.Parsec + +newtype Macro = Macro { macroParser :: Parser String } + +-- | Parses a @\\newcommand@ or @\\renewcommand@ macro definition and +-- returns a 'Macro'. +pMacroDefinition :: Parser Macro +pMacroDefinition = newcommand + +-- | Skip whitespace and comments. +pSkipSpaceComments :: Parser () +pSkipSpaceComments = spaces >> skipMany (comment >> spaces) + +-- | Applies a list of macros to a string recursively until a fixed +-- point is reached. If there are several macros in the list with the +-- same name, later ones will shadow earlier ones. +applyMacros :: [Macro] -> String -> String +applyMacros [] = id +applyMacros ms = iterateToFixedPoint ((2 * length ms) + 1) $ + applyMacrosOnce $ reverse ms -- we reverse so that the most recently + -- defined macros will be applied first + -- and shadow others with the same name + +------------------------------------------------------------------------------------ + +iterateToFixedPoint :: Eq a => Int -> (a -> a) -> a -> a +iterateToFixedPoint 0 _ _ = error $ + "Macro application did not terminate in a reasonable time.\n" ++ + "Check your macros for loops." +iterateToFixedPoint limit f x = + if x' == x + then x' + else iterateToFixedPoint (limit - 1) f x' + where x' = f x + +applyMacrosOnce :: [Macro] -> String -> String +applyMacrosOnce ms s = + case parse (many tok) "input" s of + Right r -> concat r + Left _ -> s -- just return original on error + where tok = try $ do + skipComment + choice [ escaped "\\" + , choice (map macroParser ms) + , ctrlseq + , count 1 anyChar ] + ctrlseq = do + char '\\' + res <- many1 letter <|> count 1 anyChar + return $ '\\' : res + +newcommand :: Parser Macro +newcommand = try $ do + char '\\' + optional $ try $ string "re" + string "newcommand" + pSkipSpaceComments + name <- inbraces + guard (take 1 name == "\\") + let name' = drop 1 name + pSkipSpaceComments + numargs <- numArgs + pSkipSpaceComments + optarg <- if numargs > 0 + then optArg + else return Nothing + let numargs' = case optarg of + Just _ -> numargs - 1 + Nothing -> numargs + pSkipSpaceComments + body <- inbraces + return $ Macro $ try $ do + char '\\' + string name' + when (all isLetter name') $ + notFollowedBy letter + opt <- case optarg of + Nothing -> return Nothing + Just _ -> liftM (`mplus` optarg) optArg + args <- count numargs' inbraces + let args' = case opt of + Just x -> x : args + Nothing -> args + return $ apply args' body + +apply :: [String] -> String -> String +apply args ('#':d:xs) | isDigit d = + let argnum = read [d] + in if length args >= argnum + then args !! (argnum - 1) ++ apply args xs + else '#' : d : apply args xs +apply args ('\\':'#':xs) = '\\':'#' : apply args xs +apply args (x:xs) = x : apply args xs +apply _ "" = "" + +skipComment :: Parser () +skipComment = skipMany comment + +comment :: Parser () +comment = do + char '%' + skipMany (notFollowedBy newline >> anyChar) + newline + return () + +numArgs :: Parser Int +numArgs = option 0 $ do + pSkipSpaceComments + char '[' + pSkipSpaceComments + n <- digit + pSkipSpaceComments + char ']' + return $ read [n] + +optArg :: Parser (Maybe String) +optArg = option Nothing $ (liftM Just $ inBrackets) + +escaped :: String -> Parser String +escaped xs = try $ char '\\' >> oneOf xs >>= \x -> return ['\\',x] + +inBrackets :: Parser String +inBrackets = try $ do + char '[' + pSkipSpaceComments + res <- manyTill (skipComment >> (escaped "[]" <|> count 1 anyChar)) + (try $ pSkipSpaceComments >> char ']') + return $ concat res + +inbraces :: Parser String +inbraces = try $ do + char '{' + res <- manyTill (skipComment >> (inbraces' <|> count 1 anyChar <|> escaped "{}")) + (try $ skipComment >> char '}') + return $ concat res + +inbraces' :: Parser String +inbraces' = do + res <- inbraces + return $ '{' : (res ++ "}") + diff --git a/Text/TeXMath/Parser.hs b/Text/TeXMath/Parser.hs --- a/Text/TeXMath/Parser.hs +++ b/Text/TeXMath/Parser.hs @@ -95,6 +95,7 @@ , diacritical , escaped , unicode + , ensuremath ] formula :: GenParser Char st [Exp] @@ -296,6 +297,10 @@ unicode :: GenParser Char st Exp unicode = lexeme $ liftM (ESymbol Ord . (:[])) $ satisfy (not . isAscii) + +ensuremath :: GenParser Char st Exp +ensuremath = lexeme $ try $ + string "\\ensuremath" >> inbraces command :: GenParser Char st String command = try $ char '\\' >> liftM ('\\':) (identifier <|> lexeme (count 1 anyChar)) diff --git a/cgi/texmath-cgi.hs b/cgi/texmath-cgi.hs --- a/cgi/texmath-cgi.hs +++ b/cgi/texmath-cgi.hs @@ -2,19 +2,34 @@ import Network.CGI import Text.XML.Light import Text.TeXMath +import Text.TeXMath.Macros import Data.Maybe (fromMaybe) import Control.Monad import Text.JSON import Codec.Binary.UTF8.String (decodeString) +import Text.ParserCombinators.Parsec (Parser, parse, many, try, eof) +pMacros :: Parser [Macro] +pMacros = do + macros <- many (try $ pSkipSpaceComments >> pMacroDefinition) + pSkipSpaceComments >> eof + return macros + cgiMain :: CGI CGIResult cgiMain = do - latexFormula <- liftM (decodeString . fromMaybe "") $ getInput "latexFormula" setHeader "Content-type" "text/xhtml; charset=UTF-8" + latexFormula <- liftM (decodeString . fromMaybe "") $ getInput "latexFormula" + rawMacros <- liftM (decodeString . fromMaybe "") $ getInput "macros" output . encodeStrict $ - case texMathToMathML DisplayBlock latexFormula of - Left e -> toJSObject [("success", JSBool False), ("error", JSString $ toJSString e)] - Right v -> toJSObject [("success", JSBool True), ("mathml", JSString $ toJSString $ ppElement v)] + case parse pMacros "macros" (rawMacros ++ "\n") of + Left err -> toJSObject [("success", JSBool False) + ,("error", JSString $ toJSString (show err))] + Right ms -> case texMathToMathML DisplayBlock (applyMacros ms latexFormula) of + Left e -> toJSObject [("success", JSBool False) + , ("error", JSString $ toJSString e)] + Right v -> toJSObject [("success", JSBool True) + , ("mathml", JSString $ toJSString $ + ppElement v)] main :: IO () main = runCGI $ handleErrors cgiMain diff --git a/cgi/texmath.xhtml b/cgi/texmath.xhtml --- a/cgi/texmath.xhtml +++ b/cgi/texmath.xhtml @@ -14,7 +14,8 @@

LaTeX to MathML converter


-
+
+
using texmath diff --git a/testTeXMathML.hs b/testTeXMathML.hs --- a/testTeXMathML.hs +++ b/testTeXMathML.hs @@ -2,7 +2,8 @@ import Text.TeXMath import Text.XML.Light - +import Text.TeXMath.Macros +import Text.ParserCombinators.Parsec import System.IO inHtml :: Element -> Element @@ -15,9 +16,18 @@ unode "meta" () , unode "body" x ] +stripMacroDefs :: Parser ([Macro], String) +stripMacroDefs = do + macros <- many (try $ pSkipSpaceComments >> pMacroDefinition) + rest <- getInput + return (macros, rest) + main :: IO () main = do inp <- getContents - case (texMathToMathML DisplayBlock $! inp) of - Left err -> hPutStrLn stderr err - Right v -> putStr . ppTopElement . inHtml $ v + case parse stripMacroDefs "stdin" inp of + Left err -> error $ show err + Right (ms, rest)-> + case (texMathToMathML DisplayBlock $! applyMacros ms rest) of + Left err -> hPutStrLn stderr err + Right v -> putStr . ppTopElement . inHtml $ v diff --git a/tests/ensuremath.tex b/tests/ensuremath.tex new file mode 100644 --- /dev/null +++ b/tests/ensuremath.tex @@ -0,0 +1,1 @@ +\ensuremath{\pi^2} diff --git a/tests/ensuremath.xhtml b/tests/ensuremath.xhtml new file mode 100644 --- /dev/null +++ b/tests/ensuremath.xhtml @@ -0,0 +1,16 @@ + + + + + + + + + + π + 2 + + + + + diff --git a/tests/macros.tex b/tests/macros.tex new file mode 100644 --- /dev/null +++ b/tests/macros.tex @@ -0,0 +1,18 @@ +\newcommand{\abc}{5} +\newcommand{\def}[2][x]{% +#1 + #2% +} +\renewcommand{% +\phi% +}{% +\theta% +} +% comment +\newcommand{\a}{\b{2}} +\renewcommand{\phi}{\a} +\newcommand{\b}[1]{#1} + +\phi +\abc +\def[y]{3} +\def{3} diff --git a/tests/macros.xhtml b/tests/macros.xhtml new file mode 100644 --- /dev/null +++ b/tests/macros.xhtml @@ -0,0 +1,20 @@ + + + + + + + + + 2 + 5 + y + + + 3 + x + + + 3 + + + + diff --git a/tests/runtests.sh b/tests/runtests.sh --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -6,15 +6,19 @@ # Exit status is number of failed tests. TESTPROG=../dist/build/testTeXMathML/testTeXMathML failures=0 -for t in *.tex; do - $TESTPROG <$t >tmp - diff ${t%.tex}.xhtml tmp >tmpdiff - if [ "$?" -ne "0" ]; then - echo "Test ${t%.tex} FAILED (< expected, > actual):" - cat tmpdiff - let "failures=$failures+1" - else - echo "Test ${t%.tex} PASSED" - fi -done +if [ -f $TESTPROG ]; then + for t in *.tex; do + $TESTPROG <$t >tmp + diff ${t%.tex}.xhtml tmp >tmpdiff + if [ "$?" -ne "0" ]; then + echo "Test ${t%.tex} FAILED (< expected, > actual):" + cat tmpdiff + let "failures=$failures+1" + else + echo "Test ${t%.tex} PASSED" + fi + done +else + echo "Test executable not built. NOT running tests." +fi exit $failures diff --git a/texmath.cabal b/texmath.cabal --- a/texmath.cabal +++ b/texmath.cabal @@ -1,5 +1,5 @@ Name: texmath -Version: 0.3.0.3 +Version: 0.3.1.3 Cabal-version: >= 1.2 Build-type: Custom Synopsis: Conversion of LaTeX math formulas to MathML. @@ -46,6 +46,8 @@ tests/sophomores_dream.tex, tests/sophomores_dream.xhtml, tests/sphere_volume.tex, tests/sphere_volume.xhtml, tests/unicode.tex, tests/unicode.xhtml + tests/ensuremath.tex, tests/ensuremath.xhtml + tests/macros.tex, tests/macros.xhtml Flag cgi description: Compile cgi executable. @@ -61,7 +63,10 @@ Build-depends: base >= 4 && < 5, syb else Build-depends: base >= 3 && < 4 - Exposed-modules: Text.TeXMath, Text.TeXMath.Parser, Text.TeXMath.MathMLWriter + Exposed-modules: Text.TeXMath + Text.TeXMath.Parser + Text.TeXMath.MathMLWriter + Text.TeXMath.Macros if impl(ghc >= 6.12) Ghc-Options: -Wall -fno-warn-unused-do-bind