From 7048c130ec9d128dd1c9d1ddf8e7ce3c15eaf435 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 18 Aug 2013 23:01:23 -0700 Subject: Create Cite element even if no matching reference in the biblio. * Add ??? as fallback text for non-resolved citations. * Biblio: Put references (including a header at the end of the document, if one exists) inside a Div with class "references". This gives some control over styling of references, and allows scripts to manipulate them. * Markdown writer: Print markdown citation codes, and disable printing of references, if `citations` extension is enabled. NOTE: It would be good to improve what citeproc-hs does for a nonexistent key. --- src/Text/Pandoc/Biblio.hs | 5 ++++- src/Text/Pandoc/Readers/Markdown.hs | 21 ++++++++++++--------- src/Text/Pandoc/Writers/Markdown.hs | 35 +++++++++++++++++++++-------------- 3 files changed, 37 insertions(+), 24 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs index 206b38530..1c0975f11 100644 --- a/src/Text/Pandoc/Biblio.hs +++ b/src/Text/Pandoc/Biblio.hs @@ -55,7 +55,10 @@ processBiblio (Just style) r p = cits_map = M.fromList $ zip grps (citations result) biblioList = map (renderPandoc' style) (bibliography result) Pandoc m b = bottomUp mvPunct . deNote . topDown (processCite style cits_map) $ p' - in Pandoc m $ b ++ biblioList + (bs, lastb) = case reverse b of + x@(Header _ _ _) : xs -> (reverse xs, [x]) + _ -> (b, []) + in Pandoc m $ bs ++ [Div ("",["references"],[]) (lastb ++ biblioList)] -- | Substitute 'Cite' elements with formatted citations. processCite :: Style -> M.Map [Citation] [FormattedOutput] -> Inline -> Inline diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index a653c2e98..05662d9b5 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -55,7 +55,6 @@ import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock ) import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockTag, isTextTag, isCommentTag ) import Text.Pandoc.Biblio (processBiblio) -import qualified Text.CSL as CSL import Data.Monoid (mconcat, mempty) import Control.Applicative ((<$>), (<*), (*>), (<$)) import Control.Monad @@ -1797,11 +1796,13 @@ rawHtmlInline = do cite :: MarkdownParser (F Inlines) cite = do guardEnabled Ext_citations - getOption readerReferences >>= guard . not . null - citations <- textualCite <|> normalCite - return $ flip B.cite mempty <$> citations + citations <- textualCite <|> (fmap (flip B.cite unknownC) <$> normalCite) + return citations + +unknownC :: Inlines +unknownC = B.str "???" -textualCite :: MarkdownParser (F [Citation]) +textualCite :: MarkdownParser (F Inlines) textualCite = try $ do (_, key) <- citeKey let first = Citation{ citationId = key @@ -1813,8 +1814,12 @@ textualCite = try $ do } mbrest <- option Nothing $ try $ spnl >> Just <$> normalCite case mbrest of - Just rest -> return $ (first:) <$> rest - Nothing -> option (return [first]) $ bareloc first + Just rest -> return $ (flip B.cite unknownC . (first:)) <$> rest + Nothing -> (fmap (flip B.cite unknownC) <$> bareloc first) <|> + return (do st <- askF + return $ case M.lookup key (stateExamples st) of + Just n -> B.str (show n) + _ -> B.cite [first] unknownC) bareloc :: Citation -> MarkdownParser (F [Citation]) bareloc c = try $ do @@ -1846,8 +1851,6 @@ citeKey = try $ do let internal p = try $ p >>~ lookAhead (letter <|> digit) rest <- many $ letter <|> digit <|> internal (oneOf ":.#$%&-_+?<>~/") let key = first:rest - citations' <- map CSL.refId <$> getOption readerReferences - guard $ key `elem` citations' return (suppress_author, key) suffix :: MarkdownParser (F Inlines) diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 623c445df..d617954dd 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -186,7 +186,12 @@ pandocToMarkdown opts (Pandoc meta blocks) = do let toc = if writerTableOfContents opts then tableOfContents opts headerBlocks else empty - body <- blockListToMarkdown opts blocks + -- Strip off final 'references' header if markdown citations enabled + let blocks' = case reverse blocks of + (Div (_,["references"],_) _):xs + | isEnabled Ext_citations opts -> reverse xs + _ -> blocks + body <- blockListToMarkdown opts blocks' st <- get notes' <- notesToMarkdown opts (reverse $ stNotes st) st' <- get -- note that the notes may contain refs @@ -304,10 +309,10 @@ blockToMarkdown _ Null = return empty blockToMarkdown opts (Div attrs ils) = do isPlain <- gets stPlain contents <- blockListToMarkdown opts ils - return $ if isPlain + return $ if isPlain || not (isEnabled Ext_markdown_in_html_blocks opts) then contents <> blankline else tagWithAttrs "div" attrs <> blankline <> - contents <> blankline <> "" <> blankline + contents <> blankline <> "" <> blankline blockToMarkdown opts (Plain inlines) = do contents <- inlineListToMarkdown opts inlines return $ contents <> cr @@ -711,17 +716,20 @@ inlineToMarkdown opts (LineBreak) | isEnabled Ext_escaped_line_breaks opts = return $ "\\" <> cr | otherwise = return $ " " <> cr inlineToMarkdown _ Space = return space -inlineToMarkdown opts (Cite (c:cs) lst@[RawInline "latex" _]) +inlineToMarkdown opts (Cite [] lst) = inlineListToMarkdown opts lst +inlineToMarkdown opts (Cite (c:cs) lst) | not (isEnabled Ext_citations opts) = inlineListToMarkdown opts lst - | citationMode c == AuthorInText = do - suffs <- inlineListToMarkdown opts $ citationSuffix c - rest <- mapM convertOne cs - let inbr = suffs <+> joincits rest - br = if isEmpty inbr then empty else char '[' <> inbr <> char ']' - return $ text ("@" ++ citationId c) <+> br - | otherwise = do - cits <- mapM convertOne (c:cs) - return $ text "[" <> joincits cits <> text "]" + | otherwise = + if citationMode c == AuthorInText + then do + suffs <- inlineListToMarkdown opts $ citationSuffix c + rest <- mapM convertOne cs + let inbr = suffs <+> joincits rest + br = if isEmpty inbr then empty else char '[' <> inbr <> char ']' + return $ text ("@" ++ citationId c) <+> br + else do + cits <- mapM convertOne (c:cs) + return $ text "[" <> joincits cits <> text "]" where joincits = hcat . intersperse (text "; ") . filter (not . isEmpty) convertOne Citation { citationId = k @@ -738,7 +746,6 @@ inlineToMarkdown opts (Cite (c:cs) lst@[RawInline "latex" _]) return $ pdoc <+> r modekey SuppressAuthor = "-" modekey _ = "" -inlineToMarkdown opts (Cite _ lst) = inlineListToMarkdown opts lst inlineToMarkdown opts (Link txt (src, tit)) = do linktext <- inlineListToMarkdown opts txt let linktitle = if null tit -- cgit v1.2.3