aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Parsing.hs4
-rw-r--r--src/Text/Pandoc/Pretty.hs32
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs59
3 files changed, 54 insertions, 41 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 66ebca253..b25fca100 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -408,7 +408,7 @@ emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)
-- Schemes from http://www.iana.org/assignments/uri-schemes.html plus
--- the unofficial schemes coap, doi, javascript.
+-- the unofficial schemes coap, doi, javascript, isbn, pmid
schemes :: [String]
schemes = ["coap","doi","javascript","aaa","aaas","about","acap","cap","cid",
"crid","data","dav","dict","dns","file","ftp","geo","go","gopher",
@@ -430,7 +430,7 @@ schemes = ["coap","doi","javascript","aaa","aaas","about","acap","cap","cid",
"rtmp","secondlife","sftp","sgn","skype","smb","soldat","spotify",
"ssh","steam","svn","teamspeak","things","udp","unreal","ut2004",
"ventrilo","view-source","webcal","wtai","wyciwyg","xfire","xri",
- "ymsgr"]
+ "ymsgr", "isbn", "pmid"]
uriScheme :: Stream s m Char => ParserT s st m String
uriScheme = oneOfStringsCI schemes
diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs
index d25ba725f..1e72c2040 100644
--- a/src/Text/Pandoc/Pretty.hs
+++ b/src/Text/Pandoc/Pretty.hs
@@ -35,6 +35,7 @@ module Text.Pandoc.Pretty (
, render
, cr
, blankline
+ , blanklines
, space
, text
, char
@@ -100,7 +101,7 @@ data D = Text Int String
| BreakingSpace
| CarriageReturn
| NewLine
- | BlankLine
+ | BlankLines Int -- number of blank lines
deriving (Show)
newtype Doc = Doc { unDoc :: Seq D }
@@ -113,7 +114,7 @@ isBlank :: D -> Bool
isBlank BreakingSpace = True
isBlank CarriageReturn = True
isBlank NewLine = True
-isBlank BlankLine = True
+isBlank (BlankLines _) = True
isBlank (Text _ (c:_)) = isSpace c
isBlank _ = False
@@ -190,7 +191,7 @@ vsep = foldr ($+$) empty
nestle :: Doc -> Doc
nestle (Doc d) = Doc $ go d
where go x = case viewl x of
- (BlankLine :< rest) -> go rest
+ (BlankLines _ :< rest) -> go rest
(NewLine :< rest) -> go rest
_ -> x
@@ -203,7 +204,7 @@ chomp d = Doc (fromList dl')
go (BreakingSpace : xs) = go xs
go (CarriageReturn : xs) = go xs
go (NewLine : xs) = go xs
- go (BlankLine : xs) = go xs
+ go (BlankLines _ : xs) = go xs
go (Prefixed s d' : xs) = Prefixed s (chomp d') : xs
go xs = xs
@@ -216,9 +217,10 @@ outp off s | off < 0 = do -- offset < 0 means newline characters
let pref = reverse $ dropWhile isSpace $ reverse rawpref
modify $ \st -> st{ output = fromString pref : output st
, column = column st + realLength pref }
+ let numnewlines = length $ takeWhile (=='\n') $ reverse s
modify $ \st -> st { output = fromString s : output st
, column = 0
- , newlines = newlines st + 1 }
+ , newlines = newlines st + numnewlines }
outp off s = do -- offset >= 0 (0 might be combining char)
st' <- get
let pref = prefix st'
@@ -277,15 +279,11 @@ renderList (BeforeNonBlank d : xs) =
| otherwise -> renderDoc d >> renderList xs
[] -> renderList xs
-renderList (BlankLine : xs) = do
+renderList (BlankLines num : xs) = do
st <- get
case output st of
- _ | newlines st > 1 || null xs -> return ()
- _ | column st == 0 -> do
- outp (-1) "\n"
- _ -> do
- outp (-1) "\n"
- outp (-1) "\n"
+ _ | newlines st > num || null xs -> return ()
+ | otherwise -> replicateM_ (1 + num - newlines st) (outp (-1) "\n")
renderList xs
renderList (CarriageReturn : xs) = do
@@ -302,7 +300,7 @@ renderList (NewLine : xs) = do
renderList (BreakingSpace : CarriageReturn : xs) = renderList (CarriageReturn:xs)
renderList (BreakingSpace : NewLine : xs) = renderList (NewLine:xs)
-renderList (BreakingSpace : BlankLine : xs) = renderList (BlankLine:xs)
+renderList (BreakingSpace : BlankLines n : xs) = renderList (BlankLines n:xs)
renderList (BreakingSpace : BreakingSpace : xs) = renderList (BreakingSpace:xs)
renderList (BreakingSpace : xs) = do
let isText (Text _ _) = True
@@ -383,9 +381,13 @@ cr = Doc $ singleton CarriageReturn
-- | Inserts a blank line unless one exists already.
-- (@blankline <> blankline@ has the same effect as @blankline@.
--- If you want multiple blank lines, use @text "\\n\\n"@.
blankline :: Doc
-blankline = Doc $ singleton BlankLine
+blankline = Doc $ singleton (BlankLines 1)
+
+-- | Inserts a blank lines unless they exists already.
+-- (@blanklines m <> blanklines n@ has the same effect as @blankline (max m n)@.
+blanklines :: Int -> Doc
+blanklines n = Doc $ singleton (BlankLines n)
-- | Uses the specified string as a prefix for every line of
-- the inside document (except the first, if not at the beginning
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 41bec8b87..897e425c6 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -37,7 +37,7 @@ import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
-import Text.Pandoc.Parsing hiding (blankline, char, space)
+import Text.Pandoc.Parsing hiding (blankline, blanklines, char, space)
import Data.List ( group, isPrefixOf, find, intersperse, transpose, sortBy )
import Data.Char ( isSpace, isPunctuation, toUpper )
import Data.Ord ( comparing )
@@ -79,6 +79,9 @@ writePlain opts document =
writerExtensions = Set.delete Ext_escaped_line_breaks $
Set.delete Ext_pipe_tables $
Set.delete Ext_raw_html $
+ Set.delete Ext_footnotes $
+ Set.delete Ext_tex_math_dollars $
+ Set.delete Ext_citations $
writerExtensions opts }
document) def{ stPlain = True }
@@ -171,7 +174,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
then tableOfContents opts headerBlocks
else empty
-- Strip off final 'references' header if markdown citations enabled
- let blocks' = if not isPlain && isEnabled Ext_citations opts
+ let blocks' = if isEnabled Ext_citations opts
then case reverse blocks of
(Div (_,["references"],_) _):xs -> reverse xs
_ -> blocks
@@ -355,11 +358,11 @@ blockToMarkdown opts (Header level attr inlines) = do
let setext = writerSetextHeaders opts
return $ nowrap
$ case level of
- 1 | plain -> blankline <> text "\n\n" <> contents <> blankline <> text "\n"
+ 1 | plain -> blanklines 3 <> contents <> blanklines 2
| setext ->
contents <> attr' <> cr <> text (replicate (offset contents) '=') <>
blankline
- 2 | plain -> blankline <> text "\n" <> contents <> blankline
+ 2 | plain -> blanklines 2 <> contents <> blankline
| setext ->
contents <> attr' <> cr <> text (replicate (offset contents) '-') <>
blankline
@@ -620,15 +623,21 @@ blockListToMarkdown opts blocks =
-- code block will be treated as a list continuation paragraph
where fixBlocks (b : CodeBlock attr x : rest)
| (not (isEnabled Ext_fenced_code_blocks opts) || attr == nullAttr)
- && isListBlock b =
- b : RawBlock "html" "<!-- -->\n" : CodeBlock attr x :
- fixBlocks rest
+ && isListBlock b = b : commentSep : CodeBlock attr x :
+ fixBlocks rest
+ fixBlocks (b1@(BulletList _) : b2@(BulletList _) : bs) =
+ b1 : commentSep : fixBlocks (b2:bs)
+ fixBlocks (b1@(OrderedList _ _) : b2@(OrderedList _ _) : bs) =
+ b1 : commentSep : fixBlocks (b2:bs)
+ fixBlocks (b1@(DefinitionList _) : b2@(DefinitionList _) : bs) =
+ b1 : commentSep : fixBlocks (b2:bs)
fixBlocks (x : xs) = x : fixBlocks xs
fixBlocks [] = []
isListBlock (BulletList _) = True
isListBlock (OrderedList _ _) = True
isListBlock (DefinitionList _) = True
isListBlock _ = False
+ commentSep = RawBlock "html" "<!-- -->\n"
-- | Get reference for target; if none exists, create unique one and return.
-- Prefer label if possible; otherwise, generate a unique key.
@@ -695,23 +704,15 @@ inlineToMarkdown opts (Strikeout lst) = do
then "~~" <> contents <> "~~"
else "<s>" <> contents <> "</s>"
inlineToMarkdown opts (Superscript lst) = do
- plain <- gets stPlain
- if plain
- then inlineListToMarkdown opts lst
- else do
- contents <- inlineListToMarkdown opts $ walk escapeSpaces lst
- return $ if isEnabled Ext_superscript opts
- then "^" <> contents <> "^"
- else "<sup>" <> contents <> "</sup>"
+ contents <- inlineListToMarkdown opts $ walk escapeSpaces lst
+ return $ if isEnabled Ext_superscript opts
+ then "^" <> contents <> "^"
+ else "<sup>" <> contents <> "</sup>"
inlineToMarkdown opts (Subscript lst) = do
- plain <- gets stPlain
- if plain
- then inlineListToMarkdown opts lst
- else do
- contents <- inlineListToMarkdown opts $ walk escapeSpaces lst
- return $ if isEnabled Ext_subscript opts
- then "~" <> contents <> "~"
- else "<sub>" <> contents <> "</sub>"
+ contents <- inlineListToMarkdown opts $ walk escapeSpaces lst
+ return $ if isEnabled Ext_subscript opts
+ then "~" <> contents <> "~"
+ else "<sub>" <> contents <> "</sub>"
inlineToMarkdown opts (SmallCaps lst) = do
plain <- gets stPlain
if plain
@@ -753,7 +754,11 @@ inlineToMarkdown opts (Math InlineMath str)
return $ "\\(" <> text str <> "\\)"
| isEnabled Ext_tex_math_double_backslash opts =
return $ "\\\\(" <> text str <> "\\\\)"
- | otherwise = inlineListToMarkdown opts $ texMathToInlines InlineMath str
+ | otherwise = do
+ plain <- gets stPlain
+ inlineListToMarkdown opts $
+ (if plain then makeMathPlainer else id) $
+ texMathToInlines InlineMath str
inlineToMarkdown opts (Math DisplayMath str)
| isEnabled Ext_tex_math_dollars opts =
return $ "$$" <> text str <> "$$"
@@ -853,3 +858,9 @@ inlineToMarkdown opts (Note contents) = do
if isEnabled Ext_footnotes opts
then return $ "[^" <> ref <> "]"
else return $ "[" <> ref <> "]"
+
+makeMathPlainer :: [Inline] -> [Inline]
+makeMathPlainer = walk go
+ where
+ go (Emph xs) = Span nullAttr xs
+ go x = x
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-17 03:51:00 +0000