@@ -1340,17 +1340,15 @@ inline = choice [ whitespace
13401340 , str
13411341 , endline
13421342 , code
1343− , fours
1344− , strong
1345− , emph
1343+ , strongOrEmph
13461344 , note
13471345 , cite
13481346 , link
13491347 , image
13501348 , math
13511349 , strikeout
1352− , superscript
13531350 , subscript
1351+ , superscript
13541352 , inlineNote -- after superscript because of ^[link](/foo)^
13551353 , autoLink
13561354 , rawHtmlInline
@@ -1455,14 +1453,58 @@ mathInlineWith op cl = try $ do
14551453 notFollowedBy digit -- to prevent capture of $5
14561454 return $ concat words'
14571455
1458−-- to avoid performance problems, treat 4 or more _ or * or ~ or ^ in a row
1459−-- as a literal rather than attempting to parse for emph/strong/strikeout/super/sub
1460−fours :: Parser [Char] st (F Inlines)
1461−fours = try $ do
1462− x <- char '*' <|> char '_' <|> char '~' <|> char '^'
1463− count 2 $ satisfy (==x)
1464− rest <- many1 (satisfy (==x))
1465− return $ return $ B.str (x:x:x:rest)
1456+-- Parses material enclosed in *s, **s, _s, or __s.
1457+-- Designed to avoid backtracking.
1458+enclosure :: Char
1459+ -> MarkdownParser (F Inlines)
1460+enclosure c = do
1461+ cs <- many1 (char c)
1462+ (return (B.str cs) <>) <$> whitespace
1463+ <|> case length cs of
1464+ 3 -> three c
1465+ 2 -> two c mempty
1466+ 1 -> one c mempty
1467+ _ -> return (return $ B.str cs)
1468+
1469+-- Parse inlines til you hit one c or a sequence of two cs.
1470+-- If one c, emit emph and then parse two.
1471+-- If two cs, emit strong and then parse one.
1472+three :: Char -> MarkdownParser (F Inlines)
1473+three c = do
1474+ contents <- mconcat <$> many (notFollowedBy (char c) >> inline)
1475+ (try (string [c,c,c]) >> return ((B.strong . B.emph) <$> contents))
1476+ <|> (try (string [c,c]) >> one c (B.strong <$> contents))
1477+ <|> (char c >> two c (B.emph <$> contents))
1478+ <|> return (return (B.str [c,c,c]) <> contents)
1479+
1480+-- Parse inlines til you hit two c's, and emit strong.
1481+-- If you never do hit two cs, emit ** plus inlines parsed.
1482+two :: Char -> F Inlines -> MarkdownParser (F Inlines)
1483+two c prefix' = do
1484+ let ender = try $ string [c,c]
1485+ contents <- mconcat <$> many (try $ notFollowedBy ender >> inline)
1486+ (ender >> return (B.strong <$> (prefix' <> contents)))
1487+ <|> return (return (B.str [c,c]) <> (prefix' <> contents))
1488+
1489+-- Parse inlines til you hit a c, and emit emph.
1490+-- If you never hit a c, emit * plus inlines parsed.
1491+one :: Char -> F Inlines -> MarkdownParser (F Inlines)
1492+one c prefix' = do
1493+ contents <- mconcat <$> many ( (notFollowedBy (char c) >> inline)
1494+ <|> try (string [c,c] >>
1495+ notFollowedBy (char c) >>
1496+ two c prefix') )
1497+ (char c >> return (B.emph <$> (prefix' <> contents)))
1498+ <|> return (return (B.str [c]) <> (prefix' <> contents))
1499+
1500+strongOrEmph :: MarkdownParser (F Inlines)
1501+strongOrEmph = enclosure '*' <|> (checkIntraword >> enclosure '_')
1502+ where checkIntraword = do
1503+ exts <- getOption readerExtensions
1504+ when (Ext_intraword_underscores `Set.member` exts) $ do
1505+ pos <- getPosition
1506+ lastStrPos <- stateLastStrPos <$> getState
1507+ guard $ lastStrPos /= Just pos
14661508
14671509-- | Parses a list of inlines between start and end delimiters.
14681510inlinesBetween :: (Show b)
@@ -1474,28 +1516,6 @@ inlinesBetween start end =
14741516 where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)
14751517 innerSpace = try $ whitespace >>~ notFollowedBy' end
14761518
1477−emph :: MarkdownParser (F Inlines)
1478−emph = fmap B.emph <$> nested
1479− (inlinesBetween starStart starEnd <|> inlinesBetween ulStart ulEnd)
1480− where starStart = char '*' >> lookAhead nonspaceChar
1481− starEnd = notFollowedBy' (() <$ strong) >> char '*'
1482− ulStart = checkIntraword >> char '_' >> lookAhead nonspaceChar
1483− ulEnd = notFollowedBy' (() <$ strong) >> char '_'
1484− checkIntraword = do
1485− exts <- getOption readerExtensions
1486− when (Ext_intraword_underscores `Set.member` exts) $ do
1487− pos <- getPosition
1488− lastStrPos <- stateLastStrPos <$> getState
1489− guard $ lastStrPos /= Just pos
1490−
1491−strong :: MarkdownParser (F Inlines)
1492−strong = fmap B.strong <$> nested
1493− (inlinesBetween starStart starEnd <|> inlinesBetween ulStart ulEnd)
1494− where starStart = string "**" >> lookAhead nonspaceChar
1495− starEnd = try $ string "**"
1496− ulStart = string "__" >> lookAhead nonspaceChar
1497− ulEnd = try $ string "__"
1498−
14991519strikeout :: MarkdownParser (F Inlines)
15001520strikeout = fmap B.strikeout <$>
15011521 (guardEnabled Ext_strikeout >> inlinesBetween strikeStart strikeEnd)