From 6b722d1b45b59e8fa57b2fce4b74f2cb933f7b7e Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 26 Oct 2010 09:03:03 -0700 Subject: Process LaTeX macros in markdown, and apply to TeX math. Example: \newcommand{\plus}[2]{#1 + #2} $\plus{3}{4}$ yields: 3+4 --- pandoc.cabal | 2 +- src/Text/Pandoc/Parsing.hs | 9 +++++++-- src/Text/Pandoc/Readers/Markdown.hs | 31 ++++++++++++++++++++++++++++--- src/pandoc.hs | 5 +++-- 4 files changed, 39 insertions(+), 8 deletions(-) diff --git a/pandoc.cabal b/pandoc.cabal index b1e0e1bed..cea9de07c 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -157,7 +157,7 @@ Library process >= 1, directory >= 1, bytestring >= 0.9, zip-archive >= 0.1.1.4, utf8-string >= 0.3, old-time >= 1, - HTTP >= 4000.0.5, texmath >= 0.3, xml >= 1.3.5 && < 1.4, + HTTP >= 4000.0.5, texmath >= 0.4, xml >= 1.3.5 && < 1.4, random, extensible-exceptions if impl(ghc >= 6.10) Build-depends: base >= 4 && < 5, syb diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 3678fc22a..dce99fd75 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -79,6 +79,7 @@ import Network.URI ( parseURI, URI (..), isAllowedInURI ) import Control.Monad ( join, liftM ) import Text.Pandoc.Shared import qualified Data.Map as M +import Text.TeXMath.Macros (Macro) -- | Like >>, but returns the operation on the left. -- (Suggested by Tillmann Rendel on Haskell-cafe list.) @@ -602,7 +603,9 @@ data ParserState = ParserState stateIndentedCodeClasses :: [String], -- ^ Classes to use for indented code blocks stateNextExample :: Int, -- ^ Number of next example stateExamples :: M.Map String Int, -- ^ Map from example labels to numbers - stateHasChapters :: Bool -- ^ True if \chapter encountered + stateHasChapters :: Bool, -- ^ True if \chapter encountered + stateApplyMacros :: Bool, -- ^ Apply LaTeX macros? + stateMacros :: [Macro] -- ^ List of macros defined so far } deriving Show @@ -630,7 +633,9 @@ defaultParserState = stateIndentedCodeClasses = [], stateNextExample = 1, stateExamples = M.empty, - stateHasChapters = False } + stateHasChapters = False, + stateApplyMacros = True, + stateMacros = []} data HeaderType = SingleHeader Char -- ^ Single line of characters underneath diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 33fb3d8e6..0f10d2b65 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -46,7 +46,8 @@ import Text.Pandoc.Readers.HTML ( rawHtmlBlock, anyHtmlBlockTag, htmlBlockElement, htmlComment, unsanitaryURI ) import Text.Pandoc.CharacterReferences ( decodeCharacterReferences ) import Text.ParserCombinators.Parsec -import Control.Monad (when, liftM, unless) +import Control.Monad (when, liftM, unless, guard) +import Text.TeXMath.Macros (applyMacros, Macro, pMacroDefinition) -- | Read markdown from an input string and return a Pandoc document. readMarkdown :: ParserState -- ^ Parser state, including options for parser @@ -284,6 +285,7 @@ block = do , plain , nullBlock ] else [ codeBlockDelimited + , macro , header , table , codeBlockIndented @@ -867,6 +869,29 @@ table = multilineTable False <|> simpleTable True <|> simpleTable False <|> multilineTable True <|> gridTable False <|> gridTable True "table" +-- +-- Macros +-- + +-- | Parse a \newcommand or \renewcommand macro definition. +macro :: GenParser Char ParserState Block +macro = getState >>= guard . stateApplyMacros >> + pMacroDefinition >>= addMacro >> return Null + +-- | Add a macro to the list of macros in state. +addMacro :: Macro -> GenParser Char ParserState () +addMacro m = do + updateState $ \st -> st{ stateMacros = m : stateMacros st } + +-- | Apply current macros to string. +applyMacros' :: String -> GenParser Char ParserState String +applyMacros' target = do + apply <- liftM stateApplyMacros getState + if apply + then do macros <- liftM stateMacros getState + return $ applyMacros macros target + else return target + -- -- inline -- @@ -969,8 +994,8 @@ mathChunk = do char '\\' <|> many1 (noneOf " \t\n\\$") math :: GenParser Char ParserState Inline -math = (mathDisplay >>= return . Math DisplayMath) - <|> (mathInline >>= return . Math InlineMath) +math = (mathDisplay >>= applyMacros' >>= return . Math DisplayMath) + <|> (mathInline >>= applyMacros' >>= return . Math InlineMath) mathDisplay :: GenParser Char ParserState String mathDisplay = try $ do diff --git a/src/pandoc.hs b/src/pandoc.hs index c19e83927..3adb9746d 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -786,10 +786,11 @@ main = do stateCitations = map citeKey refs, #endif stateSmart = smart || writerName' `elem` - ["latex", "context", "man"], + ["latex", "context", "latex+lhs", "man"], stateColumns = columns, stateStrict = strict, - stateIndentedCodeClasses = codeBlockClasses } + stateIndentedCodeClasses = codeBlockClasses, + stateApplyMacros = writerName' `notElem` ["latex", "latex+lhs"] } let writerOptions = WriterOptions { writerStandalone = standalone', writerTemplate = if null template -- cgit v1.2.3