@@ -1,7 +1,3 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE MultiParamTypeClasses #-}
51{-# LANGUAGE OverloadedStrings #-}
62{-# LANGUAGE PatternGuards #-}
73{-# LANGUAGE ScopedTypeVariables #-}
@@ -22,50 +18,58 @@ module Text.Pandoc.Readers.LaTeX ( readLaTeX,
2218 applyMacros,
2319 rawLaTeXInline,
2420 rawLaTeXBlock,
25− inlineCommand,
26− tokenize,
27− untokenize
21+ inlineCommand
2822 ) where
2923
3024import Control.Applicative (many, optional, (<|>))
3125import Control.Monad
3226import Control.Monad.Except (throwError)
33−import Data.Char (isDigit, isLetter, toUpper, chr)
27+import Data.Char (isDigit, isLetter, isAlphaNum, toUpper, chr)
3428import Data.Default
35−import Data.Functor (($>))
3629import Data.List (intercalate)
3730import qualified Data.Map as M
3831import Data.Maybe (fromMaybe, maybeToList)
3932import qualified Data.Set as Set
40−import qualified Data.Sequence as Seq
4133import Data.Text (Text)
4234import qualified Data.Text as T
35+import Skylighting (defaultSyntaxMap)
4336import System.FilePath (addExtension, replaceExtension, takeExtension)
44−import Text.Pandoc.BCP47 (Lang (..), renderLang)
45−import Text.Pandoc.Builder
37+import Text.Collate.Lang (renderLang)
38+import Text.Pandoc.Builder as B
4639import Text.Pandoc.Class.PandocPure (PandocPure)
4740import Text.Pandoc.Class.PandocMonad (PandocMonad (..), getResourcePath,
48− readFileFromDirs, report, setResourcePath,
49− setTranslations, translateTerm)
41+ readFileFromDirs, report,
42+ setResourcePath)
5043import Text.Pandoc.Error (PandocError (PandocParseError, PandocParsecError))
51−import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
44+import Text.Pandoc.Highlighting (languagesByExtension)
5245import Text.Pandoc.ImageSize (numUnit, showFl)
5346import Text.Pandoc.Logging
5447import Text.Pandoc.Options
5548import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,
5649 optional, space, spaces, withRaw, (<|>))
57−import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
58− ArgSpec (..), Tok (..), TokType (..))
50+import Text.Pandoc.Readers.LaTeX.Types (Tok (..), TokType (..))
5951import Text.Pandoc.Readers.LaTeX.Parsing
60−import Text.Pandoc.Readers.LaTeX.Accent (accentCommands)
61−import Text.Pandoc.Readers.LaTeX.Lang (polyglossiaLangToBCP47,
62− babelLangToBCP47)
63−import Text.Pandoc.Readers.LaTeX.SIunitx
52+import Text.Pandoc.Readers.LaTeX.Citation (citationCommands, cites)
53+import Text.Pandoc.Readers.LaTeX.Math (dollarsMath, inlineEnvironments,
54+ inlineEnvironment,
55+ mathDisplay, mathInline,
56+ newtheorem, theoremstyle, proof,
57+ theoremEnvironment)
58+import Text.Pandoc.Readers.LaTeX.Table (tableEnvironments)
59+import Text.Pandoc.Readers.LaTeX.Macro (macroDef)
60+import Text.Pandoc.Readers.LaTeX.Lang (inlineLanguageCommands,
61+ enquoteCommands,
62+ babelLangToBCP47, setDefaultLanguage)
63+import Text.Pandoc.Readers.LaTeX.SIunitx (siunitxCommands)
64+import Text.Pandoc.Readers.LaTeX.Inline (acronymCommands, refCommands,
65+ nameCommands, charCommands,
66+ accentCommands,
67+ biblatexInlineCommands,
68+ verbCommands, rawInlineOr,
69+ listingsLanguage)
6470import Text.Pandoc.Shared
65−import qualified Text.Pandoc.Translations as Translations
6671import Text.Pandoc.Walk
67−import qualified Text.Pandoc.Builder as B
68−import Safe
72+import Data.List.NonEmpty (nonEmpty)
6973
7074-- for debugging:
7175-- import Text.Pandoc.Extensions (getDefaultExtensions)
@@ -73,16 +77,17 @@ import Safe
7377-- import Debug.Trace (traceShowId)
7478
7579-- | Parse LaTeX from string and return 'Pandoc' document.
76−readLaTeX :: PandocMonad m
80+readLaTeX :: (PandocMonad m, ToSources a)
7781 => ReaderOptions -- ^ Reader options
78− -> Text -- ^ String to parse (assumes @'\n'@ line endings)
82+ -> a -- ^ Input to parse
7983 -> m Pandoc
8084readLaTeX opts ltx = do
85+ let sources = toSources ltx
8186 parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"
82− (tokenize "source" (crFilter ltx))
87+ (tokenizeSources sources)
8388 case parsed of
8489 Right result -> return result
85− Left e -> throwError $ PandocParsecError ltx e
90+ Left e -> throwError $ PandocParsecError sources e
8691
8792parseLaTeX :: PandocMonad m => LP m Pandoc
8893parseLaTeX = do
@@ -93,11 +98,7 @@ parseLaTeX = do
9398 let doc' = doc bs
9499 let headerLevel (Header n _ _) = [n]
95100 headerLevel _ = []
96−#if MIN_VERSION_safe(0,3,18)
97− let bottomLevel = minimumBound 1 $ query headerLevel doc'
98−#else
99− let bottomLevel = minimumDef 1 $ query headerLevel doc'
100−#endif
101+ let bottomLevel = maybe 1 minimum $ nonEmpty $ query headerLevel doc'
101102 let adjustHeaders m (Header n attr ils) = Header (n+m) attr ils
102103 adjustHeaders _ x = x
103104 let (Pandoc _ bs') =
@@ -132,11 +133,11 @@ resolveRefs _ x = x
132133
133134
134135rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)
135− => ParserT Text s m Text
136+ => ParserT Sources s m Text
136137rawLaTeXBlock = do
137138 lookAhead (try (char '\\' >> letter))
138139 inp <- getInput
139− let toks = tokenize "source" inp
140+ let toks = tokenizeSources inp
140141 snd <$> (rawLaTeXParser toks False (macroDef (const mempty)) blocks
141142 <|> rawLaTeXParser toks True
142143 (do choice (map controlSeq
@@ -163,14 +164,14 @@ beginOrEndCommand = try $ do
163164 (txt <> untokenize rawargs)
164165
165166rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)
166− => ParserT Text s m Text
167+ => ParserT Sources s m Text
167168rawLaTeXInline = do
168169 lookAhead (try (char '\\' >> letter))
169170 inp <- getInput
170− let toks = tokenize "source" inp
171+ let toks = tokenizeSources inp
171172 raw <- snd <$>
172173 ( rawLaTeXParser toks True
173− (mempty <$ (controlSeq "input" >> skipMany opt >> braced))
174+ (mempty <$ (controlSeq "input" >> skipMany rawopt >> braced))
174175 inlines
175176 <|> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')
176177 inlines
@@ -178,11 +179,11 @@ rawLaTeXInline = do
178179 finalbraces <- mconcat <$> many (try (string "{}")) -- see #5439
179180 return $ raw <> T.pack finalbraces
180181
181−inlineCommand :: PandocMonad m => ParserT Text ParserState m Inlines
182+inlineCommand :: PandocMonad m => ParserT Sources ParserState m Inlines
182183inlineCommand = do
183184 lookAhead (try (char '\\' >> letter))
184185 inp <- getInput
185− let toks = tokenize "source" inp
186+ let toks = tokenizeSources inp
186187 fst <$> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')
187188 inlines
188189
@@ -191,12 +192,6 @@ inlineCommand = do
191192word :: PandocMonad m => LP m Inlines
192193word = str . untoken <$> satisfyTok isWordTok
193194
194−regularSymbol :: PandocMonad m => LP m Inlines
195−regularSymbol = str . untoken <$> satisfyTok isRegularSymbol
196− where isRegularSymbol (Tok _ Symbol t) = not $ T.any isSpecial t
197− isRegularSymbol _ = False
198− isSpecial c = c `Set.member` specialChars
199−
200195inlineGroup :: PandocMonad m => LP m Inlines
201196inlineGroup = do
202197 ils <- grouped inline
@@ -237,16 +232,6 @@ mkImage options (T.unpack -> src) = do
237232 _ -> return src
238233 return $ imageWith attr (T.pack src') "" alt
239234
240−doxspace :: PandocMonad m => LP m Inlines
241−doxspace =
242− (space <$ lookAhead (satisfyTok startsWithLetter)) <|> return mempty
243− where startsWithLetter (Tok _ Word t) =
244− case T.uncons t of
245− Just (c, _) | isLetter c -> True
246− _ -> False
247− startsWithLetter _ = False
248−
249−
250235removeDoubleQuotes :: Text -> Text
251236removeDoubleQuotes t =
252237 Data.Maybe.fromMaybe t $ T.stripPrefix "\"" t >>= T.stripSuffix "\""
@@ -296,23 +281,11 @@ quoted' f starter ender = do
296281lit :: Text -> LP m Inlines
297282lit = pure . str
298283
299−enquote :: PandocMonad m => Bool -> Maybe Text -> LP m Inlines
300−enquote starred mblang = do
301− skipopts
302− let lang = mblang >>= babelLangToBCP47
303− let langspan = case lang of
304− Nothing -> id
305− Just l -> spanWith ("",[],[("lang", renderLang l)])
306− quoteContext <- sQuoteContext <$> getState
307− if starred || quoteContext == InDoubleQuote
308− then singleQuoted . langspan <$> withQuoteContext InSingleQuote tok
309− else doubleQuoted . langspan <$> withQuoteContext InDoubleQuote tok
310−
311284blockquote :: PandocMonad m => Bool -> Maybe Text -> LP m Blocks
312285blockquote cvariant mblang = do
313286 citepar <- if cvariant
314287 then (\xs -> para (cite xs mempty))
315− <$> cites NormalCitation False
288+ <$> cites inline NormalCitation False
316289 else option mempty $ para <$> bracketed inline
317290 let lang = mblang >>= babelLangToBCP47
318291 let langdiv = case lang of
@@ -323,224 +296,13 @@ blockquote cvariant mblang = do
323296 optional $ symbolIn (".:;?!" :: [Char]) -- currently ignored
324297 return $ blockQuote . langdiv $ (bs <> citepar)
325298
326−doAcronym :: PandocMonad m => Text -> LP m Inlines
327−doAcronym form = do
328− acro <- braced
329− return . mconcat $ [spanWith ("",[],[("acronym-label", untokenize acro),
330− ("acronym-form", "singular+" <> form)])
331− $ str $ untokenize acro]
332−
333−doAcronymPlural :: PandocMonad m => Text -> LP m Inlines
334−doAcronymPlural form = do
335− acro <- braced
336− plural <- lit "s"
337− return . mconcat $ [spanWith ("",[],[("acronym-label", untokenize acro),
338− ("acronym-form", "plural+" <> form)]) $
339− mconcat [str $ untokenize acro, plural]]
340−
341−doverb :: PandocMonad m => LP m Inlines
342−doverb = do
343− Tok _ Symbol t <- anySymbol
344− marker <- case T.uncons t of
345− Just (c, ts) | T.null ts -> return c
346− _ -> mzero
347− withVerbatimMode $
348− code . untokenize <$>
349− manyTill (notFollowedBy newlineTok >> verbTok marker) (symbol marker)
350−
351−verbTok :: PandocMonad m => Char -> LP m Tok
352−verbTok stopchar = do
353− t@(Tok pos toktype txt) <- anyTok
354− case T.findIndex (== stopchar) txt of
355− Nothing -> return t
356− Just i -> do
357− let (t1, t2) = T.splitAt i txt
358− inp <- getInput
359− setInput $ Tok (incSourceColumn pos i) Symbol (T.singleton stopchar)
360− : totoks (incSourceColumn pos (i + 1)) (T.drop 1 t2) ++ inp
361− return $ Tok pos toktype t1
362−
363−listingsLanguage :: [(Text, Text)] -> Maybe Text
364−listingsLanguage opts =
365− case lookup "language" opts of
366− Nothing -> Nothing
367− Just l -> fromListingsLanguage l `mplus` Just l
368−
369−dolstinline :: PandocMonad m => LP m Inlines
370−dolstinline = do
371− options <- option [] keyvals
372− let classes = maybeToList $ listingsLanguage options
373− doinlinecode classes
374−
375−domintinline :: PandocMonad m => LP m Inlines
376−domintinline = do
377− skipopts
378− cls <- untokenize <$> braced
379− doinlinecode [cls]
380−
381−doinlinecode :: PandocMonad m => [Text] -> LP m Inlines
382−doinlinecode classes = do
383− Tok _ Symbol t <- anySymbol
384− marker <- case T.uncons t of
385− Just (c, ts) | T.null ts -> return c
386− _ -> mzero
387− let stopchar = if marker == '{' then '}' else marker
388− withVerbatimMode $
389− codeWith ("",classes,[]) . T.map nlToSpace . untokenize <$>
390− manyTill (verbTok stopchar) (symbol stopchar)
391−
392−nlToSpace :: Char -> Char
393−nlToSpace '\n' = ' '
394−nlToSpace x = x
395−
396−mathDisplay :: Text -> Inlines
397−mathDisplay = displayMath . trimMath
398−
399−mathInline :: Text -> Inlines
400−mathInline = math . trimMath
401−
402−dollarsMath :: PandocMonad m => LP m Inlines
403−dollarsMath = do
404− symbol '$'
405− display <- option False (True <$ symbol '$')
406− (do contents <- try $ untokenize <$> pDollarsMath 0
407− if display
408− then mathDisplay contents <$ symbol '$'
409− else return $ mathInline contents)
410− <|> (guard display >> return (mathInline ""))
411−
412−-- Int is number of embedded groupings
413−pDollarsMath :: PandocMonad m => Int -> LP m [Tok]
414−pDollarsMath n = do
415− tk@(Tok _ toktype t) <- anyTok
416− case toktype of
417− Symbol | t == "$"
418− , n == 0 -> return []
419− | t == "\\" -> do
420− tk' <- anyTok
421− (tk :) . (tk' :) <$> pDollarsMath n
422− | t == "{" -> (tk :) <$> pDollarsMath (n+1)
423− | t == "}" ->
424− if n > 0
425− then (tk :) <$> pDollarsMath (n-1)
426− else mzero
427− _ -> (tk :) <$> pDollarsMath n
428−
429−-- citations
430−
431−addPrefix :: [Inline] -> [Citation] -> [Citation]
432−addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
433−addPrefix _ _ = []
434−
435−addSuffix :: [Inline] -> [Citation] -> [Citation]
436−addSuffix s ks@(_:_) =
437− let k = last ks
438− in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
439−addSuffix _ _ = []
440−
441−simpleCiteArgs :: PandocMonad m => LP m [Citation]
442−simpleCiteArgs = try $ do
443− first <- optionMaybe $ toList <$> opt
444− second <- optionMaybe $ toList <$> opt
445− keys <- try $ bgroup *> manyTill citationLabel egroup
446− let (pre, suf) = case (first , second ) of
447− (Just s , Nothing) -> (mempty, s )
448− (Just s , Just t ) -> (s , t )
449− _ -> (mempty, mempty)
450− conv k = Citation { citationId = k
451− , citationPrefix = []
452− , citationSuffix = []
453− , citationMode = NormalCitation
454− , citationHash = 0
455− , citationNoteNum = 0
456− }
457− return $ addPrefix pre $ addSuffix suf $ map conv keys
458−
459−citationLabel :: PandocMonad m => LP m Text
460−citationLabel = do
461− sp
462− untokenize <$>
463− (many1 (satisfyTok isWordTok <|> symbolIn bibtexKeyChar)
464− <* sp
465− <* optional (symbol ',')
466− <* sp)
467− where bibtexKeyChar = ".:;?!`'()/*@_+=-&[]" :: [Char]
468−
469−cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
470−cites mode multi = try $ do
471− cits <- if multi
472− then do
473− multiprenote <- optionMaybe $ toList <$> paropt
474− multipostnote <- optionMaybe $ toList <$> paropt
475− let (pre, suf) = case (multiprenote, multipostnote) of
476− (Just s , Nothing) -> (mempty, s)
477− (Nothing , Just t) -> (mempty, t)
478− (Just s , Just t ) -> (s, t)
479− _ -> (mempty, mempty)
480− tempCits <- many1 simpleCiteArgs
481− case tempCits of
482− (k:ks) -> case ks of
483− (_:_) -> return $ (addMprenote pre k : init ks) ++
484− [addMpostnote suf (last ks)]
485− _ -> return [addMprenote pre (addMpostnote suf k)]
486− _ -> return [[]]
487− else count 1 simpleCiteArgs
488− let cs = concat cits
489− return $ case mode of
490− AuthorInText -> case cs of
491− (c:rest) -> c {citationMode = mode} : rest
492− [] -> []
493− _ -> map (\a -> a {citationMode = mode}) cs
494− where mprenote (k:ks) = (k:ks) ++ [Space]
495− mprenote _ = mempty
496− mpostnote (k:ks) = [Str ",", Space] ++ (k:ks)
497− mpostnote _ = mempty
498− addMprenote mpn (k:ks) =
499− let mpnfinal = case citationPrefix k of
500− (_:_) -> mprenote mpn
501− _ -> mpn
502− in addPrefix mpnfinal (k:ks)
503− addMprenote _ _ = []
504− addMpostnote = addSuffix . mpostnote
505−
506−citation :: PandocMonad m => Text -> CitationMode -> Bool -> LP m Inlines
507−citation name mode multi = do
508− (c,raw) <- withRaw $ cites mode multi
509− return $ cite c (rawInline "latex" $ "\\" <> name <> untokenize raw)
510−
511−handleCitationPart :: Inlines -> [Citation]
512−handleCitationPart ils =
513− let isCite Cite{} = True
514− isCite _ = False
515− (pref, rest) = break isCite (toList ils)
516− in case rest of
517− (Cite cs _:suff) -> addPrefix pref $ addSuffix suff cs
518− _ -> []
519−
520−complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
521−complexNatbibCitation mode = try $ do
522− (cs, raw) <-
523− withRaw $ concat <$> do
524− bgroup
525− items <- mconcat <$>
526− many1 (notFollowedBy (symbol ';') >> inline)
527− `sepBy1` symbol ';'
528− egroup
529− return $ map handleCitationPart items
530− case cs of
531− [] -> mzero
532− (c:cits) -> return $ cite (c{ citationMode = mode }:cits)
533− (rawInline "latex" $ "\\citetext" <> untokenize raw)
534−
535−inNote :: Inlines -> Inlines
536−inNote ils =
537− note $ para $ ils <> str "."
538−
539299inlineCommand' :: PandocMonad m => LP m Inlines
540300inlineCommand' = try $ do
541301 Tok _ (CtrlSeq name) cmd <- anyControlSeq
542302 guard $ name /= "begin" && name /= "end" && name /= "and"
543− star <- option "" ("*" <$ symbol '*' <* sp)
303+ star <- if T.all isAlphaNum name
304+ then option "" ("*" <$ symbol '*' <* sp)
305+ else pure ""
544306 overlay <- option "" overlaySpecification
545307 let name' = name <> star <> overlay
546308 let names = ordNub [name', name] -- check non-starred as fallback
@@ -551,28 +313,8 @@ inlineCommand' = try $ do
551313 <|> ignore rawcommand
552314 lookupListDefault raw names inlineCommands
553315
554−
555316tok :: PandocMonad m => LP m Inlines
556−tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar'
557− where singleChar' = do
558− Tok _ _ t <- singleChar
559− return $ str t
560−
561−opt :: PandocMonad m => LP m Inlines
562−opt = do
563− toks <- try (sp *> bracketedToks <* sp)
564− -- now parse the toks as inlines
565− st <- getState
566− parsed <- runParserT (mconcat <$> many inline) st "bracketed option" toks
567− case parsed of
568− Right result -> return result
569− Left e -> throwError $ PandocParsecError (untokenize toks) e
570−
571−paropt :: PandocMonad m => LP m Inlines
572−paropt = parenWrapped inline
573−
574−inBrackets :: Inlines -> Inlines
575−inBrackets x = str "[" <> x <> str "]"
317+tok = tokWith inline
576318
577319unescapeURL :: Text -> Text
578320unescapeURL = T.concat . go . T.splitOn "\\"
@@ -585,345 +327,107 @@ unescapeURL = T.concat . go . T.splitOn "\\"
585327 , isEscapable c = t
586328 | otherwise = "\\" <> t
587329
588−mathEnvWith :: PandocMonad m
589− => (Inlines -> a) -> Maybe Text -> Text -> LP m a
590−mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name
591− where inner x = case innerEnv of
592− Nothing -> x
593− Just y -> "\\begin{" <> y <> "}\n" <> x <>
594− "\\end{" <> y <> "}"
595−
596−mathEnv :: PandocMonad m => Text -> LP m Text
597−mathEnv name = do
598− skipopts
599− optional blankline
600− res <- manyTill anyTok (end_ name)
601− return $ stripTrailingNewlines $ untokenize res
602−
603−inlineEnvironment :: PandocMonad m => LP m Inlines
604−inlineEnvironment = try $ do
605− controlSeq "begin"
606− name <- untokenize <$> braced
607− M.findWithDefault mzero name inlineEnvironments
608−
609−inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)
610−inlineEnvironments = M.fromList [
611− ("displaymath", mathEnvWith id Nothing "displaymath")
612− , ("math", math <$> mathEnv "math")
613− , ("equation", mathEnvWith id Nothing "equation")
614− , ("equation*", mathEnvWith id Nothing "equation*")
615− , ("gather", mathEnvWith id (Just "gathered") "gather")
616− , ("gather*", mathEnvWith id (Just "gathered") "gather*")
617− , ("multline", mathEnvWith id (Just "gathered") "multline")
618− , ("multline*", mathEnvWith id (Just "gathered") "multline*")
619− , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")
620− , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")
621− , ("align", mathEnvWith id (Just "aligned") "align")
622− , ("align*", mathEnvWith id (Just "aligned") "align*")
623− , ("alignat", mathEnvWith id (Just "aligned") "alignat")
624− , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
625− , ("dmath", mathEnvWith id Nothing "dmath")
626− , ("dmath*", mathEnvWith id Nothing "dmath*")
627− , ("dgroup", mathEnvWith id (Just "aligned") "dgroup")
628− , ("dgroup*", mathEnvWith id (Just "aligned") "dgroup*")
629− , ("darray", mathEnvWith id (Just "aligned") "darray")
630− , ("darray*", mathEnvWith id (Just "aligned") "darray*")
631− ]
632−
633330inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
634−inlineCommands =
635− M.union inlineLanguageCommands $
636− M.union (accentCommands tok) $
637− M.fromList
638− [ ("emph", extractSpaces emph <$> tok)
639− , ("textit", extractSpaces emph <$> tok)
640− , ("textsl", extractSpaces emph <$> tok)
641− , ("textsc", extractSpaces smallcaps <$> tok)
642− , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)
643− , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)
644− , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)
645− , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)
646− , ("texttt", ttfamily)
647− , ("sout", extractSpaces strikeout <$> tok)
648− , ("alert", skipopts >> spanWith ("",["alert"],[]) <$> tok) -- beamer
649− , ("lq", return (str "‘"))
650− , ("rq", return (str "’"))
651− , ("textquoteleft", return (str "‘"))
652− , ("textquoteright", return (str "’"))
653− , ("textquotedblleft", return (str "“"))
654− , ("textquotedblright", return (str "”"))
655− , ("textsuperscript", extractSpaces superscript <$> tok)
656− , ("textsubscript", extractSpaces subscript <$> tok)
657− , ("textbackslash", lit "\\")
658− , ("backslash", lit "\\")
659− , ("slash", lit "/")
660− , ("textbf", extractSpaces strong <$> tok)
661− , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)
662− , ("underline", underline <$> tok)
663− , ("ldots", lit "…")
664− , ("vdots", lit "\8942")
665− , ("dots", lit "…")
666− , ("mdots", lit "…")
667− , ("sim", lit "~")
668− , ("sep", lit ",")
669− , ("label", rawInlineOr "label" dolabel)
670− , ("ref", rawInlineOr "ref" $ doref "ref")
671− , ("cref", rawInlineOr "cref" $ doref "ref") -- from cleveref.sty
672− , ("vref", rawInlineOr "vref" $ doref "ref+page") -- from varioref.sty
673− , ("eqref", rawInlineOr "eqref" $ doref "eqref") -- from amsmath.sty
674− , ("mbox", rawInlineOr "mbox" $ processHBox <$> tok)
675− , ("hbox", rawInlineOr "hbox" $ processHBox <$> tok)
676− , ("lettrine", rawInlineOr "lettrine" lettrine)
677− , ("(", mathInline . untokenize <$> manyTill anyTok (controlSeq ")"))
678− , ("[", mathDisplay . untokenize <$> manyTill anyTok (controlSeq "]"))
679− , ("ensuremath", mathInline . untokenize <$> braced)
680− , ("texorpdfstring", const <$> tok <*> tok)
681− , ("P", lit "¶")
682− , ("S", lit "§")
683− , ("$", lit "$")
684− , ("%", lit "%")
685− , ("&", lit "&")
686− , ("#", lit "#")
687− , ("_", lit "_")
688− , ("{", lit "{")
689− , ("}", lit "}")
690− , ("qed", lit "\a0\x25FB")
691− -- old TeX commands
692− , ("em", extractSpaces emph <$> inlines)
693− , ("it", extractSpaces emph <$> inlines)
694− , ("sl", extractSpaces emph <$> inlines)
695− , ("bf", extractSpaces strong <$> inlines)
696− , ("tt", code . stringify . toList <$> inlines)
697− , ("rm", inlines)
698− , ("itshape", extractSpaces emph <$> inlines)
699− , ("slshape", extractSpaces emph <$> inlines)
700− , ("scshape", extractSpaces smallcaps <$> inlines)
701− , ("bfseries", extractSpaces strong <$> inlines)
702− , ("MakeUppercase", makeUppercase <$> tok)
703− , ("MakeTextUppercase", makeUppercase <$> tok) -- textcase
704− , ("uppercase", makeUppercase <$> tok)
705− , ("MakeLowercase", makeLowercase <$> tok)
706− , ("MakeTextLowercase", makeLowercase <$> tok)
707− , ("lowercase", makeLowercase <$> tok)
708− , ("/", pure mempty) -- italic correction
709− , ("\\", linebreak <$ (do inTableCell <- sInTableCell <$> getState
710− guard $ not inTableCell
711− optional opt
712− spaces))
713− , (",", lit "\8198")
714− , ("@", pure mempty)
715− , (" ", lit "\160")
716− , ("ps", pure $ str "PS." <> space)
717− , ("TeX", lit "TeX")
718− , ("LaTeX", lit "LaTeX")
719− , ("bar", lit "|")
720− , ("textless", lit "<")
721− , ("textgreater", lit ">")
722− , ("thanks", skipopts >> note <$> grouped block)
723− , ("footnote", skipopts >> note <$> grouped block)
724− , ("passthrough", tok) -- \passthrough macro used by latex writer
725− -- for listings
726− , ("verb", doverb)
727− , ("lstinline", dolstinline)
728− , ("mintinline", domintinline)
729− , ("Verb", doverb)
730− , ("url", (\url -> link url "" (str url)) . unescapeURL . untokenize <$>
731− bracedUrl)
732− , ("nolinkurl", code . unescapeURL . untokenize <$> bracedUrl)
733− , ("href", do url <- bracedUrl
734− sp
735− link (unescapeURL $ untokenize url) "" <$> tok)
736− , ("includegraphics", do options <- option [] keyvals
737− src <- braced
738− mkImage options . unescapeURL . removeDoubleQuotes $
739− untokenize src)
740− , ("enquote*", enquote True Nothing)
741− , ("enquote", enquote False Nothing)
742− -- foreignquote is supposed to use native quote marks
743− , ("foreignquote*", braced >>= enquote True . Just . untokenize)
744− , ("foreignquote", braced >>= enquote False . Just . untokenize)
745− -- hypehnquote uses regular quotes
746− , ("hyphenquote*", braced >>= enquote True . Just . untokenize)
747− , ("hyphenquote", braced >>= enquote False . Just . untokenize)
748− , ("figurename", doTerm Translations.Figure)
749− , ("prefacename", doTerm Translations.Preface)
750− , ("refname", doTerm Translations.References)
751− , ("bibname", doTerm Translations.Bibliography)
752− , ("chaptername", doTerm Translations.Chapter)
753− , ("partname", doTerm Translations.Part)
754− , ("contentsname", doTerm Translations.Contents)
755− , ("listfigurename", doTerm Translations.ListOfFigures)
756− , ("listtablename", doTerm Translations.ListOfTables)
757− , ("indexname", doTerm Translations.Index)
758− , ("abstractname", doTerm Translations.Abstract)
759− , ("tablename", doTerm Translations.Table)
760− , ("enclname", doTerm Translations.Encl)
761− , ("ccname", doTerm Translations.Cc)
762− , ("headtoname", doTerm Translations.To)
763− , ("pagename", doTerm Translations.Page)
764− , ("seename", doTerm Translations.See)
765− , ("seealsoname", doTerm Translations.SeeAlso)
766− , ("proofname", doTerm Translations.Proof)
767− , ("glossaryname", doTerm Translations.Glossary)
768− , ("lstlistingname", doTerm Translations.Listing)
769− , ("cite", citation "cite" NormalCitation False)
770− , ("Cite", citation "Cite" NormalCitation False)
771− , ("citep", citation "citep" NormalCitation False)
772− , ("citep*", citation "citep*" NormalCitation False)
773− , ("citeal", citation "citeal" NormalCitation False)
774− , ("citealp", citation "citealp" NormalCitation False)
775− , ("citealp*", citation "citealp*" NormalCitation False)
776− , ("autocite", citation "autocite" NormalCitation False)
777− , ("smartcite", citation "smartcite" NormalCitation False)
778− , ("footcite", inNote <$> citation "footcite" NormalCitation False)
779− , ("parencite", citation "parencite" NormalCitation False)
780− , ("supercite", citation "supercite" NormalCitation False)
781− , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)
782− , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)
783− , ("citeyear", citation "citeyear" SuppressAuthor False)
784− , ("autocite*", citation "autocite*" SuppressAuthor False)
785− , ("cite*", citation "cite*" SuppressAuthor False)
786− , ("parencite*", citation "parencite*" SuppressAuthor False)
787− , ("textcite", citation "textcite" AuthorInText False)
788− , ("citet", citation "citet" AuthorInText False)
789− , ("citet*", citation "citet*" AuthorInText False)
790− , ("citealt", citation "citealt" AuthorInText False)
791− , ("citealt*", citation "citealt*" AuthorInText False)
792− , ("textcites", citation "textcites" AuthorInText True)
793− , ("cites", citation "cites" NormalCitation True)
794− , ("autocites", citation "autocites" NormalCitation True)
795− , ("footcites", inNote <$> citation "footcites" NormalCitation True)
796− , ("parencites", citation "parencites" NormalCitation True)
797− , ("supercites", citation "supercites" NormalCitation True)
798− , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)
799− , ("Autocite", citation "Autocite" NormalCitation False)
800− , ("Smartcite", citation "Smartcite" NormalCitation False)
801− , ("Footcite", inNote <$> citation "Footcite" NormalCitation False)
802− , ("Parencite", citation "Parencite" NormalCitation False)
803− , ("Supercite", citation "Supercite" NormalCitation False)
804− , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)
805− , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)
806− , ("Citeyear", citation "Citeyear" SuppressAuthor False)
807− , ("Autocite*", citation "Autocite*" SuppressAuthor False)
808− , ("Cite*", citation "Cite*" SuppressAuthor False)
809− , ("Parencite*", citation "Parencite*" SuppressAuthor False)
810− , ("Textcite", citation "Textcite" AuthorInText False)
811− , ("Textcites", citation "Textcites" AuthorInText True)
812− , ("Cites", citation "Cites" NormalCitation True)
813− , ("Autocites", citation "Autocites" NormalCitation True)
814− , ("Footcites", inNote <$> citation "Footcites" NormalCitation True)
815− , ("Parencites", citation "Parencites" NormalCitation True)
816− , ("Supercites", citation "Supercites" NormalCitation True)
817− , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)
818− , ("citetext", complexNatbibCitation NormalCitation)
819− , ("citeauthor", (try (tok *> sp *> controlSeq "citetext") *>
820− complexNatbibCitation AuthorInText)
821− <|> citation "citeauthor" AuthorInText False)
822− , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
823− addMeta "nocite"))
824− , ("hyperlink", hyperlink)
825− , ("hypertarget", hypertargetInline)
826− -- glossaries package
827− , ("gls", doAcronym "short")
828− , ("Gls", doAcronym "short")
829− , ("glsdesc", doAcronym "long")
830− , ("Glsdesc", doAcronym "long")
831− , ("GLSdesc", doAcronym "long")
832− , ("acrlong", doAcronym "long")
833− , ("Acrlong", doAcronym "long")
834− , ("acrfull", doAcronym "full")
835− , ("Acrfull", doAcronym "full")
836− , ("acrshort", doAcronym "abbrv")
837− , ("Acrshort", doAcronym "abbrv")
838− , ("glspl", doAcronymPlural "short")
839− , ("Glspl", doAcronymPlural "short")
840− , ("glsdescplural", doAcronymPlural "long")
841− , ("Glsdescplural", doAcronymPlural "long")
842− , ("GLSdescplural", doAcronymPlural "long")
843− -- acronyms package
844− , ("ac", doAcronym "short")
845− , ("acf", doAcronym "full")
846− , ("acs", doAcronym "abbrv")
847− , ("acl", doAcronym "long")
848− , ("acp", doAcronymPlural "short")
849− , ("acfp", doAcronymPlural "full")
850− , ("acsp", doAcronymPlural "abbrv")
851− , ("aclp", doAcronymPlural "long")
852− , ("Ac", doAcronym "short")
853− , ("Acf", doAcronym "full")
854− , ("Acs", doAcronym "abbrv")
855− , ("Acl", doAcronym "long")
856− , ("Acp", doAcronymPlural "short")
857− , ("Acfp", doAcronymPlural "full")
858− , ("Acsp", doAcronymPlural "abbrv")
859− , ("Aclp", doAcronymPlural "long")
860− -- siuntix
861− , ("si", skipopts *> dosi tok)
862− , ("SI", doSI tok)
863− , ("SIrange", doSIrange True tok)
864− , ("numrange", doSIrange False tok)
865− , ("numlist", doSInumlist)
866− , ("num", doSInum)
867− , ("ang", doSIang)
868− -- hyphenat
869− , ("bshyp", lit "\\\173")
870− , ("fshyp", lit "/\173")
871− , ("dothyp", lit ".\173")
872− , ("colonhyp", lit ":\173")
873− , ("hyp", lit "-")
874− , ("nohyphens", tok)
875− , ("textnhtt", ttfamily)
876− , ("nhttfamily", ttfamily)
877− -- LaTeX colors
878− , ("textcolor", coloredInline "color")
879− , ("colorbox", coloredInline "background-color")
880− -- fontawesome
881− , ("faCheck", lit "\10003")
882− , ("faClose", lit "\10007")
883− -- xspace
884− , ("xspace", doxspace)
885− -- etoolbox
886− , ("ifstrequal", ifstrequal)
887− , ("newtoggle", braced >>= newToggle)
888− , ("toggletrue", braced >>= setToggle True)
889− , ("togglefalse", braced >>= setToggle False)
890− , ("iftoggle", try $ ifToggle >> inline)
891− -- biblatex misc
892− , ("RN", romanNumeralUpper)
893− , ("Rn", romanNumeralLower)
894− -- babel
895− , ("foreignlanguage", foreignlanguage)
896− -- include
897− , ("input", rawInlineOr "input" $ include "input")
898− -- soul package
899− , ("ul", underline <$> tok)
900− -- ulem package
901− , ("uline", underline <$> tok)
902− -- plain tex stuff that should just be passed through as raw tex
903− , ("ifdim", ifdim)
904− -- bibtex
905− , ("mkbibquote", spanWith nullAttr . doubleQuoted <$> tok)
906− , ("mkbibemph", spanWith nullAttr . emph <$> tok)
907− , ("mkbibitalic", spanWith nullAttr . emph <$> tok)
908− , ("mkbibbold", spanWith nullAttr . strong <$> tok)
909− , ("mkbibparens",
910− spanWith nullAttr . (\x -> str "(" <> x <> str ")") <$> tok)
911− , ("mkbibbrackets",
912− spanWith nullAttr . (\x -> str "[" <> x <> str "]") <$> tok)
913− , ("autocap", spanWith nullAttr <$> tok)
914− , ("textnormal", spanWith ("",["nodecor"],[]) <$> tok)
915− , ("bibstring",
916− (\x -> spanWith ("",[],[("bibstring",x)]) (str x)) . untokenize
917− <$> braced)
918− , ("adddot", pure (str "."))
919− , ("adddotspace", pure (spanWith nullAttr (str "." <> space)))
920− , ("addabbrvspace", pure space)
921− , ("hyphen", pure (str "-"))
922− ]
331+inlineCommands = M.unions
332+ [ accentCommands tok
333+ , citationCommands inline
334+ , siunitxCommands tok
335+ , acronymCommands
336+ , refCommands
337+ , nameCommands
338+ , verbCommands
339+ , charCommands
340+ , enquoteCommands tok
341+ , inlineLanguageCommands tok
342+ , biblatexInlineCommands tok
343+ , rest ]
344+ where
345+ rest = M.fromList
346+ [ ("emph", extractSpaces emph <$> tok)
347+ , ("textit", extractSpaces emph <$> tok)
348+ , ("textsl", extractSpaces emph <$> tok)
349+ , ("textsc", extractSpaces smallcaps <$> tok)
350+ , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)
351+ , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)
352+ , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)
353+ , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)
354+ , ("texttt", ttfamily)
355+ , ("sout", extractSpaces strikeout <$> tok)
356+ , ("alert", skipopts >> spanWith ("",["alert"],[]) <$> tok) -- beamer
357+ , ("textsuperscript", extractSpaces superscript <$> tok)
358+ , ("textsubscript", extractSpaces subscript <$> tok)
359+ , ("textbf", extractSpaces strong <$> tok)
360+ , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)
361+ , ("underline", underline <$> tok)
362+ , ("mbox", rawInlineOr "mbox" $ processHBox <$> tok)
363+ , ("hbox", rawInlineOr "hbox" $ processHBox <$> tok)
364+ , ("lettrine", rawInlineOr "lettrine" lettrine)
365+ , ("(", mathInline . untokenize <$> manyTill anyTok (controlSeq ")"))
366+ , ("[", mathDisplay . untokenize <$> manyTill anyTok (controlSeq "]"))
367+ , ("ensuremath", mathInline . untokenize <$> braced)
368+ , ("texorpdfstring", const <$> tok <*> tok)
369+ -- old TeX commands
370+ , ("em", extractSpaces emph <$> inlines)
371+ , ("it", extractSpaces emph <$> inlines)
372+ , ("sl", extractSpaces emph <$> inlines)
373+ , ("bf", extractSpaces strong <$> inlines)
374+ , ("tt", code . stringify . toList <$> inlines)
375+ , ("rm", inlines)
376+ , ("itshape", extractSpaces emph <$> inlines)
377+ , ("slshape", extractSpaces emph <$> inlines)
378+ , ("scshape", extractSpaces smallcaps <$> inlines)
379+ , ("bfseries", extractSpaces strong <$> inlines)
380+ , ("MakeUppercase", makeUppercase <$> tok)
381+ , ("MakeTextUppercase", makeUppercase <$> tok) -- textcase
382+ , ("uppercase", makeUppercase <$> tok)
383+ , ("MakeLowercase", makeLowercase <$> tok)
384+ , ("MakeTextLowercase", makeLowercase <$> tok)
385+ , ("lowercase", makeLowercase <$> tok)
386+ , ("thanks", skipopts >> note <$> grouped block)
387+ , ("footnote", skipopts >> note <$> grouped block)
388+ , ("passthrough", tok) -- \passthrough macro used by latex writer
389+ -- for listings
390+ , ("includegraphics", do options <- option [] keyvals
391+ src <- braced
392+ mkImage options .
393+ unescapeURL .
394+ removeDoubleQuotes $ untokenize src)
395+ -- hyperref
396+ , ("url", (\url -> link url "" (str url)) . unescapeURL . untokenize <$>
397+ bracedUrl)
398+ , ("nolinkurl", code . unescapeURL . untokenize <$> bracedUrl)
399+ , ("href", do url <- bracedUrl
400+ sp
401+ link (unescapeURL $ untokenize url) "" <$> tok)
402+ , ("hyperlink", hyperlink)
403+ , ("hyperref", hyperref)
404+ , ("hypertarget", hypertargetInline)
405+ -- hyphenat
406+ , ("nohyphens", tok)
407+ , ("textnhtt", ttfamily)
408+ , ("nhttfamily", ttfamily)
409+ -- LaTeX colors
410+ , ("textcolor", coloredInline "color")
411+ , ("colorbox", coloredInline "background-color")
412+ -- etoolbox
413+ , ("ifstrequal", ifstrequal)
414+ , ("newtoggle", braced >>= newToggle)
415+ , ("toggletrue", braced >>= setToggle True)
416+ , ("togglefalse", braced >>= setToggle False)
417+ , ("iftoggle", try $ ifToggle >> inline)
418+ -- include
419+ , ("input", rawInlineOr "input" $ include "input")
420+ -- soul package
421+ , ("ul", underline <$> tok)
422+ -- ulem package
423+ , ("uline", underline <$> tok)
424+ -- plain tex stuff that should just be passed through as raw tex
425+ , ("ifdim", ifdim)
426+ ]
923427
924428lettrine :: PandocMonad m => LP m Inlines
925429lettrine = do
926− optional opt
430+ optional rawopt
927431 x <- tok
928432 y <- tok
929433 return $ extractSpaces (spanWith ("",["lettrine"],[])) x <> smallcaps y
@@ -943,32 +447,18 @@ alterStr :: (Text -> Text) -> Inline -> Inline
943447alterStr f (Str xs) = Str (f xs)
944448alterStr _ x = x
945449
946−foreignlanguage :: PandocMonad m => LP m Inlines
947−foreignlanguage = do
948− babelLang <- untokenize <$> braced
949− case babelLangToBCP47 babelLang of
950− Just lang -> spanWith ("", [], [("lang", renderLang lang)]) <$> tok
951− _ -> tok
952−
953−inlineLanguageCommands :: PandocMonad m => M.Map Text (LP m Inlines)
954−inlineLanguageCommands = M.fromList $ mk <$> M.toList polyglossiaLangToBCP47
955− where
956− mk (polyglossia, bcp47Func) =
957− ("text" <> polyglossia, inlineLanguage bcp47Func)
958−
959−inlineLanguage :: PandocMonad m => (Text -> Lang) -> LP m Inlines
960−inlineLanguage bcp47Func = do
961− o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')
962− <$> rawopt
963− let lang = renderLang $ bcp47Func o
964− extractSpaces (spanWith ("", [], [("lang", lang)])) <$> tok
965−
966450hyperlink :: PandocMonad m => LP m Inlines
967451hyperlink = try $ do
968452 src <- untokenize <$> braced
969453 lab <- tok
970454 return $ link ("#" <> src) "" lab
971455
456+hyperref :: PandocMonad m => LP m Inlines
457+hyperref = try $ do
458+ url <- (("#" <>) . untokenize <$> try (sp *> bracketedToks <* sp))
459+ <|> untokenize <$> (bracedUrl <* bracedUrl <* bracedUrl)
460+ link url "" <$> tok
461+
972462hypertargetBlock :: PandocMonad m => LP m Blocks
973463hypertargetBlock = try $ do
974464 ref <- untokenize <$> braced
@@ -983,31 +473,6 @@ hypertargetInline = try $ do
983473 ils <- grouped inline
984474 return $ spanWith (ref, [], []) ils
985475
986−romanNumeralUpper :: (PandocMonad m) => LP m Inlines
987−romanNumeralUpper =
988− str . toRomanNumeral <$> romanNumeralArg
989−
990−romanNumeralLower :: (PandocMonad m) => LP m Inlines
991−romanNumeralLower =
992− str . T.toLower . toRomanNumeral <$> romanNumeralArg
993−
994−romanNumeralArg :: (PandocMonad m) => LP m Int
995−romanNumeralArg = spaces *> (parser <|> inBraces)
996− where
997− inBraces = do
998− symbol '{'
999− spaces
1000− res <- parser
1001− spaces
1002− symbol '}'
1003− return res
1004− parser = do
1005− s <- untokenize <$> many1 (satisfyTok isWordTok)
1006− let (digits, rest) = T.span isDigit s
1007− unless (T.null rest) $
1008− Prelude.fail "Non-digits in argument to \\Rn or \\RN"
1009− safeRead digits
1010−
1011476newToggle :: (Monoid a, PandocMonad m) => [Tok] -> LP m a
1012477newToggle name = do
1013478 updateState $ \st ->
@@ -1038,9 +503,6 @@ ifToggle = do
1038503 report $ UndefinedToggle name' pos
1039504 return ()
1040505
1041−doTerm :: PandocMonad m => Translations.Term -> LP m Inlines
1042−doTerm term = str <$> translateTerm term
1043−
1044506ifstrequal :: (PandocMonad m, Monoid a) => LP m a
1045507ifstrequal = do
1046508 str1 <- tok
@@ -1061,13 +523,6 @@ coloredInline stylename = do
1061523ttfamily :: PandocMonad m => LP m Inlines
1062524ttfamily = code . stringify . toList <$> tok
1063525
1064−rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines
1065−rawInlineOr name' fallback = do
1066− parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
1067− if parseRaw
1068− then rawInline "latex" <$> getRawCommand name' ("\\" <> name')
1069− else fallback
1070−
1071526processHBox :: Inlines -> Inlines
1072527processHBox = walk convert
1073528 where
@@ -1118,67 +573,67 @@ treatAsInline = Set.fromList
1118573 , "pagebreak"
1119574 ]
1120575
1121−label :: PandocMonad m => LP m ()
1122−label = do
1123− controlSeq "label"
1124− t <- braced
1125− updateState $ \st -> st{ sLastLabel = Just $ untokenize t }
1126−
1127−dolabel :: PandocMonad m => LP m Inlines
1128−dolabel = do
1129− v <- braced
1130− let refstr = untokenize v
1131− updateState $ \st ->
1132− st{ sLastLabel = Just refstr }
1133− return $ spanWith (refstr,[],[("label", refstr)])
1134− $ inBrackets $ str $ untokenize v
1135−
1136−doref :: PandocMonad m => Text -> LP m Inlines
1137−doref cls = do
1138− v <- braced
1139− let refstr = untokenize v
1140− return $ linkWith ("",[],[ ("reference-type", cls)
1141− , ("reference", refstr)])
1142− ("#" <> refstr)
1143− ""
1144− (inBrackets $ str refstr)
1145−
1146576lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
1147577lookupListDefault d = (fromMaybe d .) . lookupList
1148578 where lookupList l m = msum $ map (`M.lookup` m) l
1149579
1150580inline :: PandocMonad m => LP m Inlines
1151−inline = (mempty <$ comment)
1152− <|> (space <$ whitespace)
1153− <|> (softbreak <$ endline)
1154− <|> word
1155− <|> macroDef (rawInline "latex")
1156− <|> inlineCommand'
1157− <|> inlineEnvironment
1158− <|> inlineGroup
1159− <|> (symbol '-' *>
1160− option (str "-") (symbol '-' *>
1161− option (str "–") (str "—" <$ symbol '-')))
1162− <|> doubleQuote
1163− <|> singleQuote
1164− <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
1165− <|> (str "”" <$ symbol '”')
1166− <|> (str "’" <$ symbol '\'')
1167− <|> (str "’" <$ symbol '’')
1168− <|> (str "\160" <$ symbol '~')
1169− <|> dollarsMath
1170− <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
1171− <|> (str . T.singleton <$> primEscape)
1172− <|> regularSymbol
1173− <|> (do res <- symbolIn "#^'`\"[]&"
1174− pos <- getPosition
1175− let s = untoken res
1176− report $ ParsingUnescaped s pos
1177− return $ str s)
581+inline = do
582+ Tok pos toktype t <- lookAhead anyTok
583+ let symbolAsString = str . untoken <$> anySymbol
584+ let unescapedSymbolAsString =
585+ do s <- untoken <$> anySymbol
586+ report $ ParsingUnescaped s pos
587+ return $ str s
588+ case toktype of
589+ Comment -> mempty <$ comment
590+ Spaces -> space <$ whitespace
591+ Newline -> softbreak <$ endline
592+ Word -> word
593+ Esc1 -> str . T.singleton <$> primEscape
594+ Esc2 -> str . T.singleton <$> primEscape
595+ Symbol ->
596+ case t of
597+ "-" -> symbol '-' *>
598+ option (str "-") (symbol '-' *>
599+ option (str "–") (str "—" <$ symbol '-'))
600+ "'" -> symbol '\'' *>
601+ option (str "’") (str "”" <$ symbol '\'')
602+ "~" -> str "\160" <$ symbol '~'
603+ "`" -> doubleQuote <|> singleQuote <|> symbolAsString
604+ "\"" -> doubleQuote <|> singleQuote <|> symbolAsString
605+ "“" -> doubleQuote <|> symbolAsString
606+ "‘" -> singleQuote <|> symbolAsString
607+ "$" -> dollarsMath <|> unescapedSymbolAsString
608+ "|" -> (guardEnabled Ext_literate_haskell *>
609+ symbol '|' *> doLHSverb) <|> symbolAsString
610+ "{" -> inlineGroup
611+ "#" -> unescapedSymbolAsString
612+ "&" -> unescapedSymbolAsString
613+ "_" -> unescapedSymbolAsString
614+ "^" -> unescapedSymbolAsString
615+ "\\" -> mzero
616+ "}" -> mzero
617+ _ -> symbolAsString
618+ CtrlSeq _ -> macroDef (rawInline "latex")
619+ <|> inlineCommand'
620+ <|> inlineEnvironment
621+ <|> inlineGroup
622+ _ -> mzero
1178623
1179624inlines :: PandocMonad m => LP m Inlines
1180625inlines = mconcat <$> many inline
1181626
627+opt :: PandocMonad m => LP m Inlines
628+opt = do
629+ toks <- try (sp *> bracketedToks <* sp)
630+ -- now parse the toks as inlines
631+ st <- getState
632+ parsed <- runParserT (mconcat <$> many inline) st "bracketed option" toks
633+ case parsed of
634+ Right result -> return result
635+ Left e -> throwError $ PandocParsecError (toSources toks) e
636+
1182637-- block elements:
1183638
1184639preamble :: PandocMonad m => LP m Blocks
@@ -1272,10 +727,6 @@ insertIncluded defaultExtension f' = do
1272727 getInput >>= setInput . (tokenize f contents ++)
1273728 updateState dropLatestIncludeFile
1274729
1275−addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> LP m ()
1276−addMeta field val = updateState $ \st ->
1277− st{ sMeta = addMetaField field val $ sMeta st }
1278−
1279730authors :: PandocMonad m => LP m ()
1280731authors = try $ do
1281732 bgroup
@@ -1284,150 +735,6 @@ authors = try $ do
1284735 egroup
1285736 addMeta "author" (map trimInlines auths)
1286737
1287−macroDef :: (PandocMonad m, Monoid a) => (Text -> a) -> LP m a
1288−macroDef constructor = do
1289− (_, s) <- withRaw (commandDef <|> environmentDef)
1290− (constructor (untokenize s) <$
1291− guardDisabled Ext_latex_macros)
1292− <|> return mempty
1293− where commandDef = do
1294− (name, macro') <- newcommand <|> letmacro <|> defmacro
1295− guardDisabled Ext_latex_macros <|>
1296− updateState (\s -> s{ sMacros = M.insert name macro' (sMacros s) })
1297− environmentDef = do
1298− mbenv <- newenvironment
1299− case mbenv of
1300− Nothing -> return ()
1301− Just (name, macro1, macro2) ->
1302− guardDisabled Ext_latex_macros <|>
1303− do updateState $ \s -> s{ sMacros =
1304− M.insert name macro1 (sMacros s) }
1305− updateState $ \s -> s{ sMacros =
1306− M.insert ("end" <> name) macro2 (sMacros s) }
1307− -- @\newenvironment{envname}[n-args][default]{begin}{end}@
1308− -- is equivalent to
1309− -- @\newcommand{\envname}[n-args][default]{begin}@
1310− -- @\newcommand{\endenvname}@
1311−
1312−letmacro :: PandocMonad m => LP m (Text, Macro)
1313−letmacro = do
1314− controlSeq "let"
1315− (name, contents) <- withVerbatimMode $ do
1316− Tok _ (CtrlSeq name) _ <- anyControlSeq
1317− optional $ symbol '='
1318− spaces
1319− -- we first parse in verbatim mode, and then expand macros,
1320− -- because we don't want \let\foo\bar to turn into
1321− -- \let\foo hello if we have previously \def\bar{hello}
1322− contents <- bracedOrToken
1323− return (name, contents)
1324− contents' <- doMacros' 0 contents
1325− return (name, Macro ExpandWhenDefined [] Nothing contents')
1326−
1327−defmacro :: PandocMonad m => LP m (Text, Macro)
1328−defmacro = try $
1329− -- we use withVerbatimMode, because macros are to be expanded
1330− -- at point of use, not point of definition
1331− withVerbatimMode $ do
1332− controlSeq "def"
1333− Tok _ (CtrlSeq name) _ <- anyControlSeq
1334− argspecs <- many (argspecArg <|> argspecPattern)
1335− contents <- bracedOrToken
1336− return (name, Macro ExpandWhenUsed argspecs Nothing contents)
1337−
1338−argspecArg :: PandocMonad m => LP m ArgSpec
1339−argspecArg = do
1340− Tok _ (Arg i) _ <- satisfyTok isArgTok
1341− return $ ArgNum i
1342−
1343−argspecPattern :: PandocMonad m => LP m ArgSpec
1344−argspecPattern =
1345− Pattern <$> many1 (satisfyTok (\(Tok _ toktype' txt) ->
1346− (toktype' == Symbol || toktype' == Word) &&
1347− (txt /= "{" && txt /= "\\" && txt /= "}")))
1348−
1349−newcommand :: PandocMonad m => LP m (Text, Macro)
1350−newcommand = do
1351− pos <- getPosition
1352− Tok _ (CtrlSeq mtype) _ <- controlSeq "newcommand" <|>
1353− controlSeq "renewcommand" <|>
1354− controlSeq "providecommand" <|>
1355− controlSeq "DeclareMathOperator" <|>
1356− controlSeq "DeclareRobustCommand"
1357− withVerbatimMode $ do
1358− Tok _ (CtrlSeq name) txt <- do
1359− optional (symbol '*')
1360− anyControlSeq <|>
1361− (symbol '{' *> spaces *> anyControlSeq <* spaces <* symbol '}')
1362− spaces
1363− numargs <- option 0 $ try bracketedNum
1364− let argspecs = map ArgNum [1..numargs]
1365− spaces
1366− optarg <- option Nothing $ Just <$> try bracketedToks
1367− spaces
1368− contents' <- bracedOrToken
1369− let contents =
1370− case mtype of
1371− "DeclareMathOperator" ->
1372− Tok pos (CtrlSeq "mathop") "\\mathop"
1373− : Tok pos Symbol "{"
1374− : Tok pos (CtrlSeq "mathrm") "\\mathrm"
1375− : Tok pos Symbol "{"
1376− : (contents' ++
1377− [ Tok pos Symbol "}", Tok pos Symbol "}" ])
1378− _ -> contents'
1379− macros <- sMacros <$> getState
1380− case M.lookup name macros of
1381− Just macro
1382− | mtype == "newcommand" -> do
1383− report $ MacroAlreadyDefined txt pos
1384− return (name, macro)
1385− | mtype == "providecommand" -> return (name, macro)
1386− _ -> return (name, Macro ExpandWhenUsed argspecs optarg contents)
1387−
1388−newenvironment :: PandocMonad m => LP m (Maybe (Text, Macro, Macro))
1389−newenvironment = do
1390− pos <- getPosition
1391− Tok _ (CtrlSeq mtype) _ <- controlSeq "newenvironment" <|>
1392− controlSeq "renewenvironment" <|>
1393− controlSeq "provideenvironment"
1394− withVerbatimMode $ do
1395− optional $ symbol '*'
1396− spaces
1397− name <- untokenize <$> braced
1398− spaces
1399− numargs <- option 0 $ try bracketedNum
1400− spaces
1401− optarg <- option Nothing $ Just <$> try bracketedToks
1402− let argspecs = map (\i -> ArgNum i) [1..numargs]
1403− startcontents <- spaces >> bracedOrToken
1404− endcontents <- spaces >> bracedOrToken
1405− macros <- sMacros <$> getState
1406− case M.lookup name macros of
1407− Just _
1408− | mtype == "newenvironment" -> do
1409− report $ MacroAlreadyDefined name pos
1410− return Nothing
1411− | mtype == "provideenvironment" ->
1412− return Nothing
1413− _ -> return $ Just (name,
1414− Macro ExpandWhenUsed argspecs optarg startcontents,
1415− Macro ExpandWhenUsed [] Nothing endcontents)
1416−
1417−bracketedNum :: PandocMonad m => LP m Int
1418−bracketedNum = do
1419− ds <- untokenize <$> bracketedToks
1420− case safeRead ds of
1421− Just i -> return i
1422− _ -> return 0
1423−
1424−setCaption :: PandocMonad m => LP m ()
1425−setCaption = try $ do
1426− skipopts
1427− ils <- tok
1428− optional $ try $ spaces *> label
1429− updateState $ \st -> st{ sCaption = Just ils }
1430−
1431738looseItem :: PandocMonad m => LP m Blocks
1432739looseItem = do
1433740 inListItem <- sInListItem <$> getState
@@ -1441,10 +748,6 @@ epigraph = do
1441748 p2 <- grouped block
1442749 return $ divWith ("", ["epigraph"], []) (p1 <> p2)
1443750
1444−resetCaption :: PandocMonad m => LP m ()
1445−resetCaption = updateState $ \st -> st{ sCaption = Nothing
1446− , sLastLabel = Nothing }
1447−
1448751section :: PandocMonad m => Attr -> Int -> LP m Blocks
1449752section (ident, classes, kvs) lvl = do
1450753 skipopts
@@ -1537,7 +840,7 @@ blockCommands = M.fromList
1537840 , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
1538841 , ("signature", mempty <$ (skipopts *> authors))
1539842 , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
1540− , ("newtheorem", newtheorem)
843+ , ("newtheorem", newtheorem inline)
1541844 , ("theoremstyle", theoremstyle)
1542845 -- KOMA-Script metadata commands
1543846 , ("extratitle", mempty <$ (skipopts *> tok >>= addMeta "extratitle"))
@@ -1585,7 +888,7 @@ blockCommands = M.fromList
1585888 , ("item", looseItem)
1586889 , ("documentclass", skipopts *> braced *> preamble)
1587890 , ("centerline", para . trimInlines <$> (skipopts *> tok))
1588− , ("caption", mempty <$ setCaption)
891+ , ("caption", mempty <$ setCaption inline)
1589892 , ("bibliography", mempty <$ (skipopts *> braced >>=
1590893 addMeta "bibliography" . splitBibs . untokenize))
1591894 , ("addbibresource", mempty <$ (skipopts *> braced >>=
@@ -1623,7 +926,8 @@ blockCommands = M.fromList
1623926
1624927
1625928environments :: PandocMonad m => M.Map Text (LP m Blocks)
1626−environments = M.fromList
929+environments = M.union (tableEnvironments blocks inline) $
930+ M.fromList
1627931 [ ("document", env "document" blocks <* skipMany anyTok)
1628932 , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
1629933 , ("sloppypar", env "sloppypar" blocks)
@@ -1633,13 +937,6 @@ environments = M.fromList
1633937 , ("figure", env "figure" $ skipopts *> figure)
1634938 , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
1635939 , ("center", divWith ("", ["center"], []) <$> env "center" blocks)
1636− , ("longtable", env "longtable" $
1637− resetCaption *> simpTable "longtable" False >>= addTableCaption)
1638− , ("table", env "table" $
1639− skipopts *> resetCaption *> blocks >>= addTableCaption)
1640− , ("tabular*", env "tabular*" $ simpTable "tabular*" True)
1641− , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1642− , ("tabular", env "tabular" $ simpTable "tabular" False)
1643940 , ("quote", blockQuote <$> env "quote" blocks)
1644941 , ("quotation", blockQuote <$> env "quotation" blocks)
1645942 , ("verse", blockQuote <$> env "verse" blocks)
@@ -1662,7 +959,7 @@ environments = M.fromList
1662959 , ("lilypond", rawVerbEnv "lilypond")
1663960 , ("ly", rawVerbEnv "ly")
1664961 -- amsthm
1665− , ("proof", proof)
962+ , ("proof", proof blocks opt)
1666963 -- etoolbox
1667964 , ("ifstrequal", ifstrequal)
1668965 , ("newtoggle", braced >>= newToggle)
@@ -1683,131 +980,17 @@ filecontents = try $ do
1683980 st{ sFileContents = M.insert fp txt (sFileContents st) }
1684981 return mempty
1685982
1686−theoremstyle :: PandocMonad m => LP m Blocks
1687−theoremstyle = do
1688− stylename <- untokenize <$> braced
1689− let mbstyle = case stylename of
1690− "plain" -> Just PlainStyle
1691− "definition" -> Just DefinitionStyle
1692− "remark" -> Just RemarkStyle
1693− _ -> Nothing
1694− case mbstyle of
1695− Nothing -> return ()
1696− Just sty -> updateState $ \s -> s{ sLastTheoremStyle = sty }
1697− return mempty
1698−
1699−newtheorem :: PandocMonad m => LP m Blocks
1700−newtheorem = do
1701− number <- option True (False <$ symbol '*' <* sp)
1702− name <- untokenize <$> braced
1703− sp
1704− series <- option Nothing $ Just . untokenize <$> bracketedToks
1705− sp
1706− showName <- tok
1707− sp
1708− syncTo <- option Nothing $ Just . untokenize <$> bracketedToks
1709− sty <- sLastTheoremStyle <$> getState
1710− let spec = TheoremSpec { theoremName = showName
1711− , theoremStyle = sty
1712− , theoremSeries = series
1713− , theoremSyncTo = syncTo
1714− , theoremNumber = number
1715− , theoremLastNum = DottedNum [0] }
1716− tmap <- sTheoremMap <$> getState
1717− updateState $ \s -> s{ sTheoremMap =
1718− M.insert name spec tmap }
1719− return mempty
1720−
1721−proof :: PandocMonad m => LP m Blocks
1722−proof = do
1723− title <- option (B.text "Proof") opt
1724− bs <- env "proof" blocks
1725− return $
1726− B.divWith ("", ["proof"], []) $
1727− addQed $ addTitle (B.emph (title <> ".")) bs
1728−
1729−addTitle :: Inlines -> Blocks -> Blocks
1730−addTitle ils bs =
1731− case B.toList bs of
1732− (Para xs : rest)
1733− -> B.fromList (Para (B.toList ils ++ (Space : xs)) : rest)
1734− _ -> B.para ils <> bs
1735−
1736−addQed :: Blocks -> Blocks
1737−addQed bs =
1738− case Seq.viewr (B.unMany bs) of
1739− s Seq.:> Para ils
1740− -> B.Many (s Seq.|> Para (ils ++ B.toList qedSign))
1741− _ -> bs <> B.para qedSign
1742− where
1743− qedSign = B.str "\xa0\x25FB"
1744−
1745983environment :: PandocMonad m => LP m Blocks
1746984environment = try $ do
1747985 controlSeq "begin"
1748986 name <- untokenize <$> braced
1749987 M.findWithDefault mzero name environments <|>
1750− theoremEnvironment name <|>
988+ theoremEnvironment blocks opt name <|>
1751989 if M.member name (inlineEnvironments
1752990 :: M.Map Text (LP PandocPure Inlines))
1753991 then mzero
1754992 else try (rawEnv name) <|> rawVerbEnv name
1755993
1756−theoremEnvironment :: PandocMonad m => Text -> LP m Blocks
1757−theoremEnvironment name = do
1758− tmap <- sTheoremMap <$> getState
1759− case M.lookup name tmap of
1760− Nothing -> mzero
1761− Just tspec -> do
1762− optTitle <- option mempty $ (\x -> space <> "(" <> x <> ")") <$> opt
1763− mblabel <- option Nothing $ Just . untokenize <$>
1764− try (spaces >> controlSeq "label" >> spaces >> braced)
1765− bs <- env name blocks
1766− number <-
1767− if theoremNumber tspec
1768− then do
1769− let name' = fromMaybe name $ theoremSeries tspec
1770− num <- getNextNumber
1771− (maybe (DottedNum [0]) theoremLastNum .
1772− M.lookup name' . sTheoremMap)
1773− updateState $ \s ->
1774− s{ sTheoremMap =
1775− M.adjust
1776− (\spec -> spec{ theoremLastNum = num })
1777− name'
1778− (sTheoremMap s)
1779− }
1780−
1781− case mblabel of
1782− Just ident ->
1783− updateState $ \s ->
1784− s{ sLabels = M.insert ident
1785− (B.toList $
1786− theoremName tspec <> "\160" <>
1787− str (renderDottedNum num)) (sLabels s) }
1788− Nothing -> return ()
1789− return $ space <> B.text (renderDottedNum num)
1790− else return mempty
1791− let titleEmph = case theoremStyle tspec of
1792− PlainStyle -> B.strong
1793− DefinitionStyle -> B.strong
1794− RemarkStyle -> B.emph
1795− let title = titleEmph (theoremName tspec <> number)
1796− <> optTitle <> "." <> space
1797− return $ divWith (fromMaybe "" mblabel, [name], []) $ addTitle title
1798− $ case theoremStyle tspec of
1799− PlainStyle -> walk italicize bs
1800− _ -> bs
1801−
1802−italicize :: Block -> Block
1803−italicize x@(Para [Image{}]) = x -- see #6925
1804−italicize (Para ils) = Para [Emph ils]
1805−italicize (Plain ils) = Plain [Emph ils]
1806−italicize x = x
1807−
1808−env :: PandocMonad m => Text -> LP m a -> LP m a
1809−env name p = p <* end_ name
1810−
1811994rawEnv :: PandocMonad m => Text -> LP m Blocks
1812995rawEnv name = do
1813996 exts <- getOption readerExtensions
@@ -1979,7 +1162,8 @@ inputListing = do
19791162 let (ident,classes,kvs) = parseListingsOptions options
19801163 let classes' =
19811164 (case listingsLanguage options of
1982− Nothing -> (take 1 (languagesByExtension (T.pack $ takeExtension $ T.unpack f)) <>)
1165+ Nothing -> (take 1 (languagesByExtension defaultSyntaxMap
1166+ (T.pack $ takeExtension $ T.unpack f)) <>)
19831167 Just _ -> id) classes
19841168 let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead
19851169 let lastline = fromMaybe (length codeLines) $
@@ -2045,356 +1229,23 @@ orderedList' = try $ do
20451229 bs <- listenv "enumerate" (many item)
20461230 return $ orderedListWith (start, style, delim) bs
20471231
2048−-- tables
2049−
2050−hline :: PandocMonad m => LP m ()
2051−hline = try $ do
2052− spaces
2053− controlSeq "hline" <|>
2054− -- booktabs rules:
2055− controlSeq "toprule" <|>
2056− controlSeq "bottomrule" <|>
2057− controlSeq "midrule" <|>
2058− controlSeq "endhead" <|>
2059− controlSeq "endfirsthead"
2060− spaces
2061− optional opt
2062− return ()
2063−
2064−lbreak :: PandocMonad m => LP m Tok
2065−lbreak = (controlSeq "\\" <|> controlSeq "tabularnewline")
2066− <* skipopts <* spaces
2067−
2068−amp :: PandocMonad m => LP m Tok
2069−amp = symbol '&'
2070−
2071−-- Split a Word into individual Symbols (for parseAligns)
2072−splitWordTok :: PandocMonad m => LP m ()
2073−splitWordTok = do
2074− inp <- getInput
2075− case inp of
2076− (Tok spos Word t : rest) ->
2077− setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) <> rest
2078− _ -> return ()
2079−
2080−parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
2081−parseAligns = try $ do
2082− let maybeBar = skipMany
2083− (try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced)))
2084− let cAlign = AlignCenter <$ symbol 'c'
2085− let lAlign = AlignLeft <$ symbol 'l'
2086− let rAlign = AlignRight <$ symbol 'r'
2087− let parAlign = AlignLeft <$ symbol 'p'
2088− -- aligns from tabularx
2089− let xAlign = AlignLeft <$ symbol 'X'
2090− let mAlign = AlignLeft <$ symbol 'm'
2091− let bAlign = AlignLeft <$ symbol 'b'
2092− let alignChar = splitWordTok *> ( cAlign <|> lAlign <|> rAlign <|> parAlign
2093− <|> xAlign <|> mAlign <|> bAlign )
2094− let alignPrefix = symbol '>' >> braced
2095− let alignSuffix = symbol '<' >> braced
2096− let colWidth = try $ do
2097− symbol '{'
2098− ds <- trim . untokenize <$> manyTill anyTok (controlSeq "linewidth")
2099− spaces
2100− symbol '}'
2101− return $ safeRead ds
2102− let alignSpec = do
2103− pref <- option [] alignPrefix
2104− spaces
2105− al <- alignChar
2106− width <- colWidth <|> option Nothing (do s <- untokenize <$> braced
2107− pos <- getPosition
2108− report $ SkippedContent s pos
2109− return Nothing)
2110− spaces
2111− suff <- option [] alignSuffix
2112− return (al, width, (pref, suff))
2113− let starAlign = do -- '*{2}{r}' == 'rr', we just expand like a macro
2114− symbol '*'
2115− spaces
2116− ds <- trim . untokenize <$> braced
2117− spaces
2118− spec <- braced
2119− case safeRead ds of
2120− Just n ->
2121− getInput >>= setInput . (mconcat (replicate n spec) ++)
2122− Nothing -> Prelude.fail $ "Could not parse " <> T.unpack ds <> " as number"
2123− bgroup
2124− spaces
2125− maybeBar
2126− aligns' <- many $ try $ spaces >> optional starAlign >>
2127− (alignSpec <* maybeBar)
2128− spaces
2129− egroup
2130− spaces
2131− return $ map toSpec aligns'
2132− where
2133− toColWidth (Just w) | w > 0 = ColWidth w
2134− toColWidth _ = ColWidthDefault
2135− toSpec (x, y, z) = (x, toColWidth y, z)
2136−
2137−-- N.B. this parser returns a Row that may have erroneous empty cells
2138−-- in it. See the note above fixTableHead for details.
2139−parseTableRow :: PandocMonad m
2140− => Text -- ^ table environment name
2141− -> [([Tok], [Tok])] -- ^ pref/suffixes
2142− -> LP m Row
2143−parseTableRow envname prefsufs = do
2144− notFollowedBy (spaces *> end_ envname)
2145− -- add prefixes and suffixes in token stream:
2146− let celltoks (pref, suff) = do
2147− prefpos <- getPosition
2148− contents <- mconcat <$>
2149− many ( snd <$> withRaw (controlSeq "parbox" >> parbox) -- #5711
2150− <|>
2151− snd <$> withRaw (inlineEnvironment <|> dollarsMath)
2152− <|>
2153− (do notFollowedBy
2154− (() <$ amp <|> () <$ lbreak <|> end_ envname)
2155− count 1 anyTok) )
2156−
2157− suffpos <- getPosition
2158− option [] (count 1 amp)
2159− return $ map (setpos prefpos) pref ++ contents ++ map (setpos suffpos) suff
2160− rawcells <- mapM celltoks prefsufs
2161− cells <- mapM (parseFromToks parseTableCell) rawcells
2162− spaces
2163− return $ Row nullAttr cells
2164−
2165−parseTableCell :: PandocMonad m => LP m Cell
2166−parseTableCell = do
2167− spaces
2168− updateState $ \st -> st{ sInTableCell = True }
2169− cell' <- multicolumnCell
2170− <|> multirowCell
2171− <|> parseSimpleCell
2172− <|> parseEmptyCell
2173− updateState $ \st -> st{ sInTableCell = False }
2174− spaces
2175− return cell'
2176− where
2177− -- The parsing of empty cells is important in LaTeX, especially when dealing
2178− -- with multirow/multicolumn. See #6603.
2179− parseEmptyCell = spaces $> emptyCell
2180−
2181−cellAlignment :: PandocMonad m => LP m Alignment
2182−cellAlignment = skipMany (symbol '|') *> alignment <* skipMany (symbol '|')
2183− where
2184− alignment = do
2185− c <- untoken <$> singleChar
2186− return $ case c of
2187− "l" -> AlignLeft
2188− "r" -> AlignRight
2189− "c" -> AlignCenter
2190− "*" -> AlignDefault
2191− _ -> AlignDefault
2192−
2193−plainify :: Blocks -> Blocks
2194−plainify bs = case toList bs of
2195− [Para ils] -> plain (fromList ils)
2196− _ -> bs
2197−
2198−multirowCell :: PandocMonad m => LP m Cell
2199−multirowCell = controlSeq "multirow" >> do
2200− -- Full prototype for \multirow macro is:
2201− -- \multirow[vpos]{nrows}[bigstruts]{width}[vmove]{text}
2202− -- However, everything except `nrows` and `text` make
2203− -- sense in the context of the Pandoc AST
2204− _ <- optional $ symbol '[' *> cellAlignment <* symbol ']' -- vertical position
2205− nrows <- fmap (fromMaybe 1 . safeRead . untokenize) braced
2206− _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- bigstrut-related
2207− _ <- symbol '{' *> manyTill anyTok (symbol '}') -- Cell width
2208− _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- Length used for fine-tuning
2209− content <- symbol '{' *> (plainify <$> blocks) <* symbol '}'
2210− return $ cell AlignDefault (RowSpan nrows) (ColSpan 1) content
2211−
2212−multicolumnCell :: PandocMonad m => LP m Cell
2213−multicolumnCell = controlSeq "multicolumn" >> do
2214− span' <- fmap (fromMaybe 1 . safeRead . untokenize) braced
2215− alignment <- symbol '{' *> cellAlignment <* symbol '}'
2216−
2217− let singleCell = do
2218− content <- plainify <$> blocks
2219− return $ cell alignment (RowSpan 1) (ColSpan span') content
2220−
2221− -- Two possible contents: either a \multirow cell, or content.
2222− -- E.g. \multicol{1}{c}{\multirow{2}{1em}{content}}
2223− -- Note that a \multirow cell can be nested in a \multicolumn,
2224− -- but not the other way around. See #6603
2225− let nestedCell = do
2226− (Cell _ _ (RowSpan rs) _ bs) <- multirowCell
2227− return $ cell
2228− alignment
2229− (RowSpan rs)
2230− (ColSpan span')
2231− (fromList bs)
2232−
2233− symbol '{' *> (nestedCell <|> singleCell) <* symbol '}'
2234−
2235−-- Parse a simple cell, i.e. not multirow/multicol
2236−parseSimpleCell :: PandocMonad m => LP m Cell
2237−parseSimpleCell = simpleCell <$> (plainify <$> blocks)
2238−
2239−-- LaTeX tables are stored with empty cells underneath multirow cells
2240−-- denoting the grid spaces taken up by them. More specifically, if a
2241−-- cell spans m rows, then it will overwrite all the cells in the
2242−-- columns it spans for (m-1) rows underneath it, requiring padding
2243−-- cells in these places. These padding cells need to be removed for
2244−-- proper table reading. See #6603.
2245−--
2246−-- These fixTable functions do not otherwise fix up malformed
2247−-- input tables: that is left to the table builder.
2248−fixTableHead :: TableHead -> TableHead
2249−fixTableHead (TableHead attr rows) = TableHead attr rows'
2250− where
2251− rows' = fixTableRows rows
2252−
2253−fixTableBody :: TableBody -> TableBody
2254−fixTableBody (TableBody attr rhc th tb)
2255− = TableBody attr rhc th' tb'
2256− where
2257− th' = fixTableRows th
2258− tb' = fixTableRows tb
2259−
2260−fixTableRows :: [Row] -> [Row]
2261−fixTableRows = fixTableRows' $ repeat Nothing
2262− where
2263− fixTableRows' oldHang (Row attr cells : rs)
2264− = let (newHang, cells') = fixTableRow oldHang cells
2265− rs' = fixTableRows' newHang rs
2266− in Row attr cells' : rs'
2267− fixTableRows' _ [] = []
2268−
2269−-- The overhang is represented as Just (relative cell dimensions) or
2270−-- Nothing for an empty grid space.
2271−fixTableRow :: [Maybe (ColSpan, RowSpan)] -> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])
2272−fixTableRow oldHang cells
2273− -- If there's overhang, drop cells until their total width meets the
2274− -- width of the occupied grid spaces (or we run out)
2275− | (n, prefHang, restHang) <- splitHang oldHang
2276− , n > 0
2277− = let cells' = dropToWidth getCellW n cells
2278− (restHang', cells'') = fixTableRow restHang cells'
2279− in (prefHang restHang', cells'')
2280− -- Otherwise record the overhang of a pending cell and fix the rest
2281− -- of the row
2282− | c@(Cell _ _ h w _):cells' <- cells
2283− = let h' = max 1 h
2284− w' = max 1 w
2285− oldHang' = dropToWidth getHangW w' oldHang
2286− (newHang, cells'') = fixTableRow oldHang' cells'
2287− in (toHang w' h' <> newHang, c : cells'')
2288− | otherwise
2289− = (oldHang, [])
2290− where
2291− getCellW (Cell _ _ _ w _) = w
2292− getHangW = maybe 1 fst
2293− getCS (ColSpan n) = n
2294−
2295− toHang c r
2296− | r > 1 = [Just (c, r)]
2297− | otherwise = replicate (getCS c) Nothing
2298−
2299− -- Take the prefix of the overhang list representing filled grid
2300− -- spaces. Also return the remainder and the length of this prefix.
2301− splitHang = splitHang' 0 id
2302−
2303− splitHang' !n l (Just (c, r):xs)
2304− = splitHang' (n + c) (l . (toHang c (r-1) ++)) xs
2305− splitHang' n l xs = (n, l, xs)
2306−
2307− -- Drop list items until the total width of the dropped items
2308− -- exceeds the passed width.
2309− dropToWidth _ n l | n < 1 = l
2310− dropToWidth wproj n (c:cs) = dropToWidth wproj (n - wproj c) cs
2311− dropToWidth _ _ [] = []
2312−
2313−simpTable :: PandocMonad m => Text -> Bool -> LP m Blocks
2314−simpTable envname hasWidthParameter = try $ do
2315− when hasWidthParameter $ () <$ (spaces >> tok)
2316− skipopts
2317− colspecs <- parseAligns
2318− let (aligns, widths, prefsufs) = unzip3 colspecs
2319− optional $ controlSeq "caption" *> setCaption
2320− spaces
2321− optional label
2322− spaces
2323− optional lbreak
2324− spaces
2325− skipMany hline
2326− spaces
2327− header' <- option [] . try . fmap (:[]) $
2328− parseTableRow envname prefsufs <* lbreak <* many1 hline
2329− spaces
2330− rows <- sepEndBy (parseTableRow envname prefsufs)
2331− (lbreak <* optional (skipMany hline))
2332− spaces
2333− optional $ controlSeq "caption" *> setCaption
2334− spaces
2335− optional label
2336− spaces
2337− optional lbreak
2338− spaces
2339− lookAhead $ controlSeq "end" -- make sure we're at end
2340− let th = fixTableHead $ TableHead nullAttr header'
2341− let tbs = [fixTableBody $ TableBody nullAttr 0 [] rows]
2342− let tf = TableFoot nullAttr []
2343− return $ table emptyCaption (zip aligns widths) th tbs tf
2344−
2345−addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
2346−addTableCaption = walkM go
2347− where go (Table attr c spec th tb tf) = do
2348− st <- getState
2349− let mblabel = sLastLabel st
2350− capt <- case (sCaption st, mblabel) of
2351− (Just ils, Nothing) -> return $ caption Nothing (plain ils)
2352− (Just ils, Just lab) -> do
2353− num <- getNextNumber sLastTableNum
2354− setState
2355− st{ sLastTableNum = num
2356− , sLabels = M.insert lab
2357− [Str (renderDottedNum num)]
2358− (sLabels st) }
2359− return $ caption Nothing (plain ils) -- add number??
2360− (Nothing, _) -> return c
2361− let attr' = case (attr, mblabel) of
2362− ((_,classes,kvs), Just ident) ->
2363− (ident,classes,kvs)
2364− _ -> attr
2365− return $ addAttrDiv attr' $ Table nullAttr capt spec th tb tf
2366− go x = return x
2367−
2368−-- TODO: For now we add a Div to contain table attributes, since
2369−-- most writers don't do anything yet with attributes on Table.
2370−-- This can be removed when that changes.
2371−addAttrDiv :: Attr -> Block -> Block
2372−addAttrDiv ("",[],[]) b = b
2373−addAttrDiv attr b = Div attr [b]
2374−
23751232block :: PandocMonad m => LP m Blocks
23761233block = do
2377− res <- (mempty <$ spaces1)
2378− <|> environment
2379− <|> macroDef (rawBlock "latex")
2380− <|> blockCommand
2381− <|> paragraph
2382− <|> grouped block
1234+ Tok _ toktype _ <- lookAhead anyTok
1235+ res <- (case toktype of
1236+ Newline -> mempty <$ spaces1
1237+ Spaces -> mempty <$ spaces1
1238+ Comment -> mempty <$ spaces1
1239+ Word -> paragraph
1240+ CtrlSeq "begin" -> environment
1241+ CtrlSeq _ -> macroDef (rawBlock "latex")
1242+ <|> blockCommand
1243+ _ -> mzero)
1244+ <|> paragraph
1245+ <|> grouped block
23831246 trace (T.take 60 $ tshow $ B.toList res)
23841247 return res
23851248
23861249blocks :: PandocMonad m => LP m Blocks
23871250blocks = mconcat <$> many block
23881251
2389−setDefaultLanguage :: PandocMonad m => LP m Blocks
2390−setDefaultLanguage = do
2391− o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')
2392− <$> rawopt
2393− polylang <- untokenize <$> braced
2394− case M.lookup polylang polyglossiaLangToBCP47 of
2395− Nothing -> return mempty -- TODO mzero? warning?
2396− Just langFunc -> do
2397− let l = langFunc o
2398− setTranslations l
2399− updateState $ setMeta "lang" $ str (renderLang l)
2400− return mempty