@@ -1,3 +1,7 @@
1+{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
15{-# LANGUAGE OverloadedStrings #-}
26{-# LANGUAGE PatternGuards #-}
37{-# LANGUAGE ScopedTypeVariables #-}
@@ -18,58 +22,50 @@ module Text.Pandoc.Readers.LaTeX ( readLaTeX,
1822 applyMacros,
1923 rawLaTeXInline,
2024 rawLaTeXBlock,
21− inlineCommand
25+ inlineCommand,
26+ tokenize,
27+ untokenize
2228 ) where
2329
2430import Control.Applicative (many, optional, (<|>))
2531import Control.Monad
2632import Control.Monad.Except (throwError)
27−import Data.Char (isDigit, isLetter, isAlphaNum, toUpper, chr)
33+import Data.Char (isDigit, isLetter, toUpper, chr)
2834import Data.Default
35+import Data.Functor (($>))
2936import Data.List (intercalate)
3037import qualified Data.Map as M
3138import Data.Maybe (fromMaybe, maybeToList)
3239import qualified Data.Set as Set
40+import qualified Data.Sequence as Seq
3341import Data.Text (Text)
3442import qualified Data.Text as T
35−import Skylighting (defaultSyntaxMap)
3643import System.FilePath (addExtension, replaceExtension, takeExtension)
37−import Text.Collate.Lang (renderLang)
38−import Text.Pandoc.Builder as B
44+import Text.Pandoc.BCP47 (Lang (..), renderLang)
45+import Text.Pandoc.Builder
3946import Text.Pandoc.Class.PandocPure (PandocPure)
4047import Text.Pandoc.Class.PandocMonad (PandocMonad (..), getResourcePath,
41− readFileFromDirs, report,
42− setResourcePath)
48+ readFileFromDirs, report, setResourcePath,
49+ setTranslations, translateTerm)
4350import Text.Pandoc.Error (PandocError (PandocParseError, PandocParsecError))
44−import Text.Pandoc.Highlighting (languagesByExtension)
51+import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
4552import Text.Pandoc.ImageSize (numUnit, showFl)
4653import Text.Pandoc.Logging
4754import Text.Pandoc.Options
4855import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,
4956 optional, space, spaces, withRaw, (<|>))
50−import Text.Pandoc.Readers.LaTeX.Types (Tok (..), TokType (..))
57+import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
58+ ArgSpec (..), Tok (..), TokType (..))
5159import Text.Pandoc.Readers.LaTeX.Parsing
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)
60+import Text.Pandoc.Readers.LaTeX.Lang (polyglossiaLangToBCP47,
61+ babelLangToBCP47)
62+import Text.Pandoc.Readers.LaTeX.SIunitx
7063import Text.Pandoc.Shared
64+import qualified Text.Pandoc.Translations as Translations
7165import Text.Pandoc.Walk
72−import Data.List.NonEmpty (nonEmpty)
66+import qualified Text.Pandoc.Builder as B
67+import qualified Data.Text.Normalize as Normalize
68+import Safe
7369
7470-- for debugging:
7571-- import Text.Pandoc.Extensions (getDefaultExtensions)
@@ -77,17 +73,16 @@ import Data.List.NonEmpty (nonEmpty)
7773-- import Debug.Trace (traceShowId)
7874
7975-- | Parse LaTeX from string and return 'Pandoc' document.
80−readLaTeX :: (PandocMonad m, ToSources a)
76+readLaTeX :: PandocMonad m
8177 => ReaderOptions -- ^ Reader options
82− -> a -- ^ Input to parse
78+ -> Text -- ^ String to parse (assumes @'\n'@ line endings)
8379 -> m Pandoc
8480readLaTeX opts ltx = do
85− let sources = toSources ltx
8681 parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"
87− (tokenizeSources sources)
82+ (tokenize "source" (crFilter ltx))
8883 case parsed of
8984 Right result -> return result
90− Left e -> throwError $ PandocParsecError sources e
85+ Left e -> throwError $ PandocParsecError ltx e
9186
9287parseLaTeX :: PandocMonad m => LP m Pandoc
9388parseLaTeX = do
@@ -98,7 +93,11 @@ parseLaTeX = do
9893 let doc' = doc bs
9994 let headerLevel (Header n _ _) = [n]
10095 headerLevel _ = []
101− let bottomLevel = maybe 1 minimum $ nonEmpty $ query headerLevel doc'
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
102101 let adjustHeaders m (Header n attr ils) = Header (n+m) attr ils
103102 adjustHeaders _ x = x
104103 let (Pandoc _ bs') =
@@ -133,11 +132,11 @@ resolveRefs _ x = x
133132
134133
135134rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)
136− => ParserT Sources s m Text
135+ => ParserT Text s m Text
137136rawLaTeXBlock = do
138137 lookAhead (try (char '\\' >> letter))
139138 inp <- getInput
140− let toks = tokenizeSources inp
139+ let toks = tokenize "source" inp
141140 snd <$> (rawLaTeXParser toks False (macroDef (const mempty)) blocks
142141 <|> rawLaTeXParser toks True
143142 (do choice (map controlSeq
@@ -164,14 +163,14 @@ beginOrEndCommand = try $ do
164163 (txt <> untokenize rawargs)
165164
166165rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)
167− => ParserT Sources s m Text
166+ => ParserT Text s m Text
168167rawLaTeXInline = do
169168 lookAhead (try (char '\\' >> letter))
170169 inp <- getInput
171− let toks = tokenizeSources inp
170+ let toks = tokenize "source" inp
172171 raw <- snd <$>
173172 ( rawLaTeXParser toks True
174− (mempty <$ (controlSeq "input" >> skipMany rawopt >> braced))
173+ (mempty <$ (controlSeq "input" >> skipMany opt >> braced))
175174 inlines
176175 <|> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')
177176 inlines
@@ -179,11 +178,11 @@ rawLaTeXInline = do
179178 finalbraces <- mconcat <$> many (try (string "{}")) -- see #5439
180179 return $ raw <> T.pack finalbraces
181180
182−inlineCommand :: PandocMonad m => ParserT Sources ParserState m Inlines
181+inlineCommand :: PandocMonad m => ParserT Text ParserState m Inlines
183182inlineCommand = do
184183 lookAhead (try (char '\\' >> letter))
185184 inp <- getInput
186− let toks = tokenizeSources inp
185+ let toks = tokenize "source" inp
187186 fst <$> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')
188187 inlines
189188
@@ -192,6 +191,12 @@ inlineCommand = do
192191word :: PandocMonad m => LP m Inlines
193192word = str . untoken <$> satisfyTok isWordTok
194193
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+
195200inlineGroup :: PandocMonad m => LP m Inlines
196201inlineGroup = do
197202 ils <- grouped inline
@@ -232,6 +237,19 @@ mkImage options (T.unpack -> src) = do
232237 _ -> return src
233238 return $ imageWith attr (T.pack src') "" alt
234239
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+
250+lit :: Text -> LP m Inlines
251+lit = pure . str
252+
235253removeDoubleQuotes :: Text -> Text
236254removeDoubleQuotes t =
237255 Data.Maybe.fromMaybe t $ T.stripPrefix "\"" t >>= T.stripSuffix "\""
@@ -278,14 +296,23 @@ quoted' f starter ender = do
278296 cs -> cs)
279297 else lit startchs
280298
281−lit :: Text -> LP m Inlines
282−lit = pure . str
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
283310
284311blockquote :: PandocMonad m => Bool -> Maybe Text -> LP m Blocks
285312blockquote cvariant mblang = do
286313 citepar <- if cvariant
287314 then (\xs -> para (cite xs mempty))
288− <$> cites inline NormalCitation False
315+ <$> cites NormalCitation False
289316 else option mempty $ para <$> bracketed inline
290317 let lang = mblang >>= babelLangToBCP47
291318 let langdiv = case lang of
@@ -296,13 +323,224 @@ blockquote cvariant mblang = do
296323 optional $ symbolIn (".:;?!" :: [Char]) -- currently ignored
297324 return $ blockQuote . langdiv $ (bs <> citepar)
298325
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+
299539inlineCommand' :: PandocMonad m => LP m Inlines
300540inlineCommand' = try $ do
301541 Tok _ (CtrlSeq name) cmd <- anyControlSeq
302542 guard $ name /= "begin" && name /= "end" && name /= "and"
303− star <- if T.all isAlphaNum name
304− then option "" ("*" <$ symbol '*' <* sp)
305− else pure ""
543+ star <- option "" ("*" <$ symbol '*' <* sp)
306544 overlay <- option "" overlaySpecification
307545 let name' = name <> star <> overlay
308546 let names = ordNub [name', name] -- check non-starred as fallback
@@ -313,8 +551,28 @@ inlineCommand' = try $ do
313551 <|> ignore rawcommand
314552 lookupListDefault raw names inlineCommands
315553
554+
316555tok :: PandocMonad m => LP m Inlines
317−tok = tokWith inline
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 "]"
318576
319577unescapeURL :: Text -> Text
320578unescapeURL = T.concat . go . T.splitOn "\\"
@@ -327,107 +585,397 @@ unescapeURL = T.concat . go . T.splitOn "\\"
327585 , isEscapable c = t
328586 | otherwise = "\\" <> t
329587
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+
330633inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
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− ]
634+inlineCommands = M.union inlineLanguageCommands $ M.fromList
635+ [ ("emph", extractSpaces emph <$> tok)
636+ , ("textit", extractSpaces emph <$> tok)
637+ , ("textsl", extractSpaces emph <$> tok)
638+ , ("textsc", extractSpaces smallcaps <$> tok)
639+ , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)
640+ , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)
641+ , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)
642+ , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)
643+ , ("texttt", ttfamily)
644+ , ("sout", extractSpaces strikeout <$> tok)
645+ , ("alert", skipopts >> spanWith ("",["alert"],[]) <$> tok) -- beamer
646+ , ("lq", return (str "‘"))
647+ , ("rq", return (str "’"))
648+ , ("textquoteleft", return (str "‘"))
649+ , ("textquoteright", return (str "’"))
650+ , ("textquotedblleft", return (str "“"))
651+ , ("textquotedblright", return (str "”"))
652+ , ("textsuperscript", extractSpaces superscript <$> tok)
653+ , ("textsubscript", extractSpaces subscript <$> tok)
654+ , ("textbackslash", lit "\\")
655+ , ("backslash", lit "\\")
656+ , ("slash", lit "/")
657+ , ("textbf", extractSpaces strong <$> tok)
658+ , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)
659+ , ("underline", underline <$> tok)
660+ , ("ldots", lit "…")
661+ , ("vdots", lit "\8942")
662+ , ("dots", lit "…")
663+ , ("mdots", lit "…")
664+ , ("sim", lit "~")
665+ , ("sep", lit ",")
666+ , ("label", rawInlineOr "label" dolabel)
667+ , ("ref", rawInlineOr "ref" $ doref "ref")
668+ , ("cref", rawInlineOr "cref" $ doref "ref") -- from cleveref.sty
669+ , ("vref", rawInlineOr "vref" $ doref "ref+page") -- from varioref.sty
670+ , ("eqref", rawInlineOr "eqref" $ doref "eqref") -- from amsmath.sty
671+ , ("mbox", rawInlineOr "mbox" $ processHBox <$> tok)
672+ , ("hbox", rawInlineOr "hbox" $ processHBox <$> tok)
673+ , ("lettrine", rawInlineOr "lettrine" lettrine)
674+ , ("(", mathInline . untokenize <$> manyTill anyTok (controlSeq ")"))
675+ , ("[", mathDisplay . untokenize <$> manyTill anyTok (controlSeq "]"))
676+ , ("ensuremath", mathInline . untokenize <$> braced)
677+ , ("texorpdfstring", const <$> tok <*> tok)
678+ , ("P", lit "¶")
679+ , ("S", lit "§")
680+ , ("$", lit "$")
681+ , ("%", lit "%")
682+ , ("&", lit "&")
683+ , ("#", lit "#")
684+ , ("_", lit "_")
685+ , ("{", lit "{")
686+ , ("}", lit "}")
687+ , ("qed", lit "\a0\x25FB")
688+ -- old TeX commands
689+ , ("em", extractSpaces emph <$> inlines)
690+ , ("it", extractSpaces emph <$> inlines)
691+ , ("sl", extractSpaces emph <$> inlines)
692+ , ("bf", extractSpaces strong <$> inlines)
693+ , ("tt", code . stringify . toList <$> inlines)
694+ , ("rm", inlines)
695+ , ("itshape", extractSpaces emph <$> inlines)
696+ , ("slshape", extractSpaces emph <$> inlines)
697+ , ("scshape", extractSpaces smallcaps <$> inlines)
698+ , ("bfseries", extractSpaces strong <$> inlines)
699+ , ("MakeUppercase", makeUppercase <$> tok)
700+ , ("MakeTextUppercase", makeUppercase <$> tok) -- textcase
701+ , ("uppercase", makeUppercase <$> tok)
702+ , ("MakeLowercase", makeLowercase <$> tok)
703+ , ("MakeTextLowercase", makeLowercase <$> tok)
704+ , ("lowercase", makeLowercase <$> tok)
705+ , ("/", pure mempty) -- italic correction
706+ , ("aa", lit "å")
707+ , ("AA", lit "Å")
708+ , ("ss", lit "ß")
709+ , ("o", lit "ø")
710+ , ("O", lit "Ø")
711+ , ("L", lit "Ł")
712+ , ("l", lit "ł")
713+ , ("ae", lit "æ")
714+ , ("AE", lit "Æ")
715+ , ("oe", lit "œ")
716+ , ("OE", lit "Œ")
717+ , ("pounds", lit "£")
718+ , ("euro", lit "€")
719+ , ("copyright", lit "©")
720+ , ("textasciicircum", lit "^")
721+ , ("textasciitilde", lit "~")
722+ , ("H", accent '\779' Nothing) -- hungarumlaut
723+ , ("`", accent '\768' (Just '`')) -- grave
724+ , ("'", accent '\769' (Just '\'')) -- acute
725+ , ("^", accent '\770' (Just '^')) -- circ
726+ , ("~", accent '\771' (Just '~')) -- tilde
727+ , ("\"", accent '\776' Nothing) -- umlaut
728+ , (".", accent '\775' Nothing) -- dot
729+ , ("=", accent '\772' Nothing) -- macron
730+ , ("|", accent '\781' Nothing) -- vertical line above
731+ , ("b", accent '\817' Nothing) -- macron below
732+ , ("c", accent '\807' Nothing) -- cedilla
733+ , ("G", accent '\783' Nothing) -- doublegrave
734+ , ("h", accent '\777' Nothing) -- hookabove
735+ , ("d", accent '\803' Nothing) -- dotbelow
736+ , ("f", accent '\785' Nothing) -- inverted breve
737+ , ("r", accent '\778' Nothing) -- ringabove
738+ , ("t", accent '\865' Nothing) -- double inverted breve
739+ , ("U", accent '\782' Nothing) -- double vertical line above
740+ , ("v", accent '\780' Nothing) -- hacek
741+ , ("u", accent '\774' Nothing) -- breve
742+ , ("k", accent '\808' Nothing) -- ogonek
743+ , ("textogonekcentered", accent '\808' Nothing) -- ogonek
744+ , ("i", lit "ı") -- dotless i
745+ , ("j", lit "ȷ") -- dotless j
746+ , ("newtie", accent '\785' Nothing) -- inverted breve
747+ , ("textcircled", accent '\8413' Nothing) -- combining circle
748+ , ("\\", linebreak <$ (do inTableCell <- sInTableCell <$> getState
749+ guard $ not inTableCell
750+ optional opt
751+ spaces))
752+ , (",", lit "\8198")
753+ , ("@", pure mempty)
754+ , (" ", lit "\160")
755+ , ("ps", pure $ str "PS." <> space)
756+ , ("TeX", lit "TeX")
757+ , ("LaTeX", lit "LaTeX")
758+ , ("bar", lit "|")
759+ , ("textless", lit "<")
760+ , ("textgreater", lit ">")
761+ , ("thanks", skipopts >> note <$> grouped block)
762+ , ("footnote", skipopts >> note <$> grouped block)
763+ , ("passthrough", tok) -- \passthrough macro used by latex writer
764+ -- for listings
765+ , ("verb", doverb)
766+ , ("lstinline", dolstinline)
767+ , ("mintinline", domintinline)
768+ , ("Verb", doverb)
769+ , ("url", (\url -> link url "" (str url)) . unescapeURL . untokenize <$>
770+ bracedUrl)
771+ , ("nolinkurl", code . unescapeURL . untokenize <$> bracedUrl)
772+ , ("href", do url <- bracedUrl
773+ sp
774+ link (unescapeURL $ untokenize url) "" <$> tok)
775+ , ("includegraphics", do options <- option [] keyvals
776+ src <- braced
777+ mkImage options . unescapeURL . removeDoubleQuotes $
778+ untokenize src)
779+ , ("enquote*", enquote True Nothing)
780+ , ("enquote", enquote False Nothing)
781+ -- foreignquote is supposed to use native quote marks
782+ , ("foreignquote*", braced >>= enquote True . Just . untokenize)
783+ , ("foreignquote", braced >>= enquote False . Just . untokenize)
784+ -- hypehnquote uses regular quotes
785+ , ("hyphenquote*", braced >>= enquote True . Just . untokenize)
786+ , ("hyphenquote", braced >>= enquote False . Just . untokenize)
787+ , ("figurename", doTerm Translations.Figure)
788+ , ("prefacename", doTerm Translations.Preface)
789+ , ("refname", doTerm Translations.References)
790+ , ("bibname", doTerm Translations.Bibliography)
791+ , ("chaptername", doTerm Translations.Chapter)
792+ , ("partname", doTerm Translations.Part)
793+ , ("contentsname", doTerm Translations.Contents)
794+ , ("listfigurename", doTerm Translations.ListOfFigures)
795+ , ("listtablename", doTerm Translations.ListOfTables)
796+ , ("indexname", doTerm Translations.Index)
797+ , ("abstractname", doTerm Translations.Abstract)
798+ , ("tablename", doTerm Translations.Table)
799+ , ("enclname", doTerm Translations.Encl)
800+ , ("ccname", doTerm Translations.Cc)
801+ , ("headtoname", doTerm Translations.To)
802+ , ("pagename", doTerm Translations.Page)
803+ , ("seename", doTerm Translations.See)
804+ , ("seealsoname", doTerm Translations.SeeAlso)
805+ , ("proofname", doTerm Translations.Proof)
806+ , ("glossaryname", doTerm Translations.Glossary)
807+ , ("lstlistingname", doTerm Translations.Listing)
808+ , ("cite", citation "cite" NormalCitation False)
809+ , ("Cite", citation "Cite" NormalCitation False)
810+ , ("citep", citation "citep" NormalCitation False)
811+ , ("citep*", citation "citep*" NormalCitation False)
812+ , ("citeal", citation "citeal" NormalCitation False)
813+ , ("citealp", citation "citealp" NormalCitation False)
814+ , ("citealp*", citation "citealp*" NormalCitation False)
815+ , ("autocite", citation "autocite" NormalCitation False)
816+ , ("smartcite", citation "smartcite" NormalCitation False)
817+ , ("footcite", inNote <$> citation "footcite" NormalCitation False)
818+ , ("parencite", citation "parencite" NormalCitation False)
819+ , ("supercite", citation "supercite" NormalCitation False)
820+ , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)
821+ , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)
822+ , ("citeyear", citation "citeyear" SuppressAuthor False)
823+ , ("autocite*", citation "autocite*" SuppressAuthor False)
824+ , ("cite*", citation "cite*" SuppressAuthor False)
825+ , ("parencite*", citation "parencite*" SuppressAuthor False)
826+ , ("textcite", citation "textcite" AuthorInText False)
827+ , ("citet", citation "citet" AuthorInText False)
828+ , ("citet*", citation "citet*" AuthorInText False)
829+ , ("citealt", citation "citealt" AuthorInText False)
830+ , ("citealt*", citation "citealt*" AuthorInText False)
831+ , ("textcites", citation "textcites" AuthorInText True)
832+ , ("cites", citation "cites" NormalCitation True)
833+ , ("autocites", citation "autocites" NormalCitation True)
834+ , ("footcites", inNote <$> citation "footcites" NormalCitation True)
835+ , ("parencites", citation "parencites" NormalCitation True)
836+ , ("supercites", citation "supercites" NormalCitation True)
837+ , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)
838+ , ("Autocite", citation "Autocite" NormalCitation False)
839+ , ("Smartcite", citation "Smartcite" NormalCitation False)
840+ , ("Footcite", inNote <$> citation "Footcite" NormalCitation False)
841+ , ("Parencite", citation "Parencite" NormalCitation False)
842+ , ("Supercite", citation "Supercite" NormalCitation False)
843+ , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)
844+ , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)
845+ , ("Citeyear", citation "Citeyear" SuppressAuthor False)
846+ , ("Autocite*", citation "Autocite*" SuppressAuthor False)
847+ , ("Cite*", citation "Cite*" SuppressAuthor False)
848+ , ("Parencite*", citation "Parencite*" SuppressAuthor False)
849+ , ("Textcite", citation "Textcite" AuthorInText False)
850+ , ("Textcites", citation "Textcites" AuthorInText True)
851+ , ("Cites", citation "Cites" NormalCitation True)
852+ , ("Autocites", citation "Autocites" NormalCitation True)
853+ , ("Footcites", inNote <$> citation "Footcites" NormalCitation True)
854+ , ("Parencites", citation "Parencites" NormalCitation True)
855+ , ("Supercites", citation "Supercites" NormalCitation True)
856+ , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)
857+ , ("citetext", complexNatbibCitation NormalCitation)
858+ , ("citeauthor", (try (tok *> sp *> controlSeq "citetext") *>
859+ complexNatbibCitation AuthorInText)
860+ <|> citation "citeauthor" AuthorInText False)
861+ , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
862+ addMeta "nocite"))
863+ , ("hyperlink", hyperlink)
864+ , ("hypertarget", hypertargetInline)
865+ -- glossaries package
866+ , ("gls", doAcronym "short")
867+ , ("Gls", doAcronym "short")
868+ , ("glsdesc", doAcronym "long")
869+ , ("Glsdesc", doAcronym "long")
870+ , ("GLSdesc", doAcronym "long")
871+ , ("acrlong", doAcronym "long")
872+ , ("Acrlong", doAcronym "long")
873+ , ("acrfull", doAcronym "full")
874+ , ("Acrfull", doAcronym "full")
875+ , ("acrshort", doAcronym "abbrv")
876+ , ("Acrshort", doAcronym "abbrv")
877+ , ("glspl", doAcronymPlural "short")
878+ , ("Glspl", doAcronymPlural "short")
879+ , ("glsdescplural", doAcronymPlural "long")
880+ , ("Glsdescplural", doAcronymPlural "long")
881+ , ("GLSdescplural", doAcronymPlural "long")
882+ -- acronyms package
883+ , ("ac", doAcronym "short")
884+ , ("acf", doAcronym "full")
885+ , ("acs", doAcronym "abbrv")
886+ , ("acl", doAcronym "long")
887+ , ("acp", doAcronymPlural "short")
888+ , ("acfp", doAcronymPlural "full")
889+ , ("acsp", doAcronymPlural "abbrv")
890+ , ("aclp", doAcronymPlural "long")
891+ , ("Ac", doAcronym "short")
892+ , ("Acf", doAcronym "full")
893+ , ("Acs", doAcronym "abbrv")
894+ , ("Acl", doAcronym "long")
895+ , ("Acp", doAcronymPlural "short")
896+ , ("Acfp", doAcronymPlural "full")
897+ , ("Acsp", doAcronymPlural "abbrv")
898+ , ("Aclp", doAcronymPlural "long")
899+ -- siuntix
900+ , ("si", skipopts *> dosi tok)
901+ , ("SI", doSI tok)
902+ , ("SIrange", doSIrange True tok)
903+ , ("numrange", doSIrange False tok)
904+ , ("numlist", doSInumlist)
905+ , ("num", doSInum)
906+ , ("ang", doSIang)
907+ -- hyphenat
908+ , ("bshyp", lit "\\\173")
909+ , ("fshyp", lit "/\173")
910+ , ("dothyp", lit ".\173")
911+ , ("colonhyp", lit ":\173")
912+ , ("hyp", lit "-")
913+ , ("nohyphens", tok)
914+ , ("textnhtt", ttfamily)
915+ , ("nhttfamily", ttfamily)
916+ -- LaTeX colors
917+ , ("textcolor", coloredInline "color")
918+ , ("colorbox", coloredInline "background-color")
919+ -- fontawesome
920+ , ("faCheck", lit "\10003")
921+ , ("faClose", lit "\10007")
922+ -- xspace
923+ , ("xspace", doxspace)
924+ -- etoolbox
925+ , ("ifstrequal", ifstrequal)
926+ , ("newtoggle", braced >>= newToggle)
927+ , ("toggletrue", braced >>= setToggle True)
928+ , ("togglefalse", braced >>= setToggle False)
929+ , ("iftoggle", try $ ifToggle >> inline)
930+ -- biblatex misc
931+ , ("RN", romanNumeralUpper)
932+ , ("Rn", romanNumeralLower)
933+ -- babel
934+ , ("foreignlanguage", foreignlanguage)
935+ -- include
936+ , ("input", rawInlineOr "input" $ include "input")
937+ -- soul package
938+ , ("ul", underline <$> tok)
939+ -- ulem package
940+ , ("uline", underline <$> tok)
941+ -- plain tex stuff that should just be passed through as raw tex
942+ , ("ifdim", ifdim)
943+ -- bibtex
944+ , ("mkbibquote", spanWith nullAttr . doubleQuoted <$> tok)
945+ , ("mkbibemph", spanWith nullAttr . emph <$> tok)
946+ , ("mkbibitalic", spanWith nullAttr . emph <$> tok)
947+ , ("mkbibbold", spanWith nullAttr . strong <$> tok)
948+ , ("mkbibparens",
949+ spanWith nullAttr . (\x -> str "(" <> x <> str ")") <$> tok)
950+ , ("mkbibbrackets",
951+ spanWith nullAttr . (\x -> str "[" <> x <> str "]") <$> tok)
952+ , ("autocap", spanWith nullAttr <$> tok)
953+ , ("textnormal", spanWith ("",["nodecor"],[]) <$> tok)
954+ , ("bibstring",
955+ (\x -> spanWith ("",[],[("bibstring",x)]) (str x)) . untokenize
956+ <$> braced)
957+ , ("adddot", pure (str "."))
958+ , ("adddotspace", pure (spanWith nullAttr (str "." <> space)))
959+ , ("addabbrvspace", pure space)
960+ , ("hyphen", pure (str "-"))
961+ ]
962+
963+accent :: PandocMonad m => Char -> Maybe Char -> LP m Inlines
964+accent combiningAccent fallBack = try $ do
965+ ils <- tok
966+ case toList ils of
967+ (Str (T.uncons -> Just (x, xs)) : ys) -> return $ fromList $
968+ -- try to normalize to the combined character:
969+ Str (Normalize.normalize Normalize.NFC
970+ (T.pack [x, combiningAccent]) <> xs) : ys
971+ [Space] -> return $ str $ T.singleton $ fromMaybe combiningAccent fallBack
972+ [] -> return $ str $ T.singleton $ fromMaybe combiningAccent fallBack
973+ _ -> return ils
974+
427975
428976lettrine :: PandocMonad m => LP m Inlines
429977lettrine = do
430− optional rawopt
978+ optional opt
431979 x <- tok
432980 y <- tok
433981 return $ extractSpaces (spanWith ("",["lettrine"],[])) x <> smallcaps y
@@ -447,18 +995,32 @@ alterStr :: (Text -> Text) -> Inline -> Inline
447995alterStr f (Str xs) = Str (f xs)
448996alterStr _ x = x
449997
998+foreignlanguage :: PandocMonad m => LP m Inlines
999+foreignlanguage = do
1000+ babelLang <- untokenize <$> braced
1001+ case babelLangToBCP47 babelLang of
1002+ Just lang -> spanWith ("", [], [("lang", renderLang lang)]) <$> tok
1003+ _ -> tok
1004+
1005+inlineLanguageCommands :: PandocMonad m => M.Map Text (LP m Inlines)
1006+inlineLanguageCommands = M.fromList $ mk <$> M.toList polyglossiaLangToBCP47
1007+ where
1008+ mk (polyglossia, bcp47Func) =
1009+ ("text" <> polyglossia, inlineLanguage bcp47Func)
1010+
1011+inlineLanguage :: PandocMonad m => (Text -> Lang) -> LP m Inlines
1012+inlineLanguage bcp47Func = do
1013+ o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')
1014+ <$> rawopt
1015+ let lang = renderLang $ bcp47Func o
1016+ extractSpaces (spanWith ("", [], [("lang", lang)])) <$> tok
1017+
4501018hyperlink :: PandocMonad m => LP m Inlines
4511019hyperlink = try $ do
4521020 src <- untokenize <$> braced
4531021 lab <- tok
4541022 return $ link ("#" <> src) "" lab
4551023
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−
4621024hypertargetBlock :: PandocMonad m => LP m Blocks
4631025hypertargetBlock = try $ do
4641026 ref <- untokenize <$> braced
@@ -473,6 +1035,31 @@ hypertargetInline = try $ do
4731035 ils <- grouped inline
4741036 return $ spanWith (ref, [], []) ils
4751037
1038+romanNumeralUpper :: (PandocMonad m) => LP m Inlines
1039+romanNumeralUpper =
1040+ str . toRomanNumeral <$> romanNumeralArg
1041+
1042+romanNumeralLower :: (PandocMonad m) => LP m Inlines
1043+romanNumeralLower =
1044+ str . T.toLower . toRomanNumeral <$> romanNumeralArg
1045+
1046+romanNumeralArg :: (PandocMonad m) => LP m Int
1047+romanNumeralArg = spaces *> (parser <|> inBraces)
1048+ where
1049+ inBraces = do
1050+ symbol '{'
1051+ spaces
1052+ res <- parser
1053+ spaces
1054+ symbol '}'
1055+ return res
1056+ parser = do
1057+ s <- untokenize <$> many1 (satisfyTok isWordTok)
1058+ let (digits, rest) = T.span isDigit s
1059+ unless (T.null rest) $
1060+ Prelude.fail "Non-digits in argument to \\Rn or \\RN"
1061+ safeRead digits
1062+
4761063newToggle :: (Monoid a, PandocMonad m) => [Tok] -> LP m a
4771064newToggle name = do
4781065 updateState $ \st ->
@@ -503,6 +1090,9 @@ ifToggle = do
5031090 report $ UndefinedToggle name' pos
5041091 return ()
5051092
1093+doTerm :: PandocMonad m => Translations.Term -> LP m Inlines
1094+doTerm term = str <$> translateTerm term
1095+
5061096ifstrequal :: (PandocMonad m, Monoid a) => LP m a
5071097ifstrequal = do
5081098 str1 <- tok
@@ -523,6 +1113,13 @@ coloredInline stylename = do
5231113ttfamily :: PandocMonad m => LP m Inlines
5241114ttfamily = code . stringify . toList <$> tok
5251115
1116+rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines
1117+rawInlineOr name' fallback = do
1118+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
1119+ if parseRaw
1120+ then rawInline "latex" <$> getRawCommand name' ("\\" <> name')
1121+ else fallback
1122+
5261123processHBox :: Inlines -> Inlines
5271124processHBox = walk convert
5281125 where
@@ -573,67 +1170,67 @@ treatAsInline = Set.fromList
5731170 , "pagebreak"
5741171 ]
5751172
1173+label :: PandocMonad m => LP m ()
1174+label = do
1175+ controlSeq "label"
1176+ t <- braced
1177+ updateState $ \st -> st{ sLastLabel = Just $ untokenize t }
1178+
1179+dolabel :: PandocMonad m => LP m Inlines
1180+dolabel = do
1181+ v <- braced
1182+ let refstr = untokenize v
1183+ updateState $ \st ->
1184+ st{ sLastLabel = Just refstr }
1185+ return $ spanWith (refstr,[],[("label", refstr)])
1186+ $ inBrackets $ str $ untokenize v
1187+
1188+doref :: PandocMonad m => Text -> LP m Inlines
1189+doref cls = do
1190+ v <- braced
1191+ let refstr = untokenize v
1192+ return $ linkWith ("",[],[ ("reference-type", cls)
1193+ , ("reference", refstr)])
1194+ ("#" <> refstr)
1195+ ""
1196+ (inBrackets $ str refstr)
1197+
5761198lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
5771199lookupListDefault d = (fromMaybe d .) . lookupList
5781200 where lookupList l m = msum $ map (`M.lookup` m) l
5791201
5801202inline :: PandocMonad m => LP m Inlines
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
1203+inline = (mempty <$ comment)
1204+ <|> (space <$ whitespace)
1205+ <|> (softbreak <$ endline)
1206+ <|> word
1207+ <|> macroDef (rawInline "latex")
1208+ <|> inlineCommand'
1209+ <|> inlineEnvironment
1210+ <|> inlineGroup
1211+ <|> (symbol '-' *>
1212+ option (str "-") (symbol '-' *>
1213+ option (str "–") (str "—" <$ symbol '-')))
1214+ <|> doubleQuote
1215+ <|> singleQuote
1216+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
1217+ <|> (str "”" <$ symbol '”')
1218+ <|> (str "’" <$ symbol '\'')
1219+ <|> (str "’" <$ symbol '’')
1220+ <|> (str "\160" <$ symbol '~')
1221+ <|> dollarsMath
1222+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
1223+ <|> (str . T.singleton <$> primEscape)
1224+ <|> regularSymbol
1225+ <|> (do res <- symbolIn "#^'`\"[]&"
1226+ pos <- getPosition
1227+ let s = untoken res
1228+ report $ ParsingUnescaped s pos
1229+ return $ str s)
6231230
6241231inlines :: PandocMonad m => LP m Inlines
6251232inlines = mconcat <$> many inline
6261233
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−
6371234-- block elements:
6381235
6391236preamble :: PandocMonad m => LP m Blocks
@@ -727,6 +1324,10 @@ insertIncluded defaultExtension f' = do
7271324 getInput >>= setInput . (tokenize f contents ++)
7281325 updateState dropLatestIncludeFile
7291326
1327+addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> LP m ()
1328+addMeta field val = updateState $ \st ->
1329+ st{ sMeta = addMetaField field val $ sMeta st }
1330+
7301331authors :: PandocMonad m => LP m ()
7311332authors = try $ do
7321333 bgroup
@@ -735,6 +1336,150 @@ authors = try $ do
7351336 egroup
7361337 addMeta "author" (map trimInlines auths)
7371338
1339+macroDef :: (PandocMonad m, Monoid a) => (Text -> a) -> LP m a
1340+macroDef constructor = do
1341+ (_, s) <- withRaw (commandDef <|> environmentDef)
1342+ (constructor (untokenize s) <$
1343+ guardDisabled Ext_latex_macros)
1344+ <|> return mempty
1345+ where commandDef = do
1346+ (name, macro') <- newcommand <|> letmacro <|> defmacro
1347+ guardDisabled Ext_latex_macros <|>
1348+ updateState (\s -> s{ sMacros = M.insert name macro' (sMacros s) })
1349+ environmentDef = do
1350+ mbenv <- newenvironment
1351+ case mbenv of
1352+ Nothing -> return ()
1353+ Just (name, macro1, macro2) ->
1354+ guardDisabled Ext_latex_macros <|>
1355+ do updateState $ \s -> s{ sMacros =
1356+ M.insert name macro1 (sMacros s) }
1357+ updateState $ \s -> s{ sMacros =
1358+ M.insert ("end" <> name) macro2 (sMacros s) }
1359+ -- @\newenvironment{envname}[n-args][default]{begin}{end}@
1360+ -- is equivalent to
1361+ -- @\newcommand{\envname}[n-args][default]{begin}@
1362+ -- @\newcommand{\endenvname}@
1363+
1364+letmacro :: PandocMonad m => LP m (Text, Macro)
1365+letmacro = do
1366+ controlSeq "let"
1367+ (name, contents) <- withVerbatimMode $ do
1368+ Tok _ (CtrlSeq name) _ <- anyControlSeq
1369+ optional $ symbol '='
1370+ spaces
1371+ -- we first parse in verbatim mode, and then expand macros,
1372+ -- because we don't want \let\foo\bar to turn into
1373+ -- \let\foo hello if we have previously \def\bar{hello}
1374+ contents <- bracedOrToken
1375+ return (name, contents)
1376+ contents' <- doMacros' 0 contents
1377+ return (name, Macro ExpandWhenDefined [] Nothing contents')
1378+
1379+defmacro :: PandocMonad m => LP m (Text, Macro)
1380+defmacro = try $
1381+ -- we use withVerbatimMode, because macros are to be expanded
1382+ -- at point of use, not point of definition
1383+ withVerbatimMode $ do
1384+ controlSeq "def"
1385+ Tok _ (CtrlSeq name) _ <- anyControlSeq
1386+ argspecs <- many (argspecArg <|> argspecPattern)
1387+ contents <- bracedOrToken
1388+ return (name, Macro ExpandWhenUsed argspecs Nothing contents)
1389+
1390+argspecArg :: PandocMonad m => LP m ArgSpec
1391+argspecArg = do
1392+ Tok _ (Arg i) _ <- satisfyTok isArgTok
1393+ return $ ArgNum i
1394+
1395+argspecPattern :: PandocMonad m => LP m ArgSpec
1396+argspecPattern =
1397+ Pattern <$> many1 (satisfyTok (\(Tok _ toktype' txt) ->
1398+ (toktype' == Symbol || toktype' == Word) &&
1399+ (txt /= "{" && txt /= "\\" && txt /= "}")))
1400+
1401+newcommand :: PandocMonad m => LP m (Text, Macro)
1402+newcommand = do
1403+ pos <- getPosition
1404+ Tok _ (CtrlSeq mtype) _ <- controlSeq "newcommand" <|>
1405+ controlSeq "renewcommand" <|>
1406+ controlSeq "providecommand" <|>
1407+ controlSeq "DeclareMathOperator" <|>
1408+ controlSeq "DeclareRobustCommand"
1409+ withVerbatimMode $ do
1410+ Tok _ (CtrlSeq name) txt <- do
1411+ optional (symbol '*')
1412+ anyControlSeq <|>
1413+ (symbol '{' *> spaces *> anyControlSeq <* spaces <* symbol '}')
1414+ spaces
1415+ numargs <- option 0 $ try bracketedNum
1416+ let argspecs = map ArgNum [1..numargs]
1417+ spaces
1418+ optarg <- option Nothing $ Just <$> try bracketedToks
1419+ spaces
1420+ contents' <- bracedOrToken
1421+ let contents =
1422+ case mtype of
1423+ "DeclareMathOperator" ->
1424+ Tok pos (CtrlSeq "mathop") "\\mathop"
1425+ : Tok pos Symbol "{"
1426+ : Tok pos (CtrlSeq "mathrm") "\\mathrm"
1427+ : Tok pos Symbol "{"
1428+ : (contents' ++
1429+ [ Tok pos Symbol "}", Tok pos Symbol "}" ])
1430+ _ -> contents'
1431+ macros <- sMacros <$> getState
1432+ case M.lookup name macros of
1433+ Just macro
1434+ | mtype == "newcommand" -> do
1435+ report $ MacroAlreadyDefined txt pos
1436+ return (name, macro)
1437+ | mtype == "providecommand" -> return (name, macro)
1438+ _ -> return (name, Macro ExpandWhenUsed argspecs optarg contents)
1439+
1440+newenvironment :: PandocMonad m => LP m (Maybe (Text, Macro, Macro))
1441+newenvironment = do
1442+ pos <- getPosition
1443+ Tok _ (CtrlSeq mtype) _ <- controlSeq "newenvironment" <|>
1444+ controlSeq "renewenvironment" <|>
1445+ controlSeq "provideenvironment"
1446+ withVerbatimMode $ do
1447+ optional $ symbol '*'
1448+ spaces
1449+ name <- untokenize <$> braced
1450+ spaces
1451+ numargs <- option 0 $ try bracketedNum
1452+ spaces
1453+ optarg <- option Nothing $ Just <$> try bracketedToks
1454+ let argspecs = map (\i -> ArgNum i) [1..numargs]
1455+ startcontents <- spaces >> bracedOrToken
1456+ endcontents <- spaces >> bracedOrToken
1457+ macros <- sMacros <$> getState
1458+ case M.lookup name macros of
1459+ Just _
1460+ | mtype == "newenvironment" -> do
1461+ report $ MacroAlreadyDefined name pos
1462+ return Nothing
1463+ | mtype == "provideenvironment" ->
1464+ return Nothing
1465+ _ -> return $ Just (name,
1466+ Macro ExpandWhenUsed argspecs optarg startcontents,
1467+ Macro ExpandWhenUsed [] Nothing endcontents)
1468+
1469+bracketedNum :: PandocMonad m => LP m Int
1470+bracketedNum = do
1471+ ds <- untokenize <$> bracketedToks
1472+ case safeRead ds of
1473+ Just i -> return i
1474+ _ -> return 0
1475+
1476+setCaption :: PandocMonad m => LP m ()
1477+setCaption = try $ do
1478+ skipopts
1479+ ils <- tok
1480+ optional $ try $ spaces *> label
1481+ updateState $ \st -> st{ sCaption = Just ils }
1482+
7381483looseItem :: PandocMonad m => LP m Blocks
7391484looseItem = do
7401485 inListItem <- sInListItem <$> getState
@@ -748,6 +1493,10 @@ epigraph = do
7481493 p2 <- grouped block
7491494 return $ divWith ("", ["epigraph"], []) (p1 <> p2)
7501495
1496+resetCaption :: PandocMonad m => LP m ()
1497+resetCaption = updateState $ \st -> st{ sCaption = Nothing
1498+ , sLastLabel = Nothing }
1499+
7511500section :: PandocMonad m => Attr -> Int -> LP m Blocks
7521501section (ident, classes, kvs) lvl = do
7531502 skipopts
@@ -840,7 +1589,7 @@ blockCommands = M.fromList
8401589 , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
8411590 , ("signature", mempty <$ (skipopts *> authors))
8421591 , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
843− , ("newtheorem", newtheorem inline)
1592+ , ("newtheorem", newtheorem)
8441593 , ("theoremstyle", theoremstyle)
8451594 -- KOMA-Script metadata commands
8461595 , ("extratitle", mempty <$ (skipopts *> tok >>= addMeta "extratitle"))
@@ -888,7 +1637,7 @@ blockCommands = M.fromList
8881637 , ("item", looseItem)
8891638 , ("documentclass", skipopts *> braced *> preamble)
8901639 , ("centerline", para . trimInlines <$> (skipopts *> tok))
891− , ("caption", mempty <$ setCaption inline)
1640+ , ("caption", mempty <$ setCaption)
8921641 , ("bibliography", mempty <$ (skipopts *> braced >>=
8931642 addMeta "bibliography" . splitBibs . untokenize))
8941643 , ("addbibresource", mempty <$ (skipopts *> braced >>=
@@ -926,8 +1675,7 @@ blockCommands = M.fromList
9261675
9271676
9281677environments :: PandocMonad m => M.Map Text (LP m Blocks)
929−environments = M.union (tableEnvironments blocks inline) $
930− M.fromList
1678+environments = M.fromList
9311679 [ ("document", env "document" blocks <* skipMany anyTok)
9321680 , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
9331681 , ("sloppypar", env "sloppypar" blocks)
@@ -937,6 +1685,13 @@ environments = M.union (tableEnvironments blocks inline) $
9371685 , ("figure", env "figure" $ skipopts *> figure)
9381686 , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
9391687 , ("center", divWith ("", ["center"], []) <$> env "center" blocks)
1688+ , ("longtable", env "longtable" $
1689+ resetCaption *> simpTable "longtable" False >>= addTableCaption)
1690+ , ("table", env "table" $
1691+ skipopts *> resetCaption *> blocks >>= addTableCaption)
1692+ , ("tabular*", env "tabular*" $ simpTable "tabular*" True)
1693+ , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1694+ , ("tabular", env "tabular" $ simpTable "tabular" False)
9401695 , ("quote", blockQuote <$> env "quote" blocks)
9411696 , ("quotation", blockQuote <$> env "quotation" blocks)
9421697 , ("verse", blockQuote <$> env "verse" blocks)
@@ -959,7 +1714,7 @@ environments = M.union (tableEnvironments blocks inline) $
9591714 , ("lilypond", rawVerbEnv "lilypond")
9601715 , ("ly", rawVerbEnv "ly")
9611716 -- amsthm
962− , ("proof", proof blocks opt)
1717+ , ("proof", proof)
9631718 -- etoolbox
9641719 , ("ifstrequal", ifstrequal)
9651720 , ("newtoggle", braced >>= newToggle)
@@ -980,17 +1735,131 @@ filecontents = try $ do
9801735 st{ sFileContents = M.insert fp txt (sFileContents st) }
9811736 return mempty
9821737
1738+theoremstyle :: PandocMonad m => LP m Blocks
1739+theoremstyle = do
1740+ stylename <- untokenize <$> braced
1741+ let mbstyle = case stylename of
1742+ "plain" -> Just PlainStyle
1743+ "definition" -> Just DefinitionStyle
1744+ "remark" -> Just RemarkStyle
1745+ _ -> Nothing
1746+ case mbstyle of
1747+ Nothing -> return ()
1748+ Just sty -> updateState $ \s -> s{ sLastTheoremStyle = sty }
1749+ return mempty
1750+
1751+newtheorem :: PandocMonad m => LP m Blocks
1752+newtheorem = do
1753+ number <- option True (False <$ symbol '*' <* sp)
1754+ name <- untokenize <$> braced
1755+ sp
1756+ series <- option Nothing $ Just . untokenize <$> bracketedToks
1757+ sp
1758+ showName <- tok
1759+ sp
1760+ syncTo <- option Nothing $ Just . untokenize <$> bracketedToks
1761+ sty <- sLastTheoremStyle <$> getState
1762+ let spec = TheoremSpec { theoremName = showName
1763+ , theoremStyle = sty
1764+ , theoremSeries = series
1765+ , theoremSyncTo = syncTo
1766+ , theoremNumber = number
1767+ , theoremLastNum = DottedNum [0] }
1768+ tmap <- sTheoremMap <$> getState
1769+ updateState $ \s -> s{ sTheoremMap =
1770+ M.insert name spec tmap }
1771+ return mempty
1772+
1773+proof :: PandocMonad m => LP m Blocks
1774+proof = do
1775+ title <- option (B.text "Proof") opt
1776+ bs <- env "proof" blocks
1777+ return $
1778+ B.divWith ("", ["proof"], []) $
1779+ addQed $ addTitle (B.emph (title <> ".")) bs
1780+
1781+addTitle :: Inlines -> Blocks -> Blocks
1782+addTitle ils bs =
1783+ case B.toList bs of
1784+ (Para xs : rest)
1785+ -> B.fromList (Para (B.toList ils ++ (Space : xs)) : rest)
1786+ _ -> B.para ils <> bs
1787+
1788+addQed :: Blocks -> Blocks
1789+addQed bs =
1790+ case Seq.viewr (B.unMany bs) of
1791+ s Seq.:> Para ils
1792+ -> B.Many (s Seq.|> Para (ils ++ B.toList qedSign))
1793+ _ -> bs <> B.para qedSign
1794+ where
1795+ qedSign = B.str "\xa0\x25FB"
1796+
9831797environment :: PandocMonad m => LP m Blocks
9841798environment = try $ do
9851799 controlSeq "begin"
9861800 name <- untokenize <$> braced
9871801 M.findWithDefault mzero name environments <|>
988− theoremEnvironment blocks opt name <|>
1802+ theoremEnvironment name <|>
9891803 if M.member name (inlineEnvironments
9901804 :: M.Map Text (LP PandocPure Inlines))
9911805 then mzero
9921806 else try (rawEnv name) <|> rawVerbEnv name
9931807
1808+theoremEnvironment :: PandocMonad m => Text -> LP m Blocks
1809+theoremEnvironment name = do
1810+ tmap <- sTheoremMap <$> getState
1811+ case M.lookup name tmap of
1812+ Nothing -> mzero
1813+ Just tspec -> do
1814+ optTitle <- option mempty $ (\x -> space <> "(" <> x <> ")") <$> opt
1815+ mblabel <- option Nothing $ Just . untokenize <$>
1816+ try (spaces >> controlSeq "label" >> spaces >> braced)
1817+ bs <- env name blocks
1818+ number <-
1819+ if theoremNumber tspec
1820+ then do
1821+ let name' = fromMaybe name $ theoremSeries tspec
1822+ num <- getNextNumber
1823+ (maybe (DottedNum [0]) theoremLastNum .
1824+ M.lookup name' . sTheoremMap)
1825+ updateState $ \s ->
1826+ s{ sTheoremMap =
1827+ M.adjust
1828+ (\spec -> spec{ theoremLastNum = num })
1829+ name'
1830+ (sTheoremMap s)
1831+ }
1832+
1833+ case mblabel of
1834+ Just ident ->
1835+ updateState $ \s ->
1836+ s{ sLabels = M.insert ident
1837+ (B.toList $
1838+ theoremName tspec <> "\160" <>
1839+ str (renderDottedNum num)) (sLabels s) }
1840+ Nothing -> return ()
1841+ return $ space <> B.text (renderDottedNum num)
1842+ else return mempty
1843+ let titleEmph = case theoremStyle tspec of
1844+ PlainStyle -> B.strong
1845+ DefinitionStyle -> B.strong
1846+ RemarkStyle -> B.emph
1847+ let title = titleEmph (theoremName tspec <> number)
1848+ <> optTitle <> "." <> space
1849+ return $ divWith (fromMaybe "" mblabel, [name], []) $ addTitle title
1850+ $ case theoremStyle tspec of
1851+ PlainStyle -> walk italicize bs
1852+ _ -> bs
1853+
1854+italicize :: Block -> Block
1855+italicize x@(Para [Image{}]) = x -- see #6925
1856+italicize (Para ils) = Para [Emph ils]
1857+italicize (Plain ils) = Plain [Emph ils]
1858+italicize x = x
1859+
1860+env :: PandocMonad m => Text -> LP m a -> LP m a
1861+env name p = p <* end_ name
1862+
9941863rawEnv :: PandocMonad m => Text -> LP m Blocks
9951864rawEnv name = do
9961865 exts <- getOption readerExtensions
@@ -1162,8 +2031,7 @@ inputListing = do
11622031 let (ident,classes,kvs) = parseListingsOptions options
11632032 let classes' =
11642033 (case listingsLanguage options of
1165− Nothing -> (take 1 (languagesByExtension defaultSyntaxMap
1166− (T.pack $ takeExtension $ T.unpack f)) <>)
2034+ Nothing -> (take 1 (languagesByExtension (T.pack $ takeExtension $ T.unpack f)) <>)
11672035 Just _ -> id) classes
11682036 let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead
11692037 let lastline = fromMaybe (length codeLines) $
@@ -1229,23 +2097,356 @@ orderedList' = try $ do
12292097 bs <- listenv "enumerate" (many item)
12302098 return $ orderedListWith (start, style, delim) bs
12312099
2100+-- tables
2101+
2102+hline :: PandocMonad m => LP m ()
2103+hline = try $ do
2104+ spaces
2105+ controlSeq "hline" <|>
2106+ -- booktabs rules:
2107+ controlSeq "toprule" <|>
2108+ controlSeq "bottomrule" <|>
2109+ controlSeq "midrule" <|>
2110+ controlSeq "endhead" <|>
2111+ controlSeq "endfirsthead"
2112+ spaces
2113+ optional opt
2114+ return ()
2115+
2116+lbreak :: PandocMonad m => LP m Tok
2117+lbreak = (controlSeq "\\" <|> controlSeq "tabularnewline")
2118+ <* skipopts <* spaces
2119+
2120+amp :: PandocMonad m => LP m Tok
2121+amp = symbol '&'
2122+
2123+-- Split a Word into individual Symbols (for parseAligns)
2124+splitWordTok :: PandocMonad m => LP m ()
2125+splitWordTok = do
2126+ inp <- getInput
2127+ case inp of
2128+ (Tok spos Word t : rest) ->
2129+ setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) <> rest
2130+ _ -> return ()
2131+
2132+parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
2133+parseAligns = try $ do
2134+ let maybeBar = skipMany
2135+ (try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced)))
2136+ let cAlign = AlignCenter <$ symbol 'c'
2137+ let lAlign = AlignLeft <$ symbol 'l'
2138+ let rAlign = AlignRight <$ symbol 'r'
2139+ let parAlign = AlignLeft <$ symbol 'p'
2140+ -- aligns from tabularx
2141+ let xAlign = AlignLeft <$ symbol 'X'
2142+ let mAlign = AlignLeft <$ symbol 'm'
2143+ let bAlign = AlignLeft <$ symbol 'b'
2144+ let alignChar = splitWordTok *> ( cAlign <|> lAlign <|> rAlign <|> parAlign
2145+ <|> xAlign <|> mAlign <|> bAlign )
2146+ let alignPrefix = symbol '>' >> braced
2147+ let alignSuffix = symbol '<' >> braced
2148+ let colWidth = try $ do
2149+ symbol '{'
2150+ ds <- trim . untokenize <$> manyTill anyTok (controlSeq "linewidth")
2151+ spaces
2152+ symbol '}'
2153+ return $ safeRead ds
2154+ let alignSpec = do
2155+ pref <- option [] alignPrefix
2156+ spaces
2157+ al <- alignChar
2158+ width <- colWidth <|> option Nothing (do s <- untokenize <$> braced
2159+ pos <- getPosition
2160+ report $ SkippedContent s pos
2161+ return Nothing)
2162+ spaces
2163+ suff <- option [] alignSuffix
2164+ return (al, width, (pref, suff))
2165+ let starAlign = do -- '*{2}{r}' == 'rr', we just expand like a macro
2166+ symbol '*'
2167+ spaces
2168+ ds <- trim . untokenize <$> braced
2169+ spaces
2170+ spec <- braced
2171+ case safeRead ds of
2172+ Just n ->
2173+ getInput >>= setInput . (mconcat (replicate n spec) ++)
2174+ Nothing -> Prelude.fail $ "Could not parse " <> T.unpack ds <> " as number"
2175+ bgroup
2176+ spaces
2177+ maybeBar
2178+ aligns' <- many $ try $ spaces >> optional starAlign >>
2179+ (alignSpec <* maybeBar)
2180+ spaces
2181+ egroup
2182+ spaces
2183+ return $ map toSpec aligns'
2184+ where
2185+ toColWidth (Just w) | w > 0 = ColWidth w
2186+ toColWidth _ = ColWidthDefault
2187+ toSpec (x, y, z) = (x, toColWidth y, z)
2188+
2189+-- N.B. this parser returns a Row that may have erroneous empty cells
2190+-- in it. See the note above fixTableHead for details.
2191+parseTableRow :: PandocMonad m
2192+ => Text -- ^ table environment name
2193+ -> [([Tok], [Tok])] -- ^ pref/suffixes
2194+ -> LP m Row
2195+parseTableRow envname prefsufs = do
2196+ notFollowedBy (spaces *> end_ envname)
2197+ -- add prefixes and suffixes in token stream:
2198+ let celltoks (pref, suff) = do
2199+ prefpos <- getPosition
2200+ contents <- mconcat <$>
2201+ many ( snd <$> withRaw (controlSeq "parbox" >> parbox) -- #5711
2202+ <|>
2203+ snd <$> withRaw (inlineEnvironment <|> dollarsMath)
2204+ <|>
2205+ (do notFollowedBy
2206+ (() <$ amp <|> () <$ lbreak <|> end_ envname)
2207+ count 1 anyTok) )
2208+
2209+ suffpos <- getPosition
2210+ option [] (count 1 amp)
2211+ return $ map (setpos prefpos) pref ++ contents ++ map (setpos suffpos) suff
2212+ rawcells <- mapM celltoks prefsufs
2213+ cells <- mapM (parseFromToks parseTableCell) rawcells
2214+ spaces
2215+ return $ Row nullAttr cells
2216+
2217+parseTableCell :: PandocMonad m => LP m Cell
2218+parseTableCell = do
2219+ spaces
2220+ updateState $ \st -> st{ sInTableCell = True }
2221+ cell' <- multicolumnCell
2222+ <|> multirowCell
2223+ <|> parseSimpleCell
2224+ <|> parseEmptyCell
2225+ updateState $ \st -> st{ sInTableCell = False }
2226+ spaces
2227+ return cell'
2228+ where
2229+ -- The parsing of empty cells is important in LaTeX, especially when dealing
2230+ -- with multirow/multicolumn. See #6603.
2231+ parseEmptyCell = spaces $> emptyCell
2232+
2233+cellAlignment :: PandocMonad m => LP m Alignment
2234+cellAlignment = skipMany (symbol '|') *> alignment <* skipMany (symbol '|')
2235+ where
2236+ alignment = do
2237+ c <- untoken <$> singleChar
2238+ return $ case c of
2239+ "l" -> AlignLeft
2240+ "r" -> AlignRight
2241+ "c" -> AlignCenter
2242+ "*" -> AlignDefault
2243+ _ -> AlignDefault
2244+
2245+plainify :: Blocks -> Blocks
2246+plainify bs = case toList bs of
2247+ [Para ils] -> plain (fromList ils)
2248+ _ -> bs
2249+
2250+multirowCell :: PandocMonad m => LP m Cell
2251+multirowCell = controlSeq "multirow" >> do
2252+ -- Full prototype for \multirow macro is:
2253+ -- \multirow[vpos]{nrows}[bigstruts]{width}[vmove]{text}
2254+ -- However, everything except `nrows` and `text` make
2255+ -- sense in the context of the Pandoc AST
2256+ _ <- optional $ symbol '[' *> cellAlignment <* symbol ']' -- vertical position
2257+ nrows <- fmap (fromMaybe 1 . safeRead . untokenize) braced
2258+ _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- bigstrut-related
2259+ _ <- symbol '{' *> manyTill anyTok (symbol '}') -- Cell width
2260+ _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- Length used for fine-tuning
2261+ content <- symbol '{' *> (plainify <$> blocks) <* symbol '}'
2262+ return $ cell AlignDefault (RowSpan nrows) (ColSpan 1) content
2263+
2264+multicolumnCell :: PandocMonad m => LP m Cell
2265+multicolumnCell = controlSeq "multicolumn" >> do
2266+ span' <- fmap (fromMaybe 1 . safeRead . untokenize) braced
2267+ alignment <- symbol '{' *> cellAlignment <* symbol '}'
2268+
2269+ let singleCell = do
2270+ content <- plainify <$> blocks
2271+ return $ cell alignment (RowSpan 1) (ColSpan span') content
2272+
2273+ -- Two possible contents: either a \multirow cell, or content.
2274+ -- E.g. \multicol{1}{c}{\multirow{2}{1em}{content}}
2275+ -- Note that a \multirow cell can be nested in a \multicolumn,
2276+ -- but not the other way around. See #6603
2277+ let nestedCell = do
2278+ (Cell _ _ (RowSpan rs) _ bs) <- multirowCell
2279+ return $ cell
2280+ alignment
2281+ (RowSpan rs)
2282+ (ColSpan span')
2283+ (fromList bs)
2284+
2285+ symbol '{' *> (nestedCell <|> singleCell) <* symbol '}'
2286+
2287+-- Parse a simple cell, i.e. not multirow/multicol
2288+parseSimpleCell :: PandocMonad m => LP m Cell
2289+parseSimpleCell = simpleCell <$> (plainify <$> blocks)
2290+
2291+-- LaTeX tables are stored with empty cells underneath multirow cells
2292+-- denoting the grid spaces taken up by them. More specifically, if a
2293+-- cell spans m rows, then it will overwrite all the cells in the
2294+-- columns it spans for (m-1) rows underneath it, requiring padding
2295+-- cells in these places. These padding cells need to be removed for
2296+-- proper table reading. See #6603.
2297+--
2298+-- These fixTable functions do not otherwise fix up malformed
2299+-- input tables: that is left to the table builder.
2300+fixTableHead :: TableHead -> TableHead
2301+fixTableHead (TableHead attr rows) = TableHead attr rows'
2302+ where
2303+ rows' = fixTableRows rows
2304+
2305+fixTableBody :: TableBody -> TableBody
2306+fixTableBody (TableBody attr rhc th tb)
2307+ = TableBody attr rhc th' tb'
2308+ where
2309+ th' = fixTableRows th
2310+ tb' = fixTableRows tb
2311+
2312+fixTableRows :: [Row] -> [Row]
2313+fixTableRows = fixTableRows' $ repeat Nothing
2314+ where
2315+ fixTableRows' oldHang (Row attr cells : rs)
2316+ = let (newHang, cells') = fixTableRow oldHang cells
2317+ rs' = fixTableRows' newHang rs
2318+ in Row attr cells' : rs'
2319+ fixTableRows' _ [] = []
2320+
2321+-- The overhang is represented as Just (relative cell dimensions) or
2322+-- Nothing for an empty grid space.
2323+fixTableRow :: [Maybe (ColSpan, RowSpan)] -> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])
2324+fixTableRow oldHang cells
2325+ -- If there's overhang, drop cells until their total width meets the
2326+ -- width of the occupied grid spaces (or we run out)
2327+ | (n, prefHang, restHang) <- splitHang oldHang
2328+ , n > 0
2329+ = let cells' = dropToWidth getCellW n cells
2330+ (restHang', cells'') = fixTableRow restHang cells'
2331+ in (prefHang restHang', cells'')
2332+ -- Otherwise record the overhang of a pending cell and fix the rest
2333+ -- of the row
2334+ | c@(Cell _ _ h w _):cells' <- cells
2335+ = let h' = max 1 h
2336+ w' = max 1 w
2337+ oldHang' = dropToWidth getHangW w' oldHang
2338+ (newHang, cells'') = fixTableRow oldHang' cells'
2339+ in (toHang w' h' <> newHang, c : cells'')
2340+ | otherwise
2341+ = (oldHang, [])
2342+ where
2343+ getCellW (Cell _ _ _ w _) = w
2344+ getHangW = maybe 1 fst
2345+ getCS (ColSpan n) = n
2346+
2347+ toHang c r
2348+ | r > 1 = [Just (c, r)]
2349+ | otherwise = replicate (getCS c) Nothing
2350+
2351+ -- Take the prefix of the overhang list representing filled grid
2352+ -- spaces. Also return the remainder and the length of this prefix.
2353+ splitHang = splitHang' 0 id
2354+
2355+ splitHang' !n l (Just (c, r):xs)
2356+ = splitHang' (n + c) (l . (toHang c (r-1) ++)) xs
2357+ splitHang' n l xs = (n, l, xs)
2358+
2359+ -- Drop list items until the total width of the dropped items
2360+ -- exceeds the passed width.
2361+ dropToWidth _ n l | n < 1 = l
2362+ dropToWidth wproj n (c:cs) = dropToWidth wproj (n - wproj c) cs
2363+ dropToWidth _ _ [] = []
2364+
2365+simpTable :: PandocMonad m => Text -> Bool -> LP m Blocks
2366+simpTable envname hasWidthParameter = try $ do
2367+ when hasWidthParameter $ () <$ (spaces >> tok)
2368+ skipopts
2369+ colspecs <- parseAligns
2370+ let (aligns, widths, prefsufs) = unzip3 colspecs
2371+ optional $ controlSeq "caption" *> setCaption
2372+ spaces
2373+ optional label
2374+ spaces
2375+ optional lbreak
2376+ spaces
2377+ skipMany hline
2378+ spaces
2379+ header' <- option [] . try . fmap (:[]) $
2380+ parseTableRow envname prefsufs <* lbreak <* many1 hline
2381+ spaces
2382+ rows <- sepEndBy (parseTableRow envname prefsufs)
2383+ (lbreak <* optional (skipMany hline))
2384+ spaces
2385+ optional $ controlSeq "caption" *> setCaption
2386+ spaces
2387+ optional label
2388+ spaces
2389+ optional lbreak
2390+ spaces
2391+ lookAhead $ controlSeq "end" -- make sure we're at end
2392+ let th = fixTableHead $ TableHead nullAttr header'
2393+ let tbs = [fixTableBody $ TableBody nullAttr 0 [] rows]
2394+ let tf = TableFoot nullAttr []
2395+ return $ table emptyCaption (zip aligns widths) th tbs tf
2396+
2397+addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
2398+addTableCaption = walkM go
2399+ where go (Table attr c spec th tb tf) = do
2400+ st <- getState
2401+ let mblabel = sLastLabel st
2402+ capt <- case (sCaption st, mblabel) of
2403+ (Just ils, Nothing) -> return $ caption Nothing (plain ils)
2404+ (Just ils, Just lab) -> do
2405+ num <- getNextNumber sLastTableNum
2406+ setState
2407+ st{ sLastTableNum = num
2408+ , sLabels = M.insert lab
2409+ [Str (renderDottedNum num)]
2410+ (sLabels st) }
2411+ return $ caption Nothing (plain ils) -- add number??
2412+ (Nothing, _) -> return c
2413+ let attr' = case (attr, mblabel) of
2414+ ((_,classes,kvs), Just ident) ->
2415+ (ident,classes,kvs)
2416+ _ -> attr
2417+ return $ addAttrDiv attr' $ Table nullAttr capt spec th tb tf
2418+ go x = return x
2419+
2420+-- TODO: For now we add a Div to contain table attributes, since
2421+-- most writers don't do anything yet with attributes on Table.
2422+-- This can be removed when that changes.
2423+addAttrDiv :: Attr -> Block -> Block
2424+addAttrDiv ("",[],[]) b = b
2425+addAttrDiv attr b = Div attr [b]
2426+
12322427block :: PandocMonad m => LP m Blocks
12332428block = do
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
2429+ res <- (mempty <$ spaces1)
2430+ <|> environment
2431+ <|> macroDef (rawBlock "latex")
2432+ <|> blockCommand
2433+ <|> paragraph
2434+ <|> grouped block
12462435 trace (T.take 60 $ tshow $ B.toList res)
12472436 return res
12482437
12492438blocks :: PandocMonad m => LP m Blocks
12502439blocks = mconcat <$> many block
12512440
2441+setDefaultLanguage :: PandocMonad m => LP m Blocks
2442+setDefaultLanguage = do
2443+ o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')
2444+ <$> rawopt
2445+ polylang <- untokenize <$> braced
2446+ case M.lookup polylang polyglossiaLangToBCP47 of
2447+ Nothing -> return mempty -- TODO mzero? warning?
2448+ Just langFunc -> do
2449+ let l = langFunc o
2450+ setTranslations l
2451+ updateState $ setMeta "lang" $ str (renderLang l)
2452+ return mempty