git.iko.soy/typeable/pandoc
on master help sign in
HTML Reader: Added support for anchors on links and list items
7c1f867Matthew Pickering
src/Text/Pandoc/Readers/HTML.hs+22−4
compare with master
unifiedsplit
@@ -217,9 +217,15 @@ pBulletList = try $ do
217 -- note: if they have an <ol> or <ul> not in scope of a <li>,
217 -- note: if they have an <ol> or <ul> not in scope of a <li>,
218 -- treat it as a list item, though it's not valid xhtml...
218 -- treat it as a list item, though it's not valid xhtml...
219 skipMany nonItem
219 skipMany nonItem
220− items <- manyTill (pInTags "li" block <* skipMany nonItem) (pCloses "ul")
220+ items <- manyTill (pListItem nonItem) (pCloses "ul")
221 return $ B.bulletList $ map (fixPlains True) items
221 return $ B.bulletList $ map (fixPlains True) items
222
222
223+pListItem :: TagParser a -> TagParser Blocks
224+pListItem nonItem = do
225+ TagOpen _ attr <- lookAhead $ pSatisfy (~== TagOpen "li" [])
226+ let liDiv = maybe mempty (\x -> B.divWith (x, [], []) mempty) (lookup "id" attr)
227+ (liDiv <>) <$> pInTags "li" block <* skipMany nonItem
228+
223pOrderedList :: TagParser Blocks
229pOrderedList :: TagParser Blocks
224pOrderedList = try $ do
230pOrderedList = try $ do
225 TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" [])
231 TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" [])
@@ -245,7 +251,7 @@ pOrderedList = try $ do
245 -- note: if they have an <ol> or <ul> not in scope of a <li>,
251 -- note: if they have an <ol> or <ul> not in scope of a <li>,
246 -- treat it as a list item, though it's not valid xhtml...
252 -- treat it as a list item, though it's not valid xhtml...
247 skipMany nonItem
253 skipMany nonItem
248− items <- manyTill (pInTags "li" block <* skipMany nonItem) (pCloses "ol")
254+ items <- manyTill (pListItem nonItem) (pCloses "ol")
249 return $ B.orderedListWith (start, style, DefaultDelim) $ map (fixPlains True) items
255 return $ B.orderedListWith (start, style, DefaultDelim) $ map (fixPlains True) items
250
256
251pDefinitionList :: TagParser Blocks
257pDefinitionList :: TagParser Blocks
@@ -518,12 +524,24 @@ pLineBreak = do
518 return B.linebreak
524 return B.linebreak
519
525
520pLink :: TagParser Inlines
526pLink :: TagParser Inlines
527+pLink = pRelLink <|> pAnchor
528+
529+pAnchor :: TagParser Inlines
530+pAnchor = try $ do
531+ tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "id"))
532+ return $ B.spanWith (fromAttrib "id" tag , [], []) mempty
533+
534+pRelLink :: TagParser Inlines
521−pLink = try $ do
535+pRelLink = try $ do
522 tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
536 tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
523 let url = fromAttrib "href" tag
537 let url = fromAttrib "href" tag
524 let title = fromAttrib "title" tag
538 let title = fromAttrib "title" tag
539+ let uid = fromAttrib "id" tag
540+ let spanC = case uid of
541+ [] -> id
542+ s -> B.spanWith (s, [], [])
525 lab <- trimInlines . mconcat <$> manyTill inline (pCloses "a")
543 lab <- trimInlines . mconcat <$> manyTill inline (pCloses "a")
526− return $ B.link (escapeURI url) title lab
544+ return $ spanC $ B.link (escapeURI url) title lab
527
545
528pImage :: TagParser Inlines
546pImage :: TagParser Inlines
529pImage = do
547pImage = do