@@ -662,13 +662,16 @@ breve 'U' = "Ŭ"
662662breve 'u' = "ŭ"
663663breve c = [c]
664664
665−mathDisplay :: [Tok] -> Inlines
666−mathDisplay = displayMath . trim . T.unpack . untokenize
665+toksToString :: [Tok] -> String
666+toksToString = T.unpack . untokenize
667+
668+mathDisplay :: String -> Inlines
669+mathDisplay = displayMath . trim
667670-- TODO we shouldn't need applyMacros
668671-- mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
669672
670−mathInline :: [Tok] -> Inlines
671−mathInline = math . trim . T.unpack . untokenize
673+mathInline :: String -> Inlines
674+mathInline = math . trim
672675-- TODO we shouldn't need applyMacros
673676-- mathInline p = math <$> (try p >>= applyMacros')
674677
@@ -679,7 +682,7 @@ dollarsMath = do
679682 contents <- many1Till anyTok (symbol '$')
680683 when display (() <$ symbol '$')
681684 let constructor = if display then mathDisplay else mathInline
682− return $ constructor contents
685+ return $ constructor $ toksToString contents
683686
684687inlineCommand' :: PandocMonad m => LP m Inlines
685688inlineCommand' = try $ do
@@ -779,6 +782,23 @@ unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
779782unescapeURL (x:xs) = x:unescapeURL xs
780783unescapeURL [] = ""
781784
785+mathEnvWith :: PandocMonad m
786+ => (Inlines -> a) -> Maybe String -> String -> LP m a
787+mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name
788+ where inner x = case innerEnv of
789+ Nothing -> x
790+ Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
791+ "\\end{" ++ y ++ "}"
792+
793+mathEnv :: PandocMonad m => String -> LP m String
794+mathEnv name = do
795+ skipopts
796+ optional blankline
797+ let endEnv = try $ controlSeq "end" *>
798+ (T.unpack . untokenize <$> braced) >>= guard . (== name)
799+ res <- manyTill anyTok endEnv
800+ return $ stripTrailingNewlines $ T.unpack $ untokenize res
801+
782802inlineEnvironment :: PandocMonad m => LP m Inlines
783803inlineEnvironment = try $ do
784804 controlSeq "begin"
@@ -787,20 +807,20 @@ inlineEnvironment = try $ do
787807
788808inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)
789809inlineEnvironments = M.fromList [
790−-- ("displaymath", mathEnvWith id Nothing "displaymath")
791−-- , ("math", math <$> mathEnv "math")
792−-- , ("equation", mathEnvWith id Nothing "equation")
793−-- , ("equation*", mathEnvWith id Nothing "equation*")
794−-- , ("gather", mathEnvWith id (Just "gathered") "gather")
795−-- , ("gather*", mathEnvWith id (Just "gathered") "gather*")
796−-- , ("multline", mathEnvWith id (Just "gathered") "multline")
797−-- , ("multline*", mathEnvWith id (Just "gathered") "multline*")
798−-- , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")
799−-- , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")
800−-- , ("align", mathEnvWith id (Just "aligned") "align")
801−-- , ("align*", mathEnvWith id (Just "aligned") "align*")
802−-- , ("alignat", mathEnvWith id (Just "aligned") "alignat")
803−-- , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
810+ ("displaymath", mathEnvWith id Nothing "displaymath")
811+ , ("math", math <$> mathEnv "math")
812+ , ("equation", mathEnvWith id Nothing "equation")
813+ , ("equation*", mathEnvWith id Nothing "equation*")
814+ , ("gather", mathEnvWith id (Just "gathered") "gather")
815+ , ("gather*", mathEnvWith id (Just "gathered") "gather*")
816+ , ("multline", mathEnvWith id (Just "gathered") "multline")
817+ , ("multline*", mathEnvWith id (Just "gathered") "multline*")
818+ , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")
819+ , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")
820+ , ("align", mathEnvWith id (Just "aligned") "align")
821+ , ("align*", mathEnvWith id (Just "aligned") "align*")
822+ , ("alignat", mathEnvWith id (Just "aligned") "alignat")
823+ , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
804824 ]
805825
806826inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
@@ -832,9 +852,9 @@ inlineCommands = M.fromList $
832852 , ("textgreek", tok)
833853 , ("sep", lit ",")
834854 , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
835− , ("(", mathInline <$> manyTill anyTok (controlSeq ")"))
836− , ("[", mathDisplay <$> manyTill anyTok (controlSeq "]"))
837− , ("ensuremath", mathInline <$> braced)
855+ , ("(", mathInline . toksToString <$> manyTill anyTok (controlSeq ")"))
856+ , ("[", mathDisplay . toksToString <$> manyTill anyTok (controlSeq "]"))
857+ , ("ensuremath", mathInline . toksToString <$> braced)
838858 , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
839859 , ("P", lit "¶")
840860 , ("S", lit "§")
@@ -992,20 +1012,20 @@ inlineCommands = M.fromList $
9921012ttfamily :: PandocMonad m => LP m Inlines
9931013ttfamily = (code . stringify . toList) <$> tok
9941014
995−rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
1015+rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines
9961016rawInlineOr name' fallback = do
9971017 parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
9981018 if parseRaw
9991019 then rawInline "latex" <$> getRawCommand name'
10001020 else fallback
10011021
1002−getRawCommand :: PandocMonad m => String -> LP m String
1022+getRawCommand :: PandocMonad m => Text -> LP m String
10031023getRawCommand name' = do
10041024 (_, rawargs) <- withRaw
10051025 (many (try (optional sp *> opt)) *>
10061026 option "" (try (optional sp *> dimenarg)) *>
10071027 many braced)
1008− return $ '\\' : name' ++ T.unpack (untokenize rawargs)
1028+ return $ '\\' : T.unpack (name' <> untokenize rawargs)
10091029
10101030isBlockCommand :: Text -> Bool
10111031isBlockCommand s =
@@ -1075,15 +1095,149 @@ maybeAddExtension ext fp =
10751095 then addExtension fp ext
10761096 else fp
10771097
1098+ignoreBlocks :: PandocMonad m => Text -> (Text, LP m Blocks)
1099+ignoreBlocks name = (name, p)
1100+ where
1101+ p = do oa <- optargs
1102+ let rawCommand = '\\' : T.unpack (name <> oa)
1103+ let doraw = guardRaw >> return (rawBlock "latex" rawCommand)
1104+ doraw <|> ignore rawCommand
1105+
1106+addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
1107+addMeta field val = updateState $ \st ->
1108+ st{ stateMeta = addMetaField field val $ stateMeta st }
1109+
1110+authors :: PandocMonad m => LP m ()
1111+authors = try $ do
1112+ bgroup
1113+ let oneAuthor = mconcat <$>
1114+ many1 (notFollowedBy' (controlSeq "and") >>
1115+ (inline <|> mempty <$ blockCommand))
1116+ -- skip e.g. \vspace{10pt}
1117+ auths <- sepBy oneAuthor (controlSeq "and")
1118+ egroup
1119+ addMeta "author" (map trimInlines auths)
1120+
1121+section :: PandocMonad m => Attr -> Int -> LP m Blocks
1122+section (ident, classes, kvs) lvl = do
1123+ skipopts
1124+ contents <- grouped inline
1125+ lab <- option ident $
1126+ try (spaces >> controlSeq "label"
1127+ >> spaces >> toksToString <$> braced)
1128+ attr' <- registerHeader (lab, classes, kvs) contents
1129+ return $ headerWith attr' lvl contents
1130+
1131+blockCommand :: PandocMonad m => LP m Blocks
1132+blockCommand = try $ do
1133+ Tok _ CtrlSeq name <- anyControlSeq
1134+ guard $ name /= "\\begin" && name /= "\\end"
1135+ star <- option "" ("*" <$ symbol '*' <* optional sp)
1136+ let name' = name <> star
1137+ let names = name : [name' | name' /= name]
1138+ let raw = rawBlock "latex" <$> getRawCommand name'
1139+ -- TODO do we still need this?
1140+ -- rawcommand <- getRawCommand name'
1141+ -- transformed <- applyMacros' rawcommand
1142+ -- guard $ transformed /= rawcommand
1143+ -- notFollowedBy $ parseFromString' inlines transformed
1144+ -- parseFromString' blocks transformed
1145+ lookupListDefault raw names blockCommands
1146+
1147+closing :: PandocMonad m => LP m Blocks
1148+closing = do
1149+ contents <- tok
1150+ st <- getState
1151+ let extractInlines (MetaBlocks [Plain ys]) = ys
1152+ extractInlines (MetaBlocks [Para ys ]) = ys
1153+ extractInlines _ = []
1154+ let sigs = case lookupMeta "author" (stateMeta st) of
1155+ Just (MetaList xs) ->
1156+ para $ trimInlines $ fromList $
1157+ intercalate [LineBreak] $ map extractInlines xs
1158+ _ -> mempty
1159+ return $ para (trimInlines contents) <> sigs
1160+
10781161blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
1079−blockCommands = M.empty
1162+blockCommands = M.fromList $
1163+ [ ("par", mempty <$ skipopts)
1164+ , ("parbox", braced >> grouped blocks)
1165+ , ("title", mempty <$ (skipopts *>
1166+ (grouped inline >>= addMeta "title")
1167+ <|> (grouped block >>= addMeta "title")))
1168+ , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
1169+ , ("author", mempty <$ (skipopts *> authors))
1170+ -- -- in letter class, temp. store address & sig as title, author
1171+ , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
1172+ , ("signature", mempty <$ (skipopts *> authors))
1173+ , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
1174+ -- Koma-script metadata commands
1175+ , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
1176+ -- sectioning
1177+ , ("part", section nullAttr (-1))
1178+ , ("part*", section nullAttr (-1))
1179+ , ("chapter", section nullAttr 0)
1180+ , ("chapter*", section ("",["unnumbered"],[]) 0)
1181+ , ("section", section nullAttr 1)
1182+ , ("section*", section ("",["unnumbered"],[]) 1)
1183+ , ("subsection", section nullAttr 2)
1184+ , ("subsection*", section ("",["unnumbered"],[]) 2)
1185+ , ("subsubsection", section nullAttr 3)
1186+ , ("subsubsection*", section ("",["unnumbered"],[]) 3)
1187+ , ("paragraph", section nullAttr 4)
1188+ , ("paragraph*", section ("",["unnumbered"],[]) 4)
1189+ , ("subparagraph", section nullAttr 5)
1190+ , ("subparagraph*", section ("",["unnumbered"],[]) 5)
1191+ -- beamer slides
1192+ , ("frametitle", section nullAttr 3)
1193+ , ("framesubtitle", section nullAttr 4)
1194+ -- letters
1195+ , ("opening", (para . trimInlines) <$> (skipopts *> tok))
1196+ , ("closing", skipopts *> closing)
1197+ --
1198+ , ("hrule", pure horizontalRule)
1199+ , ("strut", pure mempty)
1200+ , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
1201+-- , ("item", skipopts *> looseItem)
1202+-- , ("documentclass", skipopts *> braced *> preamble)
1203+-- , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
1204+-- , ("caption", skipopts *> setCaption)
1205+-- , ("bibliography", mempty <$ (skipopts *> braced >>=
1206+-- addMeta "bibliography" . splitBibs))
1207+-- , ("addbibresource", mempty <$ (skipopts *> braced >>=
1208+-- addMeta "bibliography" . splitBibs))
1209+-- -- includes
1210+-- , ("lstinputlisting", inputListing)
1211+-- , ("graphicspath", graphicsPath)
1212+-- -- hyperlink
1213+ , ("hypertarget", braced >> grouped block)
1214+ ] ++ map ignoreBlocks
1215+ -- these commands will be ignored unless --parse-raw is specified,
1216+ -- in which case they will appear as raw latex blocks
1217+ [ "newcommand", "renewcommand", "newenvironment", "renewenvironment"
1218+ -- newcommand, etc. should be parsed by macro, but we need this
1219+ -- here so these aren't parsed as inline commands to ignore
1220+ , "special", "pdfannot", "pdfstringdef"
1221+ , "bibliographystyle"
1222+ , "maketitle", "makeindex", "makeglossary"
1223+ , "addcontentsline", "addtocontents", "addtocounter"
1224+ -- \ignore{} is used conventionally in literate haskell for definitions
1225+ -- that are to be processed by the compiler but not printed.
1226+ , "ignore"
1227+ , "hyperdef"
1228+ , "markboth", "markright", "markleft"
1229+ , "hspace", "vspace"
1230+ , "newpage"
1231+ , "clearpage"
1232+ , "pagebreak"
1233+ ]
10801234
10811235block :: PandocMonad m => LP m Blocks
10821236block = (mempty <$ spaces1)
10831237 -- <|> environment
10841238 <|> include
10851239 -- <|> macro
1086− -- <|> blockCommand
1240+ <|> blockCommand
10871241 <|> paragraph
10881242 <|> grouped block
10891243
@@ -1963,19 +2117,6 @@ blocks = mconcat <$> many block
19632117-- _ -> mempty
19642118-- return $ addr <> bs -- sig added by \closing
19652119--
1966−-- closing :: PandocMonad m => LP m Blocks
1967−-- closing = do
1968−-- contents <- tok
1969−-- st <- getState
1970−-- let extractInlines (MetaBlocks [Plain ys]) = ys
1971−-- extractInlines (MetaBlocks [Para ys ]) = ys
1972−-- extractInlines _ = []
1973−-- let sigs = case lookupMeta "author" (stateMeta st) of
1974−-- Just (MetaList xs) ->
1975−-- para $ trimInlines $ fromList $
1976−-- intercalate [LineBreak] $ map extractInlines xs
1977−-- _ -> mempty
1978−-- return $ para (trimInlines contents) <> sigs
19792120--
19802121-- item :: PandocMonad m => LP m Blocks
19812122-- item = blocks *> controlSeq "item" *> skipopts *> blocks