From ff0e130560e32d23ead14bca7af821a80acc3318 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 22 Jul 2020 23:52:28 -0700 Subject: LaTeX reader: SUpport ams `\theoremstyle`. --- src/Text/Pandoc/Readers/LaTeX.hs | 34 ++++++++++++++++++++++++++------ src/Text/Pandoc/Readers/LaTeX/Parsing.hs | 12 +++++++++-- 2 files changed, 38 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 1538354e3..cd856b425 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -1725,6 +1725,7 @@ blockCommands = M.fromList , ("signature", mempty <$ (skipopts *> authors)) , ("date", mempty <$ (skipopts *> tok >>= addMeta "date")) , ("newtheorem", newtheorem) + , ("theoremstyle", theoremstyle) -- KOMA-Script metadata commands , ("extratitle", mempty <$ (skipopts *> tok >>= addMeta "extratitle")) , ("frontispiece", mempty <$ (skipopts *> tok >>= addMeta "frontispiece")) @@ -1857,6 +1858,19 @@ environments = M.fromList , ("iftoggle", try $ ifToggle >> block) ] +theoremstyle :: PandocMonad m => LP m Blocks +theoremstyle = do + stylename <- untokenize <$> braced + let mbstyle = case stylename of + "plain" -> Just PlainStyle + "definition" -> Just DefinitionStyle + "remark" -> Just RemarkStyle + _ -> Nothing + case mbstyle of + Nothing -> return () + Just sty -> updateState $ \s -> s{ sLastTheoremStyle = sty } + return mempty + newtheorem :: PandocMonad m => LP m Blocks newtheorem = do number <- option True (False <$ symbol '*' <* sp) @@ -1867,7 +1881,9 @@ newtheorem = do showName <- untokenize <$> braced sp syncTo <- option Nothing $ Just . untokenize <$> bracketedToks + sty <- sLastTheoremStyle <$> getState let spec = TheoremSpec { theoremName = showName + , theoremStyle = sty , theoremSeries = series , theoremSyncTo = syncTo , theoremNumber = number @@ -1906,14 +1922,14 @@ environment = try $ do controlSeq "begin" name <- untokenize <$> braced M.findWithDefault mzero name environments <|> - lookupTheoremEnvironment name <|> + theoremEnvironment name <|> if M.member name (inlineEnvironments :: M.Map Text (LP PandocPure Inlines)) then mzero else try (rawEnv name) <|> rawVerbEnv name -lookupTheoremEnvironment :: PandocMonad m => Text -> LP m Blocks -lookupTheoremEnvironment name = do +theoremEnvironment :: PandocMonad m => Text -> LP m Blocks +theoremEnvironment name = do tmap <- sTheoremMap <$> getState case M.lookup name tmap of Nothing -> mzero @@ -1947,10 +1963,16 @@ lookupTheoremEnvironment name = do Nothing -> return () return $ space <> B.text (renderDottedNum num) else return mempty - let title = B.strong (B.text (theoremName tspec) <> number) + let titleEmph = case theoremStyle tspec of + PlainStyle -> B.strong + DefinitionStyle -> B.strong + RemarkStyle -> B.emph + let title = titleEmph (B.text (theoremName tspec) <> number) <> optTitle <> space - return $ divWith ("", [name], []) $ addTitle title $ - walk italicize bs + return $ divWith ("", [name], []) $ addTitle title + $ case theoremStyle tspec of + PlainStyle -> walk italicize bs + _ -> bs italicize :: Block -> Block italicize (Para ils) = Para [Emph ils] diff --git a/src/Text/Pandoc/Readers/LaTeX/Parsing.hs b/src/Text/Pandoc/Readers/LaTeX/Parsing.hs index 4e8414fef..10e48b45f 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Parsing.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Parsing.hs @@ -19,6 +19,7 @@ module Text.Pandoc.Readers.LaTeX.Parsing , renderDottedNum , incrementDottedNum , TheoremSpec(..) + , TheoremStyle(..) , LaTeXState(..) , defaultLaTeXState , LP @@ -103,7 +104,7 @@ import Text.Parsec.Pos -- import Debug.Trace newtype DottedNum = DottedNum [Int] - deriving (Show) + deriving (Show, Eq) renderDottedNum :: DottedNum -> T.Text renderDottedNum (DottedNum xs) = T.pack $ @@ -115,14 +116,19 @@ incrementDottedNum level (DottedNum ns) = DottedNum $ (x:xs) -> reverse (x+1 : xs) [] -> [] -- shouldn't happen +data TheoremStyle = + PlainStyle | DefinitionStyle | RemarkStyle + deriving (Show, Eq) + data TheoremSpec = TheoremSpec { theoremName :: Text + , theoremStyle :: TheoremStyle , theoremSeries :: Maybe Text , theoremSyncTo :: Maybe Text , theoremNumber :: Bool , theoremLastNum :: DottedNum } - deriving (Show) + deriving (Show, Eq) data LaTeXState = LaTeXState{ sOptions :: ReaderOptions , sMeta :: Meta @@ -139,6 +145,7 @@ data LaTeXState = LaTeXState{ sOptions :: ReaderOptions , sLastFigureNum :: DottedNum , sLastTableNum :: DottedNum , sTheoremMap :: M.Map Text TheoremSpec + , sLastTheoremStyle :: TheoremStyle , sLastLabel :: Maybe Text , sLabels :: M.Map Text [Inline] , sHasChapters :: Bool @@ -163,6 +170,7 @@ defaultLaTeXState = LaTeXState{ sOptions = def , sLastFigureNum = DottedNum [] , sLastTableNum = DottedNum [] , sTheoremMap = M.empty + , sLastTheoremStyle = PlainStyle , sLastLabel = Nothing , sLabels = M.empty , sHasChapters = False -- cgit v1.2.3