summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
authordr@jones.dk <dr@jones.dk>2009-12-14 12:57:35 +0100
committerdr@jones.dk <dr@jones.dk>2009-12-14 12:57:35 +0100
commit789d0772d8b5d9c066fb8624bd51576cbde5e30b (patch)
tree7141187124ecc41b13861c81c7b642076cb88078 /src/Text/Pandoc
parent88b315ccee666385e1a4c52e2eb5fb0b0ffe8d60 (diff)
Imported Upstream version 1.3
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Definition.hs13
-rw-r--r--src/Text/Pandoc/Highlighting.hs6
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs13
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs6
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs219
-rw-r--r--src/Text/Pandoc/Readers/RST.hs25
-rw-r--r--src/Text/Pandoc/Readers/TeXMath.hs4
-rw-r--r--src/Text/Pandoc/Shared.hs74
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs19
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs19
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs123
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs55
-rw-r--r--src/Text/Pandoc/Writers/Man.hs24
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs30
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs24
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs16
-rw-r--r--src/Text/Pandoc/Writers/RST.hs19
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs18
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs26
-rw-r--r--src/Text/Pandoc/XML.hs13
20 files changed, 461 insertions, 285 deletions
diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs
index 92ce094d4..94183c500 100644
--- a/src/Text/Pandoc/Definition.hs
+++ b/src/Text/Pandoc/Definition.hs
@@ -79,16 +79,17 @@ data Block
-- and a list of items, each a list of blocks)
| BulletList [[Block]] -- ^ Bullet list (list of items, each
-- a list of blocks)
- | DefinitionList [([Inline],[Block])] -- ^ Definition list
- -- (list of items, each a pair of an inline list,
- -- the term, and a block list)
+ | DefinitionList [([Inline],[[Block]])] -- ^ Definition list
+ -- Each list item is a pair consisting of a
+ -- term (a list of inlines) and one or more
+ -- definitions (each a list of blocks)
| Header Int [Inline] -- ^ Header - level (integer) and text (inlines)
| HorizontalRule -- ^ Horizontal rule
| Table [Inline] [Alignment] [Double] [[Block]] [[[Block]]] -- ^ Table,
-- with caption, column alignments,
- -- relative column widths, column headers
- -- (each a list of blocks), and rows
- -- (each a list of lists of blocks)
+ -- relative column widths (0 = default),
+ -- column headers (each a list of blocks), and
+ -- rows (each a list of lists of blocks)
| Null -- ^ Nothing
deriving (Eq, Read, Show, Typeable, Data)
diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs
index 6a88e5d70..457e605a5 100644
--- a/src/Text/Pandoc/Highlighting.hs
+++ b/src/Text/Pandoc/Highlighting.hs
@@ -45,12 +45,16 @@ highlightHtml (_, classes, keyvals) rawCode =
case find (`elem` ["number","numberLines","number-lines"]) classes of
Nothing -> []
Just _ -> [OptNumberLines]
+ addBirdTracks = "literate" `elem` classes
lcLanguages = map (map toLower) languages
in case find (\c -> (map toLower c) `elem` lcLanguages) classes of
Nothing -> Left "Unknown or unsupported language"
Just language -> case highlightAs language rawCode of
Left err -> Left err
- Right hl -> Right $ formatAsXHtml fmtOpts language hl
+ Right hl -> Right $ formatAsXHtml fmtOpts language $
+ if addBirdTracks
+ then map ((["Special"],"> "):) hl
+ else hl
#else
defaultHighlightingCss :: String
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index c988c68d2..e6ca05d87 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -38,6 +38,7 @@ module Text.Pandoc.Readers.HTML (
htmlEndTag,
extractTagType,
htmlBlockElement,
+ htmlComment,
unsanitaryURI
) where
@@ -52,7 +53,7 @@ import Network.URI ( parseURIReference, URI (..) )
-- | Convert HTML-formatted string to 'Pandoc' document.
readHtml :: ParserState -- ^ Parser state
- -> String -- ^ String to parse
+ -> String -- ^ String to parse (assumes @'\n'@ line endings)
-> Pandoc
readHtml = readWith parseHtml
@@ -76,7 +77,7 @@ inlineHtmlTags = ["a", "abbr", "acronym", "b", "basefont", "bdo", "big",
blockHtmlTags :: [[Char]]
blockHtmlTags = ["address", "blockquote", "body", "center", "dir", "div",
"dl", "fieldset", "form", "h1", "h2", "h3", "h4",
- "h5", "h6", "hr", "html", "isindex", "menu", "noframes",
+ "h5", "h6", "head", "hr", "html", "isindex", "menu", "noframes",
"noscript", "ol", "p", "pre", "table", "ul", "dd",
"dt", "frameset", "li", "tbody", "td", "tfoot",
"th", "thead", "tr", "script"] ++ eitherBlockOrInline
@@ -346,8 +347,8 @@ rawHtmlBlock' = do notFollowedBy' (htmlTag "/body" <|> htmlTag "/html")
htmlComment :: GenParser Char st [Char]
htmlComment = try $ do
string "<!--"
- comment <- many ( (satisfy (/='-'))
- <|> (char '-' >>~ notFollowedBy (try $ char '-' >> char '>')))
+ comment <- many $ noneOf "-"
+ <|> try (char '-' >>~ notFollowedBy (try (char '-' >> char '>')))
string "-->"
return $ "<!--" ++ comment ++ "-->"
@@ -544,12 +545,12 @@ definitionList = try $ do
htmlEndTag "dl"
return $ DefinitionList items
-definitionListItem :: GenParser Char ParserState ([Inline], [Block])
+definitionListItem :: GenParser Char ParserState ([Inline], [[Block]])
definitionListItem = try $ do
terms <- sepEndBy1 (inlinesIn "dt") spaces
defs <- sepEndBy1 (blocksIn "dd") spaces
let term = intercalate [LineBreak] terms
- return (term, concat defs)
+ return (term, defs)
--
-- paragraph block
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 5d02a2be5..b4c01fe19 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -42,7 +42,7 @@ import Data.List ( isPrefixOf, isSuffixOf )
-- | Parse LaTeX from string and return 'Pandoc' document.
readLaTeX :: ParserState -- ^ Parser state, including options for parser
- -> String -- ^ String to parse
+ -> String -- ^ String to parse (assumes @'\n'@ line endings)
-> Pandoc
readLaTeX = readWith parseLaTeX
@@ -207,7 +207,7 @@ lhsCodeBlock :: GenParser Char ParserState Block
lhsCodeBlock = do
failUnlessLHS
(CodeBlock (_,_,_) cont) <- codeBlockWith "code"
- return $ CodeBlock ("", ["sourceCode","haskell"], []) cont
+ return $ CodeBlock ("", ["sourceCode","literate","haskell"], []) cont
--
-- block quotes
@@ -282,7 +282,7 @@ definitionList = try $ do
items <- many listItem
end "description"
spaces
- return (DefinitionList items)
+ return $ DefinitionList $ map (\(t,d) -> (t,[d])) items
--
-- paragraph block
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index ae682e72e..0de700537 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -42,13 +42,15 @@ import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment' )
import Text.Pandoc.Readers.HTML ( rawHtmlBlock, anyHtmlBlockTag,
anyHtmlInlineTag, anyHtmlTag,
anyHtmlEndTag, htmlEndTag, extractTagType,
- htmlBlockElement, unsanitaryURI )
+ htmlBlockElement, htmlComment, unsanitaryURI )
import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
import Text.ParserCombinators.Parsec
-import Control.Monad (when)
+import Control.Monad (when, liftM, unless)
-- | Read markdown from an input string and return a Pandoc document.
-readMarkdown :: ParserState -> String -> Pandoc
+readMarkdown :: ParserState -- ^ Parser state, including options for parser
+ -> String -- ^ String to parse (assuming @'\n'@ line endings)
+ -> Pandoc
readMarkdown state s = (readWith parseMarkdown) state (s ++ "\n\n")
--
@@ -107,7 +109,7 @@ failUnlessBeginningOfLine = do
failUnlessSmart :: GenParser tok ParserState ()
failUnlessSmart = do
state <- getState
- if stateSmart state then return () else fail "Smart typography feature"
+ if stateSmart state then return () else pzero
-- | Parse a sequence of inline elements between square brackets,
-- including inlines between balanced pairs of square brackets.
@@ -116,9 +118,7 @@ inlinesInBalancedBrackets :: GenParser Char ParserState Inline
inlinesInBalancedBrackets parser = try $ do
char '['
result <- manyTill ( (do lookAhead $ try $ do (Str res) <- parser
- if res == "["
- then return ()
- else pzero
+ unless (res == "[") pzero
bal <- inlinesInBalancedBrackets parser
return $ [Str "["] ++ bal ++ [Str "]"])
<|> (count 1 parser))
@@ -162,23 +162,18 @@ parseMarkdown = do
-- markdown allows raw HTML
updateState (\state -> state { stateParseRaw = True })
startPos <- getPosition
- -- go through once just to get list of reference keys
- -- docMinusKeys is the raw document with blanks where the keys were...
- docMinusKeys <- manyTill (referenceKey <|> lineClump) eof >>=
- return . concat
+ -- go through once just to get list of reference keys and notes
+ -- docMinusKeys is the raw document with blanks where the keys/notes were...
+ st <- getState
+ let firstPassParser = referenceKey
+ <|> (if stateStrict st then pzero else noteBlock)
+ <|> lineClump
+ docMinusKeys <- liftM concat $ manyTill firstPassParser eof
setInput docMinusKeys
setPosition startPos
- st <- getState
- -- go through again for notes unless strict...
- if stateStrict st
- then return ()
- else do docMinusNotes <- manyTill (noteBlock <|> lineClump) eof >>=
- return . concat
- st' <- getState
- let reversedNotes = stateNotes st'
- updateState $ \s -> s { stateNotes = reverse reversedNotes }
- setInput docMinusNotes
- setPosition startPos
+ st' <- getState
+ let reversedNotes = stateNotes st'
+ updateState $ \s -> s { stateNotes = reverse reversedNotes }
-- now parse it for real...
(title, author, date) <- option ([],[],"") titleBlock
blocks <- parseBlocks
@@ -201,7 +196,7 @@ referenceKey = try $ do
tit <- option "" referenceTitle
blanklines
endPos <- getPosition
- let newkey = (lab, (intercalate "%20" $ words $ removeTrailingSpace src, tit))
+ let newkey = (lab, (intercalate "+" $ words $ removeTrailingSpace src, tit))
st <- getState
let oldkeys = stateKeys st
updateState $ \s -> s { stateKeys = newkey : oldkeys }
@@ -241,9 +236,7 @@ noteBlock = try $ do
raw <- sepBy rawLines (try (blankline >> indentSpaces))
optional blanklines
endPos <- getPosition
- -- parse the extracted text, which may contain various block elements:
- contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"
- let newnote = (ref, contents)
+ let newnote = (ref, (intercalate "\n" raw) ++ "\n\n")
st <- getState
let oldnotes = stateNotes st
updateState $ \s -> s { stateNotes = newnote : oldnotes }
@@ -399,13 +392,15 @@ codeBlockIndented = do
l <- indentedLine
return $ b ++ l))
optional blanklines
- return $ CodeBlock ("",[],[]) $ stripTrailingNewlines $ concat contents
+ st <- getState
+ return $ CodeBlock ("", stateIndentedCodeClasses st, []) $
+ stripTrailingNewlines $ concat contents
lhsCodeBlock :: GenParser Char ParserState Block
lhsCodeBlock = do
failUnlessLHS
contents <- lhsCodeBlockBird <|> lhsCodeBlockLaTeX
- return $ CodeBlock ("",["sourceCode","haskell"],[]) contents
+ return $ CodeBlock ("",["sourceCode","literate","haskell"],[]) contents
lhsCodeBlockLaTeX :: GenParser Char ParserState String
lhsCodeBlockLaTeX = try $ do
@@ -502,8 +497,8 @@ listLine = try $ do
notFollowedBy' (do indentSpaces
many (spaceChar)
listStart)
- line <- manyTill anyChar newline
- return $ line ++ "\n"
+ chunks <- manyTill (htmlComment <|> count 1 anyChar) newline
+ return $ concat chunks ++ "\n"
-- parse raw text for one list item, excluding start marker and continuations
rawListItem :: GenParser Char ParserState [Char]
@@ -560,38 +555,61 @@ bulletList = try $ do
-- definition lists
-definitionListItem :: GenParser Char ParserState ([Inline], [Block])
+defListMarker :: GenParser Char ParserState ()
+defListMarker = do
+ sps <- nonindentSpaces
+ char ':' <|> char '~'
+ st <- getState
+ let tabStop = stateTabStop st
+ let remaining = tabStop - (length sps + 1)
+ if remaining > 0
+ then count remaining (char ' ') <|> string "\t"
+ else pzero
+ return ()
+
+definitionListItem :: GenParser Char ParserState ([Inline], [[Block]])
definitionListItem = try $ do
- notFollowedBy blankline
- notFollowedBy' indentSpaces
-- first, see if this has any chance of being a definition list:
- lookAhead (anyLine >> char ':')
+ lookAhead (anyLine >> optional blankline >> defListMarker)
term <- manyTill inline newline
+ optional blankline
raw <- many1 defRawBlock
state <- getState
let oldContext = stateParserContext state
-- parse the extracted block, which may contain various block elements:
- contents <- parseFromString parseBlocks $ concat raw
+ contents <- mapM (parseFromString parseBlocks) raw
updateState (\st -> st {stateParserContext = oldContext})
return ((normalizeSpaces term), contents)
defRawBlock :: GenParser Char ParserState [Char]
defRawBlock = try $ do
- char ':'
- state <- getState
- let tabStop = stateTabStop state
- try (count (tabStop - 1) (char ' ')) <|> (many (char ' ') >> string "\t")
+ defListMarker
firstline <- anyLine
rawlines <- many (notFollowedBy blankline >> indentSpaces >> anyLine)
trailing <- option "" blanklines
- return $ firstline ++ "\n" ++ unlines rawlines ++ trailing
+ cont <- liftM concat $ many $ do
+ lns <- many1 $ notFollowedBy blankline >> indentSpaces >> anyLine
+ trl <- option "" blanklines
+ return $ unlines lns ++ trl
+ return $ firstline ++ "\n" ++ unlines rawlines ++ trailing ++ cont
definitionList :: GenParser Char ParserState Block
definitionList = do
items <- many1 definitionListItem
- let (terms, defs) = unzip items
- let defs' = compactify defs
- let items' = zip terms defs'
+ -- "compactify" the definition list:
+ let defs = map snd items
+ let defBlocks = reverse $ concat $ concat defs
+ let isPara (Para _) = True
+ isPara _ = False
+ let items' = case take 1 defBlocks of
+ [Para x] -> if not $ any isPara (drop 1 defBlocks)
+ then let (t,ds) = last items
+ lastDef = last ds
+ ds' = init ds ++
+ [init lastDef ++ [Plain x]]
+ in init items ++ [(t, ds')]
+ else items
+ _ -> items
return $ DefinitionList items'
--
@@ -681,26 +699,36 @@ dashedLine ch = do
return $ (length dashes, length $ dashes ++ sp)
-- Parse a table header with dashed lines of '-' preceded by
--- one line of text.
-simpleTableHeader :: GenParser Char ParserState ([[Char]], [Alignment], [Int])
-simpleTableHeader = try $ do
- rawContent <- anyLine
+-- one (or zero) line of text.
+simpleTableHeader :: Bool -- ^ Headerless table
+ -> GenParser Char ParserState ([[Char]], [Alignment], [Int])
+simpleTableHeader headless = try $ do
+ rawContent <- if headless
+ then return ""
+ else anyLine
initSp <- nonindentSpaces
dashes <- many1 (dashedLine '-')
newline
let (lengths, lines') = unzip dashes
let indices = scanl (+) (length initSp) lines'
- let rawHeads = tail $ splitByIndices (init indices) rawContent
+ -- If no header, calculate alignment on basis of first row of text
+ rawHeads <- liftM (tail . splitByIndices (init indices)) $
+ if headless
+ then lookAhead anyLine
+ else return rawContent
let aligns = zipWith alignType (map (\a -> [a]) rawHeads) lengths
- return (rawHeads, aligns, indices)
+ let rawHeads' = if headless
+ then replicate (length dashes) ""
+ else rawHeads
+ return (rawHeads', aligns, indices)
-- Parse a table footer - dashed lines followed by blank line.
tableFooter :: GenParser Char ParserState [Char]
tableFooter = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> blanklines
-- Parse a table separator - dashed line.
-tableSep :: GenParser Char ParserState String
-tableSep = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> string "\n"
+tableSep :: GenParser Char ParserState Char
+tableSep = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> char '\n'
-- Parse a raw line and split it into chunks by indices.
rawTableLine :: [Int]
@@ -731,7 +759,17 @@ widthsFromIndices :: Int -- Number of columns on terminal
-> [Double] -- Fractional relative sizes of columns
widthsFromIndices _ [] = []
widthsFromIndices numColumns indices =
- let lengths = zipWith (-) indices (0:indices)
+ let lengths' = zipWith (-) indices (0:indices)
+ lengths = reverse $
+ case reverse lengths' of
+ [] -> []
+ [x] -> [x]
+ -- compensate for the fact that intercolumn
+ -- spaces are counted in widths of all columns
+ -- but the last...
+ (x:y:zs) -> if x < y && y - x <= 2
+ then y:y:zs
+ else x:y:zs
totLength = sum lengths
quotient = if totLength > numColumns
then fromIntegral totLength
@@ -765,30 +803,48 @@ tableWith headerParser lineParser footerParser = try $ do
return $ Table caption aligns widths heads lines'
-- Parse a simple table with '---' header and one line per row.
-simpleTable :: GenParser Char ParserState Block
-simpleTable = tableWith simpleTableHeader tableLine blanklines
+simpleTable :: Bool -- ^ Headerless table
+ -> GenParser Char ParserState Block
+simpleTable headless = do
+ Table c a _w h l <- tableWith (simpleTableHeader headless) tableLine
+ (if headless then tableFooter else tableFooter <|> blanklines)
+ -- Simple tables get 0s for relative column widths (i.e., use default)
+ return $ Table c a (replicate (length a) 0) h l
-- Parse a multiline table: starts with row of '-' on top, then header
-- (which may be multiline), then the rows,
-- which may be multiline, separated by blank lines, and
-- ending with a footer (dashed line followed by blank line).
-multilineTable :: GenParser Char ParserState Block
-multilineTable = tableWith multilineTableHeader multilineRow tableFooter
-
-multilineTableHeader :: GenParser Char ParserState ([String], [Alignment], [Int])
-multilineTableHeader = try $ do
- tableSep
- rawContent <- many1 (notFollowedBy' tableSep >> many1Till anyChar newline)
+multilineTable :: Bool -- ^ Headerless table
+ -> GenParser Char ParserState Block
+multilineTable headless =
+ tableWith (multilineTableHeader headless) multilineRow tableFooter
+
+multilineTableHeader :: Bool -- ^ Headerless table
+ -> GenParser Char ParserState ([String], [Alignment], [Int])
+multilineTableHeader headless = try $ do
+ if headless
+ then return '\n'
+ else tableSep
+ rawContent <- if headless
+ then return $ repeat ""
+ else many1
+ (notFollowedBy tableSep >> many1Till anyChar newline)
initSp <- nonindentSpaces
dashes <- many1 (dashedLine '-')
newline
let (lengths, lines') = unzip dashes
let indices = scanl (+) (length initSp) lines'
- let rawHeadsList = transpose $ map
- (\ln -> tail $ splitByIndices (init indices) ln)
- rawContent
- let rawHeads = map (intercalate " ") rawHeadsList
+ rawHeadsList <- if headless
+ then liftM (map (:[]) . tail .
+ splitByIndices (init indices)) $ lookAhead anyLine
+ else return $ transpose $ map
+ (\ln -> tail $ splitByIndices (init indices) ln)
+ rawContent
let aligns = zipWith alignType rawHeadsList lengths
+ let rawHeads = if headless
+ then replicate (length dashes) ""
+ else map (intercalate " ") rawHeadsList
return ((map removeLeadingTrailingSpace rawHeads), aligns, indices)
-- Returns an alignment type for a table, based on a list of strings
@@ -810,7 +866,8 @@ alignType strLst len =
(False, False) -> AlignDefault
table :: GenParser Char ParserState Block
-table = simpleTable <|> multilineTable <?> "table"
+table = multilineTable False <|> simpleTable True <|>
+ simpleTable False <|> multilineTable True <?> "table"
--
-- inline
@@ -826,6 +883,7 @@ inlineParsers = [ str
, endline
, code
, charRef
+ , (fourOrMore '*' <|> fourOrMore '_')
, strong
, emph
, note
@@ -862,10 +920,10 @@ escapedChar = do
result <- option '\\' $ if stateStrict state
then oneOf "\\`*_{}[]()>#+-.!~"
else satisfy (not . isAlphaNum)
- let result' = if result == ' '
- then '\160' -- '\ ' is a nonbreaking space
- else result
- return $ Str [result']
+ return $ case result of
+ ' ' -> Str "\160" -- "\ " is a nonbreaking space
+ '\n' -> LineBreak -- "\[newline]" is a linebreak
+ _ -> Str [result]
ltSign :: GenParser Char ParserState Inline
ltSign = do
@@ -895,8 +953,13 @@ code = try $ do
return $ Code $ removeLeadingTrailingSpace $ concat result
mathWord :: GenParser Char st [Char]
-mathWord = many1 ((noneOf " \t\n\\$") <|>
- (try (char '\\') >>~ notFollowedBy (char '$')))
+mathWord = liftM concat $ many1 mathChunk
+
+mathChunk :: GenParser Char st [Char]
+mathChunk = do char '\\'
+ c <- anyChar
+ return ['\\',c]
+ <|> many1 (noneOf " \t\n\\$")
math :: GenParser Char ParserState Inline
math = (mathDisplay >>= return . Math DisplayMath)
@@ -918,6 +981,12 @@ mathInline = try $ do
notFollowedBy digit
return $ intercalate " " words'
+-- to avoid performance problems, treat 4 or more _ or * in a row as a literal
+-- rather than attempting to parse for emph/strong
+fourOrMore :: Char -> GenParser Char st Inline
+fourOrMore c = try $ count 4 (char c) >> many (char c) >>= \s ->
+ return (Str $ replicate 4 c ++ s)
+
emph :: GenParser Char ParserState Inline
emph = ((enclosed (char '*') (notFollowedBy' strong >> char '*') inline) <|>
(enclosed (char '_') (notFollowedBy' strong >> char '_' >>
@@ -1106,7 +1175,7 @@ source' = do
tit <- option "" linkTitle
skipSpaces
eof
- return (intercalate "%20" $ words $ removeTrailingSpace src, tit)
+ return (intercalate "+" $ words $ removeTrailingSpace src, tit)
linkTitle :: GenParser Char st String
linkTitle = try $ do
@@ -1167,8 +1236,8 @@ note = try $ do
state <- getState
let notes = stateNotes state
case lookup ref notes of
- Nothing -> fail "note not found"
- Just contents -> return $ Note contents
+ Nothing -> fail "note not found"
+ Just raw -> liftM Note $ parseFromString parseBlocks raw
inlineNote :: GenParser Char ParserState Inline
inlineNote = try $ do
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 884d6f0e6..d1515c4d5 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -37,7 +37,9 @@ import Control.Monad ( when )
import Data.List ( findIndex, delete, intercalate )
-- | Parse reStructuredText string and return Pandoc document.
-readRST :: ParserState -> String -> Pandoc
+readRST :: ParserState -- ^ Parser state, including options for parser
+ -> String -- ^ String to parse (assuming @'\n'@ line endings)
+ -> Pandoc
readRST state s = (readWith parseRST) state (s ++ "\n\n")
--
@@ -48,7 +50,7 @@ bulletListMarkers :: [Char]
bulletListMarkers = "*+-"
underlineChars :: [Char]
-underlineChars = "!\"#$&'()*+,-./:;<=>?@[\\]^_`{|}~"
+underlineChars = "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"
-- treat these as potentially non-text when parsing inline:
specialChars :: [Char]
@@ -120,6 +122,7 @@ block = choice [ codeBlock
, fieldList
, blockQuote
, imageBlock
+ , customCodeBlock
, unknownDirective
, header
, hrule
@@ -171,7 +174,7 @@ fieldList = try $ do
else do terms <- mapM (return . (:[]) . Str . fst) remaining
defs <- mapM (parseFromString (many block) . snd)
remaining
- return $ DefinitionList $ zip terms defs
+ return $ DefinitionList $ zip terms $ map (:[]) defs
--
-- line block
@@ -329,6 +332,16 @@ codeBlock = try $ do
result <- indentedBlock
return $ CodeBlock ("",[],[]) $ stripTrailingNewlines result
+-- | The 'code-block' directive (from Sphinx) that allows a language to be
+-- specified.
+customCodeBlock :: GenParser Char st Block
+customCodeBlock = try $ do
+ string ".. code-block:: "
+ language <- manyTill anyChar newline
+ blanklines
+ result <- indentedBlock
+ return $ CodeBlock ("", ["sourceCode", language], []) $ stripTrailingNewlines result
+
lhsCodeBlock :: GenParser Char ParserState Block
lhsCodeBlock = try $ do
failUnlessLHS
@@ -340,7 +353,7 @@ lhsCodeBlock = try $ do
then map (drop 1) lns
else lns
blanklines
- return $ CodeBlock ("", ["sourceCode", "haskell"], []) $ intercalate "\n" lns'
+ return $ CodeBlock ("", ["sourceCode", "literate", "haskell"], []) $ intercalate "\n" lns'
birdTrackLine :: GenParser Char st [Char]
birdTrackLine = do
@@ -384,7 +397,7 @@ blockQuote = do
list :: GenParser Char ParserState Block
list = choice [ bulletList, orderedList, definitionList ] <?> "list"
-definitionListItem :: GenParser Char ParserState ([Inline], [Block])
+definitionListItem :: GenParser Char ParserState ([Inline], [[Block]])
definitionListItem = try $ do
-- avoid capturing a directive or comment
notFollowedBy (try $ char '.' >> char '.')
@@ -392,7 +405,7 @@ definitionListItem = try $ do
raw <- indentedBlock
-- parse the extracted block, which may contain various block elements:
contents <- parseFromString parseBlocks $ raw ++ "\n\n"
- return (normalizeSpaces term, contents)
+ return (normalizeSpaces term, [contents])
definitionList :: GenParser Char ParserState Block
definitionList = many1 definitionListItem >>= return . DefinitionList
diff --git a/src/Text/Pandoc/Readers/TeXMath.hs b/src/Text/Pandoc/Readers/TeXMath.hs
index 04b0f3b8f..18790d03a 100644
--- a/src/Text/Pandoc/Readers/TeXMath.hs
+++ b/src/Text/Pandoc/Readers/TeXMath.hs
@@ -35,7 +35,8 @@ import Text.ParserCombinators.Parsec
import Text.Pandoc.Definition
-- | Converts a string of raw TeX math to a list of 'Pandoc' inlines.
-readTeXMath :: String -> [Inline]
+readTeXMath :: String -- ^ String to parse (assumes @'\n'@ line endings)
+ -> [Inline]
readTeXMath inp = case parse teXMath ("formula: " ++ inp) inp of
Left _ -> [Str inp] -- if unparseable, just include original
Right res -> res
@@ -223,6 +224,7 @@ teXsymbols =
,("rceiling", "\x2309")
,("langle", "\x2329")
,("rangle", "\x232A")
+ ,("int", "\8747")
,("{", "{")
,("}", "}")
,("[", "[")
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index b67e169c8..c99fa3e9e 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -671,7 +671,8 @@ data ParserState = ParserState
stateSmart :: Bool, -- ^ Use smart typography?
stateLiterateHaskell :: Bool, -- ^ Treat input as literate haskell
stateColumns :: Int, -- ^ Number of columns in terminal
- stateHeaderTable :: [HeaderType] -- ^ Ordered list of header types used
+ stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
+ stateIndentedCodeClasses :: [String] -- ^ Classes to use for indented code blocks
}
deriving Show
@@ -695,7 +696,8 @@ defaultParserState =
stateSmart = False,
stateLiterateHaskell = False,
stateColumns = 80,
- stateHeaderTable = [] }
+ stateHeaderTable = [],
+ stateIndentedCodeClasses = [] }
data HeaderType
= SingleHeader Char -- ^ Single line of characters underneath
@@ -713,7 +715,7 @@ data QuoteContext
| NoQuote -- ^ Used when not parsing inside quotes
deriving (Eq, Show)
-type NoteTable = [(String, [Block])]
+type NoteTable = [(String, String)]
type KeyTable = [([Inline], Target)]
@@ -794,10 +796,12 @@ prettyBlock (OrderedList attribs blockLists) =
prettyBlock (BulletList blockLists) = "BulletList\n" ++
indentBy 2 0 ("[ " ++ (intercalate ", "
(map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
-prettyBlock (DefinitionList blockLists) = "DefinitionList\n" ++
- indentBy 2 0 ("[" ++ (intercalate ",\n"
- (map (\(term, blocks) -> " (" ++ show term ++ ",\n" ++
- indentBy 1 2 (prettyBlockList 2 blocks) ++ " )") blockLists))) ++ " ]"
+prettyBlock (DefinitionList items) = "DefinitionList\n" ++
+ indentBy 2 0 ("[ " ++ (intercalate "\n, "
+ (map (\(term, defs) -> "(" ++ show term ++ ",\n" ++
+ indentBy 3 0 ("[ " ++ (intercalate ", "
+ (map (\blocks -> prettyBlockList 2 blocks) defs)) ++ "]") ++
+ ")") items))) ++ " ]"
prettyBlock (Table caption aligns widths header rows) =
"Table " ++ show caption ++ " " ++ show aligns ++ " " ++
show widths ++ "\n" ++ prettyRow header ++ " [\n" ++
@@ -856,34 +860,30 @@ normalizeSpaces list =
else lst
in removeLeading $ removeTrailing $ removeDoubles list
--- | Change final list item from @Para@ to @Plain@ if the list should
--- be compact.
+-- | Change final list item from @Para@ to @Plain@ if the list contains
+-- no other @Para@ blocks.
compactify :: [[Block]] -- ^ List of list items (each a list of blocks)
-> [[Block]]
compactify [] = []
compactify items =
- let final = last items
- others = init items
- in case last final of
- Para a -> if all endsWithPlain others && not (null final)
- then others ++ [init final ++ [Plain a]]
- else items
- _ -> items
-
-endsWithPlain :: [Block] -> Bool
-endsWithPlain [] = False
-endsWithPlain blocks =
- case last blocks of
- Plain _ -> True
- (BulletList (x:xs)) -> endsWithPlain $ last (x:xs)
- (OrderedList _ (x:xs)) -> endsWithPlain $ last (x:xs)
- (DefinitionList (x:xs)) -> endsWithPlain $ last $ map snd (x:xs)
- _ -> False
+ case (init items, last items) of
+ (_,[]) -> items
+ (others, final) ->
+ case last final of
+ Para a -> case (filter isPara $ concat items) of
+ -- if this is only Para, change to Plain
+ [_] -> others ++ [init final ++ [Plain a]]
+ _ -> items
+ _ -> items
+
+isPara :: Block -> Bool
+isPara (Para _) = True
+isPara _ = False
-- | Data structure for defining hierarchical Pandoc documents
data Element = Blk Block
- | Sec Int String [Inline] [Element]
- -- lvl ident label contents
+ | Sec Int [Int] String [Inline] [Element]
+ -- lvl num ident label contents
deriving (Eq, Read, Show, Typeable, Data)
-- | Convert Pandoc inline list to plain text identifier.
@@ -895,7 +895,7 @@ inlineListToIdentifier' [] = ""
inlineListToIdentifier' (x:xs) =
xAsText ++ inlineListToIdentifier' xs
where xAsText = case x of
- Str s -> filter (\c -> c == '-' || not (isPunctuation c)) $
+ Str s -> filter (\c -> c `elem` "_-.~" || not (isPunctuation c)) $
intercalate "-" $ words $ map toLower s
Emph lst -> inlineListToIdentifier' lst
Strikeout lst -> inlineListToIdentifier' lst
@@ -921,18 +921,22 @@ inlineListToIdentifier' (x:xs) =
-- | Convert list of Pandoc blocks into (hierarchical) list of Elements
hierarchicalize :: [Block] -> [Element]
-hierarchicalize blocks = S.evalState (hierarchicalizeWithIds blocks) []
+hierarchicalize blocks = S.evalState (hierarchicalizeWithIds blocks) ([],[])
-hierarchicalizeWithIds :: [Block] -> S.State [String] [Element]
+hierarchicalizeWithIds :: [Block] -> S.State ([Int],[String]) [Element]
hierarchicalizeWithIds [] = return []
hierarchicalizeWithIds ((Header level title'):xs) = do
- usedIdents <- S.get
+ (lastnum, usedIdents) <- S.get
let ident = uniqueIdent title' usedIdents
- S.modify (ident :)
+ let lastnum' = take level lastnum
+ let newnum = if length lastnum' >= level
+ then init lastnum' ++ [last lastnum' + 1]
+ else lastnum ++ replicate (level - length lastnum - 1) 0 ++ [1]
+ S.put (newnum, (ident : usedIdents))
let (sectionContents, rest) = break (headerLtEq level) xs
sectionContents' <- hierarchicalizeWithIds sectionContents
rest' <- hierarchicalizeWithIds rest
- return $ Sec level ident title' sectionContents' : rest'
+ return $ Sec level newnum ident title' sectionContents' : rest'
hierarchicalizeWithIds (x:rest) = do
rest' <- hierarchicalizeWithIds rest
return $ (Blk x) : rest'
@@ -992,6 +996,7 @@ data WriterOptions = WriterOptions
, writerWrapText :: Bool -- ^ Wrap text to line length
, writerLiterateHaskell :: Bool -- ^ Write as literate haskell
, writerEmailObfuscation :: ObfuscationMethod -- ^ How to obfuscate emails
+ , writerIdentifierPrefix :: String -- ^ Prefix for section & note ids in HTML
} deriving Show
-- | Default writer options.
@@ -1014,6 +1019,7 @@ defaultWriterOptions =
, writerWrapText = True
, writerLiterateHaskell = False
, writerEmailObfuscation = JavascriptObfuscation
+ , writerIdentifierPrefix = ""
}
--
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index 014751968..142c862ef 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -31,8 +31,9 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Printf ( printf )
-import Data.List ( isSuffixOf, intercalate )
+import Data.List ( isSuffixOf, intercalate, intersperse )
import Control.Monad.State
+import Control.Monad (liftM)
import Text.PrettyPrint.HughesPJ hiding ( Str )
data WriterState =
@@ -192,15 +193,16 @@ blockToConTeXt (Header level lst) = do
text base <> char '{' <> contents <> char '}'
else contents
blockToConTeXt (Table caption aligns widths heads rows) = do
- let colWidths = map printDecimal widths
let colDescriptor colWidth alignment = (case alignment of
AlignLeft -> 'l'
AlignRight -> 'r'
AlignCenter -> 'c'
AlignDefault -> 'l'):
- "p(" ++ colWidth ++ "\\textwidth)|"
+ if colWidth == 0
+ then "|"
+ else ("p(" ++ printf "%.2f" colWidth ++ "\\textwidth)|")
let colDescriptors = "|" ++ (concat $
- zipWith colDescriptor colWidths aligns)
+ zipWith colDescriptor widths aligns)
headers <- tableRowToConTeXt heads
captionText <- inlineListToConTeXt caption
let captionText' = if null caption then text "none" else captionText
@@ -210,9 +212,6 @@ blockToConTeXt (Table caption aligns widths heads rows) = do
text "\\HL" $$ headers $$ text "\\HL" $$
vcat rows' $$ text "\\HL\n\\stoptable"
-printDecimal :: Double -> String
-printDecimal = printf "%.2f"
-
tableRowToConTeXt :: [[Block]] -> State WriterState Doc
tableRowToConTeXt cols = do
cols' <- mapM blockListToConTeXt cols
@@ -223,10 +222,10 @@ listItemToConTeXt :: [Block] -> State WriterState Doc
listItemToConTeXt list = blockListToConTeXt list >>=
return . (text "\\item" $$) . (nest 2)
-defListItemToConTeXt :: ([Inline], [Block]) -> State WriterState BlockWrapper
-defListItemToConTeXt (term, def) = do
+defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState BlockWrapper
+defListItemToConTeXt (term, defs) = do
term' <- inlineListToConTeXt term
- def' <- blockListToConTeXt def
+ def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToConTeXt defs
return $ Pad $ text "\\startdescr{" <> term' <> char '}' $$ def' $$ text "\\stopdescr"
-- | Convert list of block elements to ConTeXt.
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index cd426e7c8..b46bb0eb4 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -82,12 +82,12 @@ writeDocbook opts (Pandoc (Meta title authors date) blocks) =
-- | Convert an Element to Docbook.
elementToDocbook :: WriterOptions -> Element -> Doc
elementToDocbook opts (Blk block) = blockToDocbook opts block
-elementToDocbook opts (Sec _ _ title elements) =
+elementToDocbook opts (Sec _ _num id' title elements) =
-- Docbook doesn't allow sections with no content, so insert some if needed
let elements' = if null elements
then [Blk (Para [])]
else elements
- in inTagsIndented "section" $
+ in inTags True "section" [("id",id')] $
inTagsSimple "title" (wrap opts title) $$
vcat (map (elementToDocbook opts) elements')
@@ -102,14 +102,14 @@ plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a list of
-- Docbook varlistentrys.
-deflistItemsToDocbook :: WriterOptions -> [([Inline],[Block])] -> Doc
+deflistItemsToDocbook :: WriterOptions -> [([Inline],[[Block]])] -> Doc
deflistItemsToDocbook opts items =
- vcat $ map (\(term, def) -> deflistItemToDocbook opts term def) items
+ vcat $ map (\(term, defs) -> deflistItemToDocbook opts term defs) items
-- | Convert a term and a list of blocks into a Docbook varlistentry.
-deflistItemToDocbook :: WriterOptions -> [Inline] -> [Block] -> Doc
-deflistItemToDocbook opts term def =
- let def' = map plainToPara def
+deflistItemToDocbook :: WriterOptions -> [Inline] -> [[Block]] -> Doc
+deflistItemToDocbook opts term defs =
+ let def' = concatMap (map plainToPara) defs
in inTagsIndented "varlistentry" $
inTagsIndented "term" (inlinesToDocbook opts term) $$
inTagsIndented "listitem" (blocksToDocbook opts def')
@@ -262,7 +262,10 @@ inlineToDocbook opts (Link txt (src, _)) =
then emailLink
else inlinesToDocbook opts txt <+> char '(' <> emailLink <>
char ')'
- else inTags False "ulink" [("url", src)] $ inlinesToDocbook opts txt
+ else (if isPrefixOf "#" src
+ then inTags False "link" [("linkend", drop 1 src)]
+ else inTags False "ulink" [("url", src)]) $
+ inlinesToDocbook opts txt
inlineToDocbook _ (Image _ (src, tit)) =
let titleDoc = if null tit
then empty
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 4b6ea5982..e0e3882fe 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -35,9 +35,10 @@ import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
+import Text.Pandoc.XML (stripTags)
import Numeric ( showHex )
import Data.Char ( ord, toLower )
-import Data.List ( isPrefixOf, intercalate )
+import Data.List ( isPrefixOf, intersperse )
import Data.Maybe ( catMaybes )
import qualified Data.Set as S
import Control.Monad.State
@@ -47,10 +48,11 @@ data WriterState = WriterState
{ stNotes :: [Html] -- ^ List of notes
, stMath :: Bool -- ^ Math is used in document
, stCSS :: S.Set String -- ^ CSS to include in header
+ , stSecNum :: [Int] -- ^ Number of current section
} deriving Show
defaultWriterState :: WriterState
-defaultWriterState = WriterState {stNotes= [], stMath = False, stCSS = S.empty}
+defaultWriterState = WriterState {stNotes= [], stMath = False, stCSS = S.empty, stSecNum = []}
-- Helpers to render HTML with the appropriate function.
@@ -87,13 +89,13 @@ writeHtmlString opts =
writeHtml :: WriterOptions -> Pandoc -> Html
writeHtml opts (Pandoc (Meta tit authors date) blocks) =
let titlePrefix = writerTitlePrefix opts
- topTitle = evalState (inlineListToHtml opts tit) defaultWriterState
- topTitle' = if null titlePrefix
- then topTitle
- else if null tit
- then stringToHtml titlePrefix
- else titlePrefix +++ " - " +++ topTitle
- metadata = thetitle topTitle' +++
+ (topTitle,st) = runState (inlineListToHtml opts tit) defaultWriterState
+ topTitle'' = stripTags $ showHtmlFragment topTitle
+ topTitle' = titlePrefix ++
+ (if null topTitle'' || null titlePrefix
+ then ""
+ else " - ") ++ topTitle''
+ metadata = thetitle << topTitle' +++
meta ! [httpequiv "Content-Type",
content "text/html; charset=UTF-8"] +++
meta ! [name "generator", content "pandoc"] +++
@@ -108,17 +110,17 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
else noHtml
sects = hierarchicalize blocks
toc = if writerTableOfContents opts
- then evalState (tableOfContents opts sects) defaultWriterState
+ then evalState (tableOfContents opts sects) st
else noHtml
- (blocks', newstate) = runState
- (mapM (elementToHtml opts) sects >>= return . toHtmlFromList)
- defaultWriterState
- cssLines = stCSS newstate
+ (blocks', st') = runState
+ (mapM (elementToHtml opts) sects >>= return . toHtmlFromList)
+ st
+ cssLines = stCSS st'
css = if S.null cssLines
then noHtml
else style ! [thetype "text/css"] $ primHtml $
'\n':(unlines $ S.toList cssLines)
- math = if stMath newstate
+ math = if stMath st'
then case writerHTMLMathMethod opts of
LaTeXMathML Nothing ->
primHtml latexMathMLScript
@@ -134,7 +136,7 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
else noHtml
head' = header $ metadata +++ math +++ css +++
primHtml (writerHeader opts)
- notes = reverse (stNotes newstate)
+ notes = reverse (stNotes st')
before = primHtml $ writerIncludeBefore opts
after = primHtml $ writerIncludeAfter opts
thebody = before +++ titleHeader +++ toc +++ blocks' +++
@@ -143,36 +145,49 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
then head' +++ body thebody
else thebody
+-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
+prefixedId :: WriterOptions -> String -> HtmlAttr
+prefixedId opts s = identifier $ writerIdentifierPrefix opts ++ s
+
-- | Construct table of contents from list of elements.
tableOfContents :: WriterOptions -> [Element] -> State WriterState Html
tableOfContents _ [] = return noHtml
tableOfContents opts sects = do
let opts' = opts { writerIgnoreNotes = True }
contents <- mapM (elementToListItem opts') sects
- return $ thediv ! [identifier "TOC"] $ unordList $ catMaybes contents
+ return $ thediv ! [prefixedId opts' "TOC"] $ unordList $ catMaybes contents
+
+-- | Convert section number to string
+showSecNum :: [Int] -> String
+showSecNum = concat . intersperse "." . map show
-- | Converts an Element to a list item for a table of contents,
-- retrieving the appropriate identifier from state.
elementToListItem :: WriterOptions -> Element -> State WriterState (Maybe Html)
elementToListItem _ (Blk _) = return Nothing
-elementToListItem opts (Sec _ id' headerText subsecs) = do
- txt <- inlineListToHtml opts headerText
+elementToListItem opts (Sec _ num id' headerText subsecs) = do
+ let sectnum = if writerNumberSections opts
+ then (thespan ! [theclass "toc-section-number"] << showSecNum num) +++
+ stringToHtml " "
+ else noHtml
+ txt <- liftM (sectnum +++) $ inlineListToHtml opts headerText
subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
let subList = if null subHeads
then noHtml
else unordList subHeads
- return $ Just $ (anchor ! [href ("#" ++ id')] $ txt) +++ subList
+ return $ Just $ (anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList
-- | Convert an Element to Html.
elementToHtml :: WriterOptions -> Element -> State WriterState Html
elementToHtml opts (Blk block) = blockToHtml opts block
-elementToHtml opts (Sec level id' title' elements) = do
+elementToHtml opts (Sec level num id' title' elements) = do
innerContents <- mapM (elementToHtml opts) elements
+ modify $ \st -> st{stSecNum = num} -- update section number
header' <- blockToHtml opts (Header level title')
return $ if writerS5 opts || (writerStrictMarkdown opts && not (writerTableOfContents opts))
-- S5 gets confused by the extra divs around sections
then toHtmlFromList (header' : innerContents)
- else thediv ! [identifier id'] << (header' : innerContents)
+ else thediv ! [prefixedId opts id'] << (header' : innerContents)
-- | Convert list of Note blocks to a footnote <div>.
-- Assumes notes are sorted.
@@ -248,20 +263,20 @@ blockToHtml opts (Plain lst) = inlineListToHtml opts lst
blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
blockToHtml _ (RawHtml str) = return $ primHtml str
blockToHtml _ (HorizontalRule) = return $ hr
-blockToHtml opts (CodeBlock (_,classes,_) rawCode) | "haskell" `elem` classes &&
- writerLiterateHaskell opts =
- let classes' = map (\c -> if c == "haskell" then "literatehaskell" else c) classes
- in blockToHtml opts $ CodeBlock ("",classes',[]) $ intercalate "\n" $ map ("> " ++) $ lines rawCode
-blockToHtml _ (CodeBlock attr@(_,classes,_) rawCode) = do
- case highlightHtml attr rawCode of
+blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
+ let classes' = if writerLiterateHaskell opts
+ then classes
+ else filter (/= "literate") classes
+ case highlightHtml (id',classes',keyvals) rawCode of
Left _ -> -- change leading newlines into <br /> tags, because some
-- browsers ignore leading newlines in pre blocks
let (leadingBreaks, rawCode') = span (=='\n') rawCode
- in return $ pre ! (if null classes
- then []
- else [theclass $ unwords classes]) $ thecode <<
- (replicate (length leadingBreaks) br +++
- [stringToHtml $ rawCode' ++ "\n"])
+ attrs = [theclass (unwords classes') | not (null classes')] ++
+ [prefixedId opts id' | not (null id')] ++
+ map (\(x,y) -> strAttr x y) keyvals
+ in return $ pre ! attrs $ thecode <<
+ (replicate (length leadingBreaks) br +++
+ [stringToHtml $ rawCode' ++ "\n"])
Right h -> addToCSS defaultHighlightingCss >> return h
blockToHtml opts (BlockQuote blocks) =
-- in S5, treat list in blockquote specially
@@ -280,17 +295,22 @@ blockToHtml opts (BlockQuote blocks) =
else blockListToHtml opts blocks >>= (return . blockquote)
blockToHtml opts (Header level lst) = do
contents <- inlineListToHtml opts lst
- let contents' = if writerTableOfContents opts
- then anchor ! [href "#TOC"] $ contents
- else contents
+ secnum <- liftM stSecNum get
+ let contents' = if writerNumberSections opts
+ then (thespan ! [theclass "header-section-number"] << showSecNum secnum) +++
+ stringToHtml " " +++ contents
+ else contents
+ let contents'' = if writerTableOfContents opts
+ then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents'
+ else contents'
return $ case level of
- 1 -> h1 contents'
- 2 -> h2 contents'
- 3 -> h3 contents'
- 4 -> h4 contents'
- 5 -> h5 contents'
- 6 -> h6 contents'
- _ -> paragraph contents'
+ 1 -> h1 contents''
+ 2 -> h2 contents''
+ 3 -> h3 contents''
+ 4 -> h4 contents''
+ 5 -> h5 contents''
+ 6 -> h6 contents''
+ _ -> paragraph contents''
blockToHtml opts (BulletList lst) = do
contents <- mapM (blockListToHtml opts) lst
let attribs = if writerIncremental opts
@@ -311,13 +331,14 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
else [])
return $ ordList ! attribs $ contents
blockToHtml opts (DefinitionList lst) = do
- contents <- mapM (\(term, def) -> do term' <- inlineListToHtml opts term
- def' <- blockListToHtml opts def
- return $ (term', def')) lst
+ contents <- mapM (\(term, defs) ->
+ do term' <- liftM (dterm <<) $ inlineListToHtml opts term
+ defs' <- mapM (liftM (ddef <<) . blockListToHtml opts) defs
+ return $ term' : defs') lst
let attribs = if writerIncremental opts
then [theclass "incremental"]
else []
- return $ defList ! attribs $ contents
+ return $ dlist ! attribs << concat contents
blockToHtml opts (Table capt aligns widths headers rows') = do
let alignStrings = map alignmentToString aligns
captionDoc <- if null capt
@@ -464,9 +485,9 @@ inlineToHtml opts inline =
htmlContents <- blockListToNote opts ref contents
-- push contents onto front of notes
put $ st {stNotes = (htmlContents:notes)}
- return $ anchor ! [href ("#fn" ++ ref),
+ return $ anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref),
theclass "footnoteRef",
- identifier ("fnref" ++ ref)] <<
+ prefixedId opts ("fnref" ++ ref)] <<
sup << ref
(Cite _ il) -> inlineListToHtml opts il
@@ -474,7 +495,7 @@ blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html
blockListToNote opts ref blocks =
-- If last block is Para or Plain, include the backlink at the end of
-- that block. Otherwise, insert a new Plain block with the backlink.
- let backlink = [HtmlInline $ " <a href=\"#fnref" ++ ref ++
+ let backlink = [HtmlInline $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++
"\" class=\"footnoteBackLink\"" ++
" title=\"Jump back to footnote " ++ ref ++ "\">&#8617;</a>"]
blocks' = if null blocks
@@ -489,5 +510,5 @@ blockListToNote opts ref blocks =
_ -> otherBlocks ++ [lastBlock,
Plain backlink]
in do contents <- blockListToHtml opts blocks'
- return $ li ! [identifier ("fn" ++ ref)] $ contents
+ return $ li ! [prefixedId opts ("fn" ++ ref)] $ contents
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index f3cbf1acb..af23f9285 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -31,10 +31,11 @@ module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Printf ( printf )
-import Data.List ( (\\), isSuffixOf, intercalate )
+import Data.List ( (\\), isSuffixOf, intercalate, intersperse )
import Data.Char ( toLower )
import qualified Data.Set as S
import Control.Monad.State
+import Control.Monad (liftM)
import Text.PrettyPrint.HughesPJ hiding ( Str )
data WriterState =
@@ -149,7 +150,8 @@ blockToLaTeX (BlockQuote lst) = do
return $ text "\\begin{quote}" $$ contents $$ text "\\end{quote}"
blockToLaTeX (CodeBlock (_,classes,_) str) = do
st <- get
- env <- if writerLiterateHaskell (stOptions st) && "haskell" `elem` classes
+ env <- if writerLiterateHaskell (stOptions st) && "haskell" `elem` classes &&
+ "literate" `elem` classes
then return "code"
else if stInNote st
then do addToHeader "\\usepackage{fancyvrb}"
@@ -187,26 +189,27 @@ blockToLaTeX (DefinitionList lst) = do
blockToLaTeX HorizontalRule = return $ text $
"\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n"
blockToLaTeX (Header level lst) = do
- txt <- inlineListToLaTeX (deVerb lst)
+ let lst' = deVerb lst
+ txt <- inlineListToLaTeX lst'
+ let noNote (Note _) = Str ""
+ noNote x = x
+ let lstNoNotes = processWith noNote lst'
+ -- footnotes in sections don't work unless you specify an optional
+ -- argument: \section[mysec]{mysec\footnote{blah}}
+ optional <- if lstNoNotes == lst'
+ then return empty
+ else do
+ res <- inlineListToLaTeX lstNoNotes
+ return $ char '[' <> res <> char ']'
return $ if (level > 0) && (level <= 3)
then text ("\\" ++ (concat (replicate (level - 1) "sub")) ++
- "section{") <> txt <> text "}\n"
+ "section") <> optional <> char '{' <> txt <> text "}\n"
else txt <> char '\n'
blockToLaTeX (Table caption aligns widths heads rows) = do
headers <- tableRowToLaTeX heads
captionText <- inlineListToLaTeX caption
rows' <- mapM tableRowToLaTeX rows
- let colWidths = map (printf "%.2f") widths
- let colDescriptors = concat $ zipWith
- (\width align -> ">{\\PBS" ++
- (case align of
- AlignLeft -> "\\raggedright"
- AlignRight -> "\\raggedleft"
- AlignCenter -> "\\centering"
- AlignDefault -> "\\raggedright") ++
- "\\hspace{0pt}}p{" ++ width ++
- "\\columnwidth}")
- colWidths aligns
+ let colDescriptors = concat $ zipWith toColDescriptor widths aligns
let tableBody = text ("\\begin{tabular}{" ++ colDescriptors ++ "}") $$
headers $$ text "\\hline" $$ vcat rows' $$
text "\\end{tabular}"
@@ -220,6 +223,22 @@ blockToLaTeX (Table caption aligns widths heads rows) = do
else text "\\begin{table}[h]" $$ centered tableBody $$
inCmd "caption" captionText $$ text "\\end{table}\n"
+toColDescriptor :: Double -> Alignment -> String
+toColDescriptor 0 align =
+ case align of
+ AlignLeft -> "l"
+ AlignRight -> "r"
+ AlignCenter -> "c"
+ AlignDefault -> "l"
+toColDescriptor width align = ">{\\PBS" ++
+ (case align of
+ AlignLeft -> "\\raggedright"
+ AlignRight -> "\\raggedleft"
+ AlignCenter -> "\\centering"
+ AlignDefault -> "\\raggedright") ++
+ "\\hspace{0pt}}p{" ++ printf "%.2f" width ++
+ "\\columnwidth}"
+
blockListToLaTeX :: [Block] -> State WriterState Doc
blockListToLaTeX lst = mapM blockToLaTeX lst >>= return . vcat
@@ -232,10 +251,10 @@ listItemToLaTeX :: [Block] -> State WriterState Doc
listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item" $$) .
(nest 2)
-defListItemToLaTeX :: ([Inline], [Block]) -> State WriterState Doc
-defListItemToLaTeX (term, def) = do
+defListItemToLaTeX :: ([Inline], [[Block]]) -> State WriterState Doc
+defListItemToLaTeX (term, defs) = do
term' <- inlineListToLaTeX $ deVerb term
- def' <- blockListToLaTeX def
+ def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToLaTeX defs
return $ text "\\item[" <> term' <> text "]" $$ def'
-- | Convert list of inline elements to LaTeX.
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 89c865754..f6f656c4e 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -149,7 +149,7 @@ blockToMan opts (Para inlines) = do
contents <- liftM vcat $ mapM (wrapIfNeeded opts (inlineListToMan opts)) $
splitSentences inlines
return $ text ".PP" $$ contents
-blockToMan _ (RawHtml str) = return $ text str
+blockToMan _ (RawHtml _) = return empty
blockToMan _ HorizontalRule = return $ text $ ".PP\n * * * * *"
blockToMan opts (Header level inlines) = do
contents <- inlineListToMan opts inlines
@@ -171,7 +171,9 @@ blockToMan opts (Table caption alignments widths headers rows) =
in do
caption' <- inlineListToMan opts caption
modify (\(notes, preprocessors) -> (notes, "t":preprocessors))
- let iwidths = map (printf "w(%0.2fn)" . (70 *)) widths
+ let iwidths = if all (== 0) widths
+ then repeat ""
+ else map (printf "w(%0.2fn)" . (70 *)) widths
-- 78n default width - 8n indent = 70n
let coldescriptions = text $ intercalate " "
(zipWith (\align width -> aligncode align ++ width)
@@ -240,19 +242,19 @@ orderedListItemToMan opts num indent (first:rest) = do
-- | Convert definition list item (label, list of blocks) to man.
definitionListItemToMan :: WriterOptions
- -> ([Inline],[Block])
+ -> ([Inline],[[Block]])
-> State WriterState Doc
-definitionListItemToMan opts (label, items) = do
+definitionListItemToMan opts (label, defs) = do
labelText <- inlineListToMan opts label
- contents <- if null items
+ contents <- if null defs
then return empty
- else do
- let (first, rest) = case items of
+ else liftM vcat $ forM defs $ \blocks -> do
+ let (first, rest) = case blocks of
((Para x):y) -> (Plain x,y)
(x:y) -> (x,y)
- [] -> error "items is null"
- rest' <- mapM (\item -> blockToMan opts item)
- rest >>= (return . vcat)
+ [] -> error "blocks is null"
+ rest' <- liftM vcat $
+ mapM (\item -> blockToMan opts item) rest
first' <- blockToMan opts first
return $ first' $$ text ".RS" $$ rest' $$ text ".RE"
return $ text ".TP\n.B " <> labelText $+$ contents
@@ -310,7 +312,7 @@ inlineToMan opts (Math DisplayMath str) = do
contents <- inlineToMan opts (Code str)
return $ text ".RS" $$ contents $$ text ".RE"
inlineToMan _ (TeX _) = return empty
-inlineToMan _ (HtmlInline str) = return $ text $ escapeCode str
+inlineToMan _ (HtmlInline _) = return empty
inlineToMan _ (LineBreak) = return $ text "\n.PD 0\n.P\n.PD\n"
inlineToMan _ Space = return $ char ' '
inlineToMan opts (Link txt (src, _)) = do
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index b2c1dc175..0e1231b62 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -34,7 +34,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Blocks
import Text.ParserCombinators.Parsec ( parse, GenParser )
-import Data.List ( group, isPrefixOf, drop, find, intersperse, intercalate )
+import Data.List ( group, isPrefixOf, drop, find, intersperse, intercalate, transpose )
import Text.PrettyPrint.HughesPJ hiding ( Str )
import Control.Monad.State
@@ -138,7 +138,7 @@ tableOfContents opts headers =
-- | Converts an Element to a list item for a table of contents,
elementToListItem :: Element -> [Block]
elementToListItem (Blk _) = []
-elementToListItem (Sec _ _ headerText subsecs) = [Plain headerText] ++
+elementToListItem (Sec _ _ _ headerText subsecs) = [Plain headerText] ++
if null subsecs
then []
else [BulletList $ map elementToListItem subsecs]
@@ -198,6 +198,7 @@ blockToMarkdown opts (Header level inlines) = do
_ -> empty
else return $ text ((replicate level '#') ++ " ") <> contents <> text "\n"
blockToMarkdown opts (CodeBlock (_,classes,_) str) | "haskell" `elem` classes &&
+ "literate" `elem` classes &&
writerLiterateHaskell opts =
return $ (vcat $ map (text "> " <>) $ map text (lines str)) <> text "\n"
blockToMarkdown opts (CodeBlock _ str) = return $
@@ -217,25 +218,29 @@ blockToMarkdown opts (Table caption aligns widths headers rows) = do
then empty
else text "" $+$ (text "Table: " <> caption')
headers' <- mapM (blockListToMarkdown opts) headers
- let widthsInChars = map (floor . (78 *)) widths
let alignHeader alignment = case alignment of
AlignLeft -> leftAlignBlock
AlignCenter -> centerAlignBlock
AlignRight -> rightAlignBlock
AlignDefault -> leftAlignBlock
+ rawRows <- mapM (mapM (blockListToMarkdown opts)) rows
+ let isSimple = all (==0) widths
+ let numChars = maximum . map (length . render)
+ let widthsInChars =
+ if isSimple
+ then map ((+2) . numChars) $ transpose (headers' : rawRows)
+ else map (floor . (78 *)) widths
let makeRow = hsepBlocks . (zipWith alignHeader aligns) .
(zipWith docToBlock widthsInChars)
let head' = makeRow headers'
- rows' <- mapM (\row -> do cols <- mapM (blockListToMarkdown opts) row
- return $ makeRow cols) rows
+ let rows' = map makeRow rawRows
let maxRowHeight = maximum $ map heightOfBlock (head':rows')
- let isMultilineTable = maxRowHeight > 1
let underline = hsep $
map (\width -> text $ replicate width '-') widthsInChars
- let border = if isMultilineTable
+ let border = if maxRowHeight > 1
then text $ replicate (sum widthsInChars + (length widthsInChars - 1)) '-'
else empty
- let spacer = if isMultilineTable
+ let spacer = if maxRowHeight > 1
then text ""
else empty
let body = vcat $ intersperse spacer $ map blockToDoc rows'
@@ -274,15 +279,14 @@ orderedListItemToMarkdown opts marker items = do
-- | Convert definition list item (label, list of blocks) to markdown.
definitionListItemToMarkdown :: WriterOptions
- -> ([Inline],[Block])
+ -> ([Inline],[[Block]])
-> State WriterState Doc
-definitionListItemToMarkdown opts (label, items) = do
+definitionListItemToMarkdown opts (label, defs) = do
labelText <- inlineListToMarkdown opts label
let tabStop = writerTabStop opts
let leader = char ':'
- contents <- mapM (\item -> blockToMarkdown opts item >>=
- (\txt -> return (leader $$ nest tabStop txt)))
- items >>= return . vcat
+ contents <- liftM vcat $
+ mapM (liftM ((leader $$) . nest tabStop . vcat) . mapM (blockToMarkdown opts)) defs
return $ labelText $+$ contents
-- | Convert list of Pandoc block elements to markdown.
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index c5f6b3bf1..1e7194621 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -33,7 +33,7 @@ module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.XML ( escapeStringForXML )
-import Data.List ( intersect )
+import Data.List ( intersect, intercalate )
import Network.URI ( isURI )
import Control.Monad.State
@@ -141,7 +141,7 @@ blockToMediaWiki opts x@(BulletList items) = do
modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
contents <- mapM (listItemToMediaWiki opts) items
modify $ \s -> s { stListLevel = init (stListLevel s) }
- return $ vcat contents
+ return $ vcat contents ++ "\n"
blockToMediaWiki opts x@(OrderedList attribs items) = do
oldUseTags <- get >>= return . stUseTags
@@ -156,7 +156,7 @@ blockToMediaWiki opts x@(OrderedList attribs items) = do
modify $ \s -> s { stListLevel = stListLevel s ++ "#" }
contents <- mapM (listItemToMediaWiki opts) items
modify $ \s -> s { stListLevel = init (stListLevel s) }
- return $ vcat contents
+ return $ vcat contents ++ "\n"
blockToMediaWiki opts x@(DefinitionList items) = do
oldUseTags <- get >>= return . stUseTags
@@ -171,7 +171,7 @@ blockToMediaWiki opts x@(DefinitionList items) = do
modify $ \s -> s { stListLevel = stListLevel s ++ ";" }
contents <- mapM (definitionListItemToMediaWiki opts) items
modify $ \s -> s { stListLevel = init (stListLevel s) }
- return $ vcat contents
+ return $ vcat contents ++ "\n"
-- Auxiliary functions for lists:
@@ -199,17 +199,19 @@ listItemToMediaWiki opts items = do
-- | Convert definition list item (label, list of blocks) to MediaWiki.
definitionListItemToMediaWiki :: WriterOptions
- -> ([Inline],[Block])
+ -> ([Inline],[[Block]])
-> State WriterState String
definitionListItemToMediaWiki opts (label, items) = do
labelText <- inlineListToMediaWiki opts label
- contents <- blockListToMediaWiki opts items
+ contents <- mapM (blockListToMediaWiki opts) items
useTags <- get >>= return . stUseTags
if useTags
- then return $ "<dt>" ++ labelText ++ "</dt>\n<dd>" ++ contents ++ "</dd>"
+ then return $ "<dt>" ++ labelText ++ "</dt>\n" ++
+ (intercalate "\n" $ map (\d -> "<dd>" ++ d ++ "</dd>") contents)
else do
marker <- get >>= return . stListLevel
- return $ marker ++ " " ++ labelText ++ "\n" ++ (init marker ++ ": ") ++ contents
+ return $ marker ++ " " ++ labelText ++ "\n" ++
+ (intercalate "\n" $ map (\d -> init marker ++ ": " ++ d) contents)
-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.
isSimpleList :: Block -> Bool
@@ -218,7 +220,7 @@ isSimpleList x =
BulletList items -> all isSimpleListItem items
OrderedList (num, sty, _) items -> all isSimpleListItem items &&
num == 1 && sty `elem` [DefaultStyle, Decimal]
- DefinitionList items -> all isSimpleListItem $ map snd items
+ DefinitionList items -> all isSimpleListItem $ concatMap snd items
_ -> False
-- | True if list item can be handled with the simple wiki syntax. False if
@@ -251,9 +253,7 @@ tr x = "<tr>\n" ++ x ++ "\n</tr>"
-- | Concatenates strings with line breaks between them.
vcat :: [String] -> String
-vcat [] = ""
-vcat [x] = x
-vcat (x:xs) = x ++ "\n" ++ vcat xs
+vcat = intercalate "\n"
-- Auxiliary functions for tables:
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 52438f81e..15e7f30bd 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -260,14 +260,14 @@ listItemsToOpenDocument :: String -> WriterOptions -> [[Block]] -> State WriterS
listItemsToOpenDocument s o is =
vcat . map (inTagsIndented "text:list-item") <$> mapM (withParagraphStyle o s . map plainToPara) is
-deflistItemToOpenDocument :: WriterOptions -> ([Inline],[Block]) -> State WriterState Doc
+deflistItemToOpenDocument :: WriterOptions -> ([Inline],[[Block]]) -> State WriterState Doc
deflistItemToOpenDocument o (t,d) = do
- let ts = if isTightList [d]
+ let ts = if isTightList d
then "Definition_20_Term_20_Tight" else "Definition_20_Term"
- ds = if isTightList [d]
+ ds = if isTightList d
then "Definition_20_Definition_20_Tight" else "Definition_20_Definition"
t' <- withParagraphStyle o ts [Para t]
- d' <- withParagraphStyle o ds (map plainToPara d)
+ d' <- liftM vcat $ mapM (withParagraphStyle o ds . (map plainToPara)) d
return $ t' $$ d'
inBlockQuote :: WriterOptions -> Int -> [Block] -> State WriterState Doc
@@ -467,13 +467,15 @@ tableStyle num wcs =
table = inTags True "style:style"
[("style:name", tableId)] $
selfClosingTag "style:table-properties"
- [ ("style:rel-width", "100%" )
- , ("table:align" , "center")]
+ [("table:align" , "center")]
+ colStyle (c,0) = selfClosingTag "style:style"
+ [ ("style:name" , tableId ++ "." ++ [c])
+ , ("style:family", "table-column" )]
colStyle (c,w) = inTags True "style:style"
[ ("style:name" , tableId ++ "." ++ [c])
, ("style:family", "table-column" )] $
selfClosingTag "style:table-column-properties"
- [("style:column-width", printf "%.2f" (7 * w) ++ "in")]
+ [("style:rel-column-width", printf "%d*" $ (floor $ w * 65535 :: Integer))]
cellStyle = inTags True "style:style"
[ ("style:name" , tableId ++ ".A1")
, ("style:family", "table-cell" )] $
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 728c78712..31c039bd7 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -33,7 +33,7 @@ module Text.Pandoc.Writers.RST ( writeRST) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Blocks
-import Data.List ( isPrefixOf, isSuffixOf, drop, intersperse )
+import Data.List ( isPrefixOf, isSuffixOf, drop, intersperse, transpose )
import Text.PrettyPrint.HughesPJ hiding ( Str )
import Control.Monad.State
import Control.Applicative ( (<$>) )
@@ -183,7 +183,8 @@ blockToRST (Header level inlines) = do
blockToRST (CodeBlock (_,classes,_) str) = do
opts <- stOptions <$> get
let tabstop = writerTabStop opts
- if "haskell" `elem` classes && writerLiterateHaskell opts
+ if "haskell" `elem` classes && "literate" `elem` classes &&
+ writerLiterateHaskell opts
then return $ (vcat $ map (text "> " <>) $ map text (lines str)) <> text "\n"
else return $ (text "::\n") $+$
(nest tabstop $ vcat $ map text (lines str)) <> text "\n"
@@ -197,7 +198,13 @@ blockToRST (Table caption _ widths headers rows) = do
then empty
else text "" $+$ (text "Table: " <> caption')
headers' <- mapM blockListToRST headers
- let widthsInChars = map (floor . (78 *)) widths
+ rawRows <- mapM (mapM blockListToRST) rows
+ let isSimple = all (==0) widths && all (all (\bs -> length bs == 1)) rows
+ let numChars = maximum . map (length . render)
+ let widthsInChars =
+ if isSimple
+ then map ((+2) . numChars) $ transpose (headers' : rawRows)
+ else map (floor . (78 *)) widths
let hpipeBlocks blocks = hcatBlocks [beg, middle, end]
where height = maximum (map heightOfBlock blocks)
sep' = TextBlock 3 height (replicate height " | ")
@@ -250,10 +257,10 @@ orderedListItemToRST marker items = do
return $ (text marker <> char ' ') <> contents
-- | Convert defintion list item (label, list of blocks) to RST.
-definitionListItemToRST :: ([Inline], [Block]) -> State WriterState Doc
-definitionListItemToRST (label, items) = do
+definitionListItemToRST :: ([Inline], [[Block]]) -> State WriterState Doc
+definitionListItemToRST (label, defs) = do
label' <- inlineListToRST label
- contents <- blockListToRST items
+ contents <- liftM vcat $ mapM blockListToRST defs
tabstop <- get >>= (return . writerTabStop . stOptions)
return $ label' $+$ nest tabstop contents
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index 62d8c4a0c..15bac115d 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -59,7 +59,7 @@ tableOfContents headers =
elementToListItem :: Element -> [Block]
elementToListItem (Blk _) = []
-elementToListItem (Sec _ _ sectext subsecs) = [Plain sectext] ++
+elementToListItem (Sec _ _ _ sectext subsecs) = [Plain sectext] ++
if null subsecs
then []
else [BulletList (map elementToListItem subsecs)]
@@ -191,9 +191,12 @@ blockToRTF indent alignment (Table caption aligns sizes headers rows) =
rtfPar indent 0 alignment (inlineListToRTF caption)
tableRowToRTF :: Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> String
-tableRowToRTF header indent aligns sizes cols =
- let columns = concat $ zipWith (tableItemToRTF indent) aligns cols
- totalTwips = 6 * 1440 -- 6 inches
+tableRowToRTF header indent aligns sizes' cols =
+ let totalTwips = 6 * 1440 -- 6 inches
+ sizes = if all (== 0) sizes'
+ then take (length cols) $ repeat (1.0 / fromIntegral (length cols))
+ else sizes'
+ columns = concat $ zipWith (tableItemToRTF indent) aligns cols
rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips))
(0 :: Integer) sizes
cellDefs = map (\edge -> (if header
@@ -244,11 +247,12 @@ listItemToRTF alignment indent marker list =
-- | Convert definition list item (label, list of blocks) to RTF.
definitionListItemToRTF :: Alignment -- ^ alignment
-> Int -- ^ indent level
- -> ([Inline],[Block]) -- ^ list item (list of blocks)
+ -> ([Inline],[[Block]]) -- ^ list item (list of blocks)
-> [Char]
-definitionListItemToRTF alignment indent (label, items) =
+definitionListItemToRTF alignment indent (label, defs) =
let labelText = blockToRTF indent alignment (Plain label)
- itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) items
+ itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) $
+ concat defs
in labelText ++ itemsText
-- | Convert list of inline items to RTF.
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index 305a1a8d0..5b706d24b 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -32,7 +32,8 @@ import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath
import Text.Printf ( printf )
-import Data.List ( isSuffixOf )
+import Data.List ( isSuffixOf, transpose, maximumBy )
+import Data.Ord ( comparing )
import Data.Char ( chr, ord )
import qualified Data.Set as S
import Control.Monad.State
@@ -104,8 +105,10 @@ texinfoHeader options (Meta title authors date) = do
then empty
else text $ stringToTexinfo date
- let baseHeader = text $ writerHeader options
- let header = baseHeader $$ extras
+ let baseHeader = case writerHeader options of
+ "" -> empty
+ x -> text x
+ let header = text "@documentencoding utf-8" $$ baseHeader $$ extras
return $ text "\\input texinfo" $$
header $$
text "@ifnottex" $$
@@ -223,9 +226,14 @@ blockToTexinfo (Table caption aligns widths heads rows) = do
headers <- tableHeadToTexinfo aligns heads
captionText <- inlineListToTexinfo caption
rowsText <- mapM (tableRowToTexinfo aligns) rows
- let colWidths = map (printf "%.2f ") widths
- let colDescriptors = concat colWidths
- let tableBody = text ("@multitable @columnfractions " ++ colDescriptors) $$
+ colDescriptors <-
+ if all (== 0) widths
+ then do -- use longest entry instead of column widths
+ cols <- mapM (mapM (liftM (render . hcat) . mapM blockToTexinfo)) $
+ transpose $ heads : rows
+ return $ concatMap ((\x -> "{"++x++"} ") . maximumBy (comparing length)) cols
+ else return $ "@columnfractions " ++ concatMap (printf "%.2f ") widths
+ let tableBody = text ("@multitable " ++ colDescriptors) $$
headers $$
vcat rowsText $$
text "@end multitable"
@@ -331,11 +339,11 @@ listItemToTexinfo :: [Block]
listItemToTexinfo lst = blockListToTexinfo lst >>=
return . (text "@item" $$)
-defListItemToTexinfo :: ([Inline], [Block])
+defListItemToTexinfo :: ([Inline], [[Block]])
-> State WriterState Doc
-defListItemToTexinfo (term, def) = do
+defListItemToTexinfo (term, defs) = do
term' <- inlineListToTexinfo term
- def' <- blockListToTexinfo def
+ def' <- liftM vcat $ mapM blockListToTexinfo defs
return $ text "@item " <> term' <> text "\n" $$ def'
-- | Convert list of inline elements to Texinfo.
diff --git a/src/Text/Pandoc/XML.hs b/src/Text/Pandoc/XML.hs
index 14e2eebbb..a5d0202e5 100644
--- a/src/Text/Pandoc/XML.hs
+++ b/src/Text/Pandoc/XML.hs
@@ -27,7 +27,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Functions for escaping and formatting XML.
-}
-module Text.Pandoc.XML ( escapeCharForXML,
+module Text.Pandoc.XML ( stripTags,
+ escapeCharForXML,
escapeStringForXML,
inTags,
selfClosingTag,
@@ -35,6 +36,16 @@ module Text.Pandoc.XML ( escapeCharForXML,
inTagsIndented ) where
import Text.PrettyPrint.HughesPJ
+-- | Remove everything between <...>
+stripTags :: String -> String
+stripTags ('<':xs) =
+ let (_,rest) = break (=='>') xs
+ in if null rest
+ then ""
+ else stripTags (tail rest) -- leave off >
+stripTags (x:xs) = x : stripTags xs
+stripTags [] = []
+
-- | Escape one character as needed for XML.
escapeCharForXML :: Char -> String
escapeCharForXML x = case x of
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-21 20:41:24 +0000