aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Definition.hs21
-rw-r--r--src/Text/Pandoc/ParserCombinators.hs62
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs19
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs30
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs41
-rw-r--r--src/Text/Pandoc/Readers/RST.hs55
-rw-r--r--src/Text/Pandoc/Shared.hs166
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs21
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs17
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs78
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs24
-rw-r--r--src/Text/Pandoc/Writers/Man.hs33
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs31
-rw-r--r--src/Text/Pandoc/Writers/RST.hs56
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs16
15 files changed, 493 insertions, 177 deletions
diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs
index a1abfcb50..3d3858b7e 100644
--- a/src/Text/Pandoc/Definition.hs
+++ b/src/Text/Pandoc/Definition.hs
@@ -45,6 +45,23 @@ data Alignment = AlignLeft
| AlignCenter
| AlignDefault deriving (Eq, Show, Read)
+-- | List attributes.
+type ListAttributes = (Int, ListNumberStyle, ListNumberDelim)
+
+-- | Style of list numbers.
+data ListNumberStyle = DefaultStyle
+ | Decimal
+ | LowerRoman
+ | UpperRoman
+ | LowerAlpha
+ | UpperAlpha deriving (Eq, Show, Read)
+
+-- | Delimiter of list numbers.
+data ListNumberDelim = DefaultDelim
+ | Period
+ | OneParen
+ | TwoParens deriving (Eq, Show, Read)
+
-- | Block element.
data Block
= Plain [Inline] -- ^ Plain text, not a paragraph
@@ -53,8 +70,8 @@ data Block
| CodeBlock String -- ^ Code block (literal)
| RawHtml String -- ^ Raw HTML block (literal)
| BlockQuote [Block] -- ^ Block quote (list of blocks)
- | OrderedList [[Block]] -- ^ Ordered list (list of items, each
- -- a list of blocks)
+ | OrderedList ListAttributes [[Block]] -- ^ Ordered list (attributes,
+ -- 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
diff --git a/src/Text/Pandoc/ParserCombinators.hs b/src/Text/Pandoc/ParserCombinators.hs
index 189f97182..559a654cc 100644
--- a/src/Text/Pandoc/ParserCombinators.hs
+++ b/src/Text/Pandoc/ParserCombinators.hs
@@ -40,7 +40,10 @@ module Text.Pandoc.ParserCombinators (
stringAnyCase,
parseFromString,
lineClump,
- charsInBalanced
+ charsInBalanced,
+ charsInBalanced',
+ romanNumeral,
+ withHorizDisplacement
) where
import Text.ParserCombinators.Parsec
import Data.Char ( toUpper, toLower )
@@ -127,7 +130,8 @@ lineClump = do
-- and a close character, including text between balanced
-- pairs of open and close. For example,
-- @charsInBalanced '(' ')'@ will parse "(hello (there))"
--- and return "hello (there)".
+-- and return "hello (there)". Stop if a blank line is
+-- encountered.
charsInBalanced :: Char -> Char -> GenParser Char st String
charsInBalanced open close = try $ do
char open
@@ -138,3 +142,57 @@ charsInBalanced open close = try $ do
(char close)
return $ concat raw
+-- | Like charsInBalanced, but allow blank lines in the content.
+charsInBalanced' :: Char -> Char -> GenParser Char st String
+charsInBalanced' open close = try $ do
+ char open
+ raw <- manyTill ( (do res <- charsInBalanced open close
+ return $ [open] ++ res ++ [close])
+ <|> count 1 anyChar)
+ (char close)
+ return $ concat raw
+
+-- | Parses a roman numeral (uppercase or lowercase), returns number.
+romanNumeral :: Bool -> -- ^ Uppercase if true
+ GenParser Char st Int
+romanNumeral upper = try $ do
+ let char' c = char (if upper then toUpper c else c)
+ let one = char' 'i'
+ let five = char' 'v'
+ let ten = char' 'x'
+ let fifty = char' 'l'
+ let hundred = char' 'c'
+ let fivehundred = char' 'd'
+ let thousand = char' 'm'
+ thousands <- many thousand >>= (return . (1000 *) . length)
+ ninehundreds <- option 0 $ try $ hundred >> thousand >> return 900
+ fivehundreds <- many fivehundred >>= (return . (500 *) . length)
+ fourhundreds <- option 0 $ try $ hundred >> fivehundred >> return 400
+ hundreds <- many hundred >>= (return . (100 *) . length)
+ nineties <- option 0 $ try $ ten >> hundred >> return 90
+ fifties <- many fifty >>= (return . (50 *) . length)
+ forties <- option 0 $ try $ ten >> fifty >> return 40
+ tens <- many ten >>= (return . (10 *) . length)
+ nines <- option 0 $ try $ one >> ten >> return 9
+ fives <- many five >>= (return . (5*) . length)
+ fours <- option 0 $ try $ one >> five >> return 4
+ ones <- many one >>= (return . length)
+ let total = thousands + ninehundreds + fivehundreds + fourhundreds +
+ hundreds + nineties + fifties + forties + tens + nines +
+ fives + fours + ones
+ if total == 0
+ then fail "not a roman numeral"
+ else return total
+
+-- | Applies a parser, returns tuple of its results and its horizontal
+-- displacement (the difference between the source column at the end
+-- and the source column at the beginning). Vertical displacement
+-- (source row) is ignored.
+withHorizDisplacement :: GenParser Char st a -- ^ Parser to apply
+ -> GenParser Char st (a, Int) -- ^ (result, displacement)
+withHorizDisplacement parser = do
+ pos1 <- getPosition
+ result <- parser
+ pos2 <- getPosition
+ return (result, sourceColumn pos2 - sourceColumn pos1)
+
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 270c7ba21..1742667b8 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -354,11 +354,26 @@ blockQuote = try (do
list = choice [ bulletList, orderedList, definitionList ] <?> "list"
orderedList = try $ do
- htmlTag "ol"
+ (_, attribs) <- htmlTag "ol"
+ (start, style) <- option (1, DefaultStyle) $
+ do failIfStrict
+ let sta = fromMaybe "1" $
+ lookup "start" attribs
+ let sty = fromMaybe (fromMaybe "" $
+ lookup "style" attribs) $
+ lookup "class" attribs
+ let sty' = case sty of
+ "lower-roman" -> LowerRoman
+ "upper-roman" -> UpperRoman
+ "lower-alpha" -> LowerAlpha
+ "upper-alpha" -> UpperAlpha
+ "decimal" -> Decimal
+ _ -> DefaultStyle
+ return (read sta, sty')
spaces
items <- sepEndBy1 (blocksIn "li") spaces
htmlEndTag "ol"
- return (OrderedList items)
+ return (OrderedList (start, style, DefaultDelim) items)
bulletList = try $ do
htmlTag "ul"
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 77ed4607a..73a3e4a8f 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -59,12 +59,8 @@ specialChars = "\\$%&^&_~#{}\n \t|<>'\"-"
-- | Returns text between brackets and its matching pair.
bracketedText openB closeB = try (do
- char openB
- result <- many (choice [ oneOfStrings [ ['\\', openB], ['\\', closeB] ],
- count 1 (noneOf [openB, closeB]),
- bracketedText openB closeB ])
- char closeB
- return ([openB] ++ (concat result) ++ [closeB]))
+ result <- charsInBalanced' openB closeB
+ return ([openB] ++ result ++ [closeB]))
-- | Returns an option or argument of a LaTeX command.
optOrArg = choice [ (bracketedText '{' '}'), (bracketedText '[' ']') ]
@@ -255,12 +251,30 @@ listItem = try $ do
return (opt, blocks)
orderedList = try $ do
- begin "enumerate"
+ string "\\begin{enumerate}"
+ (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
+ try $ do failIfStrict
+ char '['
+ res <- anyOrderedListMarker
+ char ']'
+ return res
spaces
+ option "" $ try $ do string "\\setlength{\\itemindent}"
+ char '{'
+ manyTill anyChar (char '}')
+ spaces
+ start <- option 1 $ try $ do failIfStrict
+ string "\\setcounter{enum"
+ many1 (char 'i')
+ string "}{"
+ num <- many1 digit
+ char '}'
+ spaces
+ return $ (read num) + 1
items <- many listItem
end "enumerate"
spaces
- return (OrderedList $ map snd items)
+ return $ OrderedList (start, style, delim) $ map snd items
bulletList = try $ do
begin "itemize"
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 0ecb09178..3ccb74ba7 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -243,6 +243,8 @@ header = choice [ setextHeader, atxHeader ] <?> "header"
atxHeader = try (do
lead <- many1 (char '#')
+ notFollowedBy (char '.') -- this would be a list
+ notFollowedBy (char ')')
skipSpaces
txt <- manyTill inline atxClosing
return (Header (length lead) (normalizeSpaces txt)))
@@ -354,27 +356,33 @@ blockQuote = do
list = choice [ bulletList, orderedList, definitionList ] <?> "list"
-bulletListStart = try (do
+bulletListStart = try $ do
option ' ' newline -- if preceded by a Plain block in a list context
nonindentSpaces
notFollowedBy' hrule -- because hrules start out just like lists
oneOf bulletListMarkers
spaceChar
- skipSpaces)
-
-standardOrderedListStart = try (do
- many1 digit
- char '.')
+ skipSpaces
-extendedOrderedListStart = try (do
- failIfStrict
- oneOf ['a'..'n']
- oneOf ".)")
+anyOrderedListStart = try $ do
+ option ' ' newline -- if preceded by a Plain block in a list context
+ nonindentSpaces
+ state <- getState
+ if stateStrict state
+ then do many1 digit
+ char '.'
+ return (1, DefaultStyle, DefaultDelim)
+ else anyOrderedListMarker
-orderedListStart = try $ do
+orderedListStart style delim = try $ do
option ' ' newline -- if preceded by a Plain block in a list context
nonindentSpaces
- standardOrderedListStart <|> extendedOrderedListStart
+ state <- getState
+ if stateStrict state
+ then do many1 digit
+ char '.'
+ return 1
+ else orderedListMarker style delim
oneOf spaceChars
skipSpaces
@@ -385,7 +393,7 @@ listLine start = try (do
notFollowedBy' (do
indentSpaces
many (spaceChar)
- choice [bulletListStart, orderedListStart])
+ choice [bulletListStart, anyOrderedListStart >> return ()])
line <- manyTill anyChar newline
return (line ++ "\n"))
@@ -431,9 +439,10 @@ listItem start = try (do
return contents)
orderedList = try (do
- items <- many1 (listItem orderedListStart)
+ (start, style, delim) <- lookAhead anyOrderedListStart
+ items <- many1 (listItem (orderedListStart style delim))
let items' = compactify items
- return (OrderedList items'))
+ return (OrderedList (start, style, delim) items'))
bulletList = try (do
items <- many1 (listItem bulletListStart)
@@ -906,7 +915,7 @@ endline = try (do
else return ()
-- parse potential list-starts differently if in a list:
if (stateParserContext st) == ListItemState
- then notFollowedBy' (orderedListStart <|> bulletListStart)
+ then notFollowedBy' $ choice [bulletListStart, anyOrderedListStart >> return ()]
else return ()
return Space)
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 83c5383bd..a36c33d92 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -379,46 +379,11 @@ bulletListStart = try (do
let len = length (marker:white)
return len)
-withPeriodSuffix parser = try (do
- a <- parser
- b <- char '.'
- return (a ++ [b]))
-
-withParentheses parser = try (do
- a <- char '('
- b <- parser
- c <- char ')'
- return ([a] ++ b ++ [c]))
-
-withRightParen parser = try (do
- a <- parser
- b <- char ')'
- return (a ++ [b]))
-
-upcaseWord = map toUpper
-
-romanNumeral = do
- let lowerNumerals = ["i", "ii", "iii", "iiii", "iv", "v", "vi",
- "vii", "viii", "ix", "x", "xi", "xii", "xiii",
- "xiv", "xv", "xvi", "xvii", "xviii", "xix", "xx",
- "xxi", "xxii", "xxiii", "xxiv" ]
- let upperNumerals = map upcaseWord lowerNumerals
- result <- choice $ map string (lowerNumerals ++ upperNumerals)
- return result
-
-orderedListEnumerator = choice [ many1 digit,
- count 1 (char '#'),
- count 1 letter,
- romanNumeral ]
-
-- parses ordered list start and returns its length (inc following whitespace)
-orderedListStart = try (do
- marker <- choice [ withPeriodSuffix orderedListEnumerator,
- withParentheses orderedListEnumerator,
- withRightParen orderedListEnumerator ]
+orderedListStart style delim = try $ do
+ (_, markerLen) <- withHorizDisplacement (orderedListMarker style delim)
white <- many1 spaceChar
- let len = length (marker ++ white)
- return len)
+ return $ markerLen + length white
-- parse a line of a list item
listLine markerLength = try (do
@@ -437,11 +402,11 @@ indentWith num = do
(try (do {char '\t'; count (num - tabStop) (char ' ')})) ]
-- parse raw text for one list item, excluding start marker and continuations
-rawListItem start = try (do
+rawListItem start = try $ do
markerLength <- start
firstLine <- manyTill anyChar newline
restLines <- many (listLine markerLength)
- return (markerLength, (firstLine ++ "\n" ++ (concat restLines))))
+ return (markerLength, (firstLine ++ "\n" ++ (concat restLines)))
-- continuation of a list item - indented and separated by blankline or
-- (in compact lists) endline.
@@ -473,10 +438,11 @@ listItem start = try (do
updateState (\st -> st {stateParserContext = oldContext})
return parsed)
-orderedList = try (do
- items <- many1 (listItem orderedListStart)
+orderedList = try $ do
+ (start, style, delim) <- lookAhead anyOrderedListMarker
+ items <- many1 (listItem (orderedListStart style delim))
let items' = compactify items
- return (OrderedList items'))
+ return (OrderedList (start, style, delim) items')
bulletList = try (do
items <- many1 (listItem bulletListStart)
@@ -611,7 +577,8 @@ endline = try (do
-- parse potential list-starts at beginning of line differently in a list:
st <- getState
if ((stateParserContext st) == ListItemState)
- then notFollowedBy' (choice [orderedListStart, bulletListStart])
+ then do notFollowedBy' anyOrderedListMarker
+ notFollowedBy' bulletListStart
else option () pzero
return Space)
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index b79af235d..587e3891a 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -43,6 +43,8 @@ module Text.Pandoc.Shared (
removeLeadingSpace,
removeTrailingSpace,
stripFirstAndLast,
+ camelCaseToHyphenated,
+ toRomanNumeral,
-- * Parsing
readWith,
testStringWith,
@@ -59,9 +61,12 @@ module Text.Pandoc.Shared (
nullBlock,
failIfStrict,
escaped,
+ anyOrderedListMarker,
+ orderedListMarker,
-- * Native format prettyprinting
prettyPandoc,
-- * Pandoc block and inline list processing
+ orderedListMarkers,
normalizeSpaces,
compactify,
Element (..),
@@ -77,8 +82,9 @@ module Text.Pandoc.Shared (
) where
import Text.Pandoc.Definition
import Text.ParserCombinators.Parsec
+import Text.Pandoc.ParserCombinators
import Text.Pandoc.Entities ( decodeEntities, escapeStringForXML )
-import Data.Char ( toLower, ord )
+import Data.Char ( toLower, toUpper, ord, chr, isLower, isUpper )
import Data.List ( find, groupBy, isPrefixOf )
-- | Parse a string with a given parser and state.
@@ -199,6 +205,105 @@ escaped parser = try (do
result <- parser
return (Str [result]))
+-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
+upperRoman :: GenParser Char st (ListNumberStyle, Int)
+upperRoman = do
+ num <- romanNumeral True
+ return (UpperRoman, num)
+
+-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
+lowerRoman :: GenParser Char st (ListNumberStyle, Int)
+lowerRoman = do
+ num <- romanNumeral False
+ return (LowerRoman, num)
+
+-- | Parses a decimal numeral and returns (Decimal, number).
+decimal :: GenParser Char st (ListNumberStyle, Int)
+decimal = do
+ num <- many1 digit
+ return (Decimal, read num)
+
+-- | Parses a '#' returns (DefaultStyle, 1).
+defaultNum :: GenParser Char st (ListNumberStyle, Int)
+defaultNum = do
+ char '#'
+ return (DefaultStyle, 1)
+
+-- | Parses a lowercase letter and returns (LowerAlpha, number).
+lowerAlpha :: GenParser Char st (ListNumberStyle, Int)
+lowerAlpha = do
+ ch <- oneOf ['a'..'z']
+ return (LowerAlpha, ord ch - ord 'a' + 1)
+
+-- | Parses an uppercase letter and returns (UpperAlpha, number).
+upperAlpha :: GenParser Char st (ListNumberStyle, Int)
+upperAlpha = do
+ ch <- oneOf ['A'..'Z']
+ return (UpperAlpha, ord ch - ord 'A' + 1)
+
+-- | Parses a roman numeral i or I
+romanOne :: GenParser Char st (ListNumberStyle, Int)
+romanOne = (do char 'i'
+ return (LowerRoman, 1)) <|>
+ (do char 'I'
+ return (UpperRoman, 1))
+
+-- | Parses an ordered list marker and returns list attributes.
+anyOrderedListMarker :: GenParser Char st ListAttributes
+anyOrderedListMarker = choice $ [delimParser numParser | delimParser <-
+ [inPeriod, inOneParen, inTwoParens],
+ numParser <- [decimal, defaultNum, romanOne,
+ lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
+
+-- | Parses a list number (num) followed by a period, returns list attributes.
+inPeriod :: GenParser Char st (ListNumberStyle, Int)
+ -> GenParser Char st ListAttributes
+inPeriod num = try $ do
+ (style, start) <- num
+ char '.'
+ let delim = if style == DefaultStyle
+ then DefaultDelim
+ else Period
+ return (start, style, delim)
+
+-- | Parses a list number (num) followed by a paren, returns list attributes.
+inOneParen :: GenParser Char st (ListNumberStyle, Int)
+ -> GenParser Char st ListAttributes
+inOneParen num = try $ do
+ (style, start) <- num
+ char ')'
+ return (start, style, OneParen)
+
+-- | Parses a list number (num) enclosed in parens, returns list attributes.
+inTwoParens :: GenParser Char st (ListNumberStyle, Int)
+ -> GenParser Char st ListAttributes
+inTwoParens num = try $ do
+ char '('
+ (style, start) <- num
+ char ')'
+ return (start, style, TwoParens)
+
+-- | Parses an ordered list marker with a given style and delimiter,
+-- returns number.
+orderedListMarker :: ListNumberStyle
+ -> ListNumberDelim
+ -> GenParser Char st Int
+orderedListMarker style delim = do
+ let num = case style of
+ DefaultStyle -> decimal <|> defaultNum
+ Decimal -> decimal
+ UpperRoman -> upperRoman
+ LowerRoman -> lowerRoman
+ UpperAlpha -> upperAlpha
+ LowerAlpha -> lowerAlpha
+ let context = case delim of
+ DefaultDelim -> inPeriod
+ Period -> inPeriod
+ OneParen -> inOneParen
+ TwoParens -> inTwoParens
+ (start, style, delim) <- context num
+ return start
+
-- | Indent string as a block.
indentBy :: Int -- ^ Number of spaces to indent the block
-> Int -- ^ Number of spaces (rel to block) to indent first line
@@ -222,9 +327,10 @@ prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++
prettyBlock :: Block -> String
prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++
(prettyBlockList 2 blocks)
-prettyBlock (OrderedList blockLists) =
- "OrderedList\n" ++ indentBy 2 0 ("[ " ++ (joinWithSep ", "
- (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
+prettyBlock (OrderedList attribs blockLists) =
+ "OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++
+ (joinWithSep ", " $ map (\blocks -> prettyBlockList 2 blocks)
+ blockLists)) ++ " ]"
prettyBlock (BulletList blockLists) = "BulletList\n" ++
indentBy 2 0 ("[ " ++ (joinWithSep ", "
(map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
@@ -317,9 +423,17 @@ removeTrailingSpace :: String -> String
removeTrailingSpace = reverse . removeLeadingSpace . reverse
-- | Strip leading and trailing characters from string
+stripFirstAndLast :: String -> String
stripFirstAndLast str =
drop 1 $ take ((length str) - 1) str
+-- | Change CamelCase word to hyphenated lowercase (e.g., camel-case).
+camelCaseToHyphenated :: String -> String
+camelCaseToHyphenated "" = ""
+camelCaseToHyphenated (a:b:rest) | isLower a && isUpper b =
+ a:'-':(toLower b):(camelCaseToHyphenated rest)
+camelCaseToHyphenated (a:rest) = (toLower a):(camelCaseToHyphenated rest)
+
-- | Replace each occurrence of one sublist in a list with another.
substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]
substitute _ _ [] = []
@@ -344,6 +458,46 @@ splitByIndices (x:xs) lst =
let (first, rest) = splitAt x lst in
first:(splitByIndices (map (\y -> y - x) xs) rest)
+-- | Generate infinite lazy list of markers for an ordered list,
+-- depending on list attributes.
+orderedListMarkers :: (Int, ListNumberStyle, ListNumberDelim) -> [String]
+orderedListMarkers (start, numstyle, numdelim) =
+ let singleton c = [c]
+ seq = case numstyle of
+ DefaultStyle -> map show [start..]
+ Decimal -> map show [start..]
+ UpperAlpha -> drop (start - 1) $ cycle $ map singleton ['A'..'Z']
+ LowerAlpha -> drop (start - 1) $ cycle $ map singleton ['a'..'z']
+ UpperRoman -> map toRomanNumeral [start..]
+ LowerRoman -> map (map toLower . toRomanNumeral) [start..]
+ inDelim str = case numdelim of
+ DefaultDelim -> str ++ "."
+ Period -> str ++ "."
+ OneParen -> str ++ ")"
+ TwoParens -> "(" ++ str ++ ")"
+ in map inDelim seq
+
+-- | Convert number < 4000 to uppercase roman numeral.
+toRomanNumeral :: Int -> String
+toRomanNumeral x =
+ if x >= 4000 || x < 0
+ then "?"
+ else case x of
+ x | x >= 1000 -> "M" ++ toRomanNumeral (x - 1000)
+ x | x >= 900 -> "CM" ++ toRomanNumeral (x - 900)
+ x | x >= 500 -> "D" ++ toRomanNumeral (x - 500)
+ x | x >= 400 -> "CD" ++ toRomanNumeral (x - 400)
+ x | x >= 100 -> "C" ++ toRomanNumeral (x - 100)
+ x | x >= 90 -> "XC" ++ toRomanNumeral (x - 90)
+ x | x >= 50 -> "L" ++ toRomanNumeral (x - 50)
+ x | x >= 40 -> "XL" ++ toRomanNumeral (x - 40)
+ x | x >= 10 -> "X" ++ toRomanNumeral (x - 10)
+ x | x >= 9 -> "IX" ++ toRomanNumeral (x - 5)
+ x | x >= 5 -> "V" ++ toRomanNumeral (x - 5)
+ x | x >= 4 -> "IV" ++ toRomanNumeral (x - 4)
+ x | x >= 1 -> "I" ++ toRomanNumeral (x - 1)
+ 0 -> ""
+
-- | Normalize a list of inline elements: remove leading and trailing
-- @Space@ elements, collapse double @Space@s into singles, and
-- remove empty Str elements.
@@ -383,8 +537,8 @@ containsPara [] = False
containsPara ((Para a):rest) = True
containsPara ((BulletList items):rest) = (any containsPara items) ||
(containsPara rest)
-containsPara ((OrderedList items):rest) = (any containsPara items) ||
- (containsPara rest)
+containsPara ((OrderedList _ items):rest) = (any containsPara items) ||
+ (containsPara rest)
containsPara (x:rest) = containsPara rest
-- | Data structure for defining hierarchical Pandoc documents
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index d5f0ba1d0..1f93787b0 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -122,9 +122,20 @@ blockToConTeXt (RawHtml str) = return ""
blockToConTeXt (BulletList lst) = do
contents <- mapM listItemToConTeXt lst
return $ "\\startltxitem\n" ++ concat contents ++ "\\stopltxitem\n"
-blockToConTeXt (OrderedList lst) = do
- contents <- mapM listItemToConTeXt lst
- return $ "\\startltxenum\n" ++ concat contents ++ "\\stopltxenum\n"
+blockToConTeXt (OrderedList attribs lst) = case attribs of
+ (1, DefaultStyle, DefaultDelim) -> do
+ contents <- mapM listItemToConTeXt lst
+ return $ "\\startltxenum\n" ++ concat contents ++ "\\stopltxenum\n"
+ _ -> do
+ let markers = take (length lst) $ orderedListMarkers attribs
+ contents <- zipWithM orderedListItemToConTeXt markers lst
+ let markerWidth = maximum $ map length markers
+ let markerWidth' = if markerWidth < 3
+ then ""
+ else "[width=" ++
+ show ((markerWidth + 2) `div` 2) ++ "em]"
+ return $ "\\startitemize" ++ markerWidth' ++ "\n" ++ concat contents ++
+ "\\stopitemize\n"
blockToConTeXt (DefinitionList lst) =
mapM defListItemToConTeXt lst >>= (return . (++ "\n") . concat)
blockToConTeXt HorizontalRule = return "\\thinrule\n\n"
@@ -163,6 +174,10 @@ listItemToConTeXt list = do
contents <- blockListToConTeXt list
return $ "\\item " ++ contents
+orderedListItemToConTeXt marker list = do
+ contents <- blockListToConTeXt list
+ return $ "\\sym{" ++ marker ++ "} " ++ contents
+
defListItemToConTeXt (term, def) = do
term' <- inlineListToConTeXt term
def' <- blockListToConTeXt def
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 4824f81da..ecd27ee0c 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -173,8 +173,21 @@ blockToDocbook opts (CodeBlock str) =
text "<screen>\n" <> text (escapeStringForXML str) <> text "\n</screen>"
blockToDocbook opts (BulletList lst) =
inTagsIndented "itemizedlist" $ listItemsToDocbook opts lst
-blockToDocbook opts (OrderedList lst) =
- inTagsIndented "orderedlist" $ listItemsToDocbook opts lst
+blockToDocbook opts (OrderedList _ []) = empty
+blockToDocbook opts (OrderedList (start, numstyle, numdelim) (first:rest)) =
+ let attribs = case numstyle of
+ DefaultStyle -> []
+ Decimal -> [("numeration", "arabic")]
+ UpperAlpha -> [("numeration", "upperalpha")]
+ LowerAlpha -> [("numeration", "loweralpha")]
+ UpperRoman -> [("numeration", "upperroman")]
+ LowerRoman -> [("numeration", "lowerroman")]
+ items = if start == 1
+ then listItemsToDocbook opts (first:rest)
+ else (inTags True "listitem" [("override",show start)]
+ (blocksToDocbook opts $ map plainToPara first)) $$
+ listItemsToDocbook opts rest
+ in inTags True "orderedlist" attribs items
blockToDocbook opts (DefinitionList lst) =
inTagsIndented "variablelist" $ deflistItemsToDocbook opts lst
blockToDocbook opts (RawHtml str) = text str -- raw XML block
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 3d46ba1c9..34c59f334 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -36,15 +36,21 @@ import Text.Regex ( mkRegex, matchRegex )
import Numeric ( showHex )
import Data.Char ( ord, toLower )
import Data.List ( isPrefixOf, partition, intersperse )
+import qualified Data.Set as S
import Control.Monad.State
-import Text.XHtml.Strict
+import Text.XHtml.Transitional
data WriterState = WriterState
- { stNotes :: [Html] -- ^ List of notes
- , stIds :: [String] -- ^ List of header identifiers
- , stHead :: [Html] -- ^ Html to include in header
+ { stNotes :: [Html] -- ^ List of notes
+ , stIds :: [String] -- ^ List of header identifiers
+ , stMath :: Bool -- ^ Math is used in document
+ , stCSS :: S.Set String -- ^ CSS to include in header
} deriving Show
+defaultWriterState :: WriterState
+defaultWriterState = WriterState {stNotes= [], stIds = [],
+ stMath = False, stCSS = S.empty}
+
-- | Convert Pandoc document to Html string.
writeHtmlString :: WriterOptions -> Pandoc -> String
writeHtmlString opts =
@@ -56,8 +62,7 @@ writeHtmlString opts =
writeHtml :: WriterOptions -> Pandoc -> Html
writeHtml opts (Pandoc (Meta tit authors date) blocks) =
let titlePrefix = writerTitlePrefix opts
- topTitle = evalState (inlineListToHtml opts tit)
- (WriterState {stNotes = [], stIds = [], stHead = []})
+ topTitle = evalState (inlineListToHtml opts tit) defaultWriterState
topTitle' = if null titlePrefix
then topTitle
else titlePrefix +++ " - " +++ topTitle
@@ -81,8 +86,19 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
else noHtml
(blocks', newstate) =
runState (blockListToHtml opts blocks)
- (WriterState {stNotes = [], stIds = ids, stHead = []})
- head = header $ metadata +++ toHtmlFromList (stHead newstate) +++
+ (defaultWriterState {stIds = ids})
+ cssLines = stCSS newstate
+ css = if S.null cssLines
+ then noHtml
+ else style ! [thetype "text/css"] $ primHtml $
+ '\n':(unlines $ S.toList cssLines)
+ math = if stMath newstate
+ then case writerASCIIMathMLURL opts of
+ Just path -> script ! [src path,
+ thetype "text/javascript"] $ noHtml
+ Nothing -> primHtml asciiMathMLScript
+ else noHtml
+ head = header $ metadata +++ math +++ css +++
primHtml (writerHeader opts)
notes = reverse (stNotes newstate)
before = primHtml $ writerIncludeBefore opts
@@ -100,7 +116,7 @@ tableOfContents opts headers ids =
let opts' = opts { writerIgnoreNotes = True }
contentsTree = hierarchicalize headers
contents = evalState (mapM (elementToListItem opts') contentsTree)
- (WriterState {stNotes= [], stIds = ids, stHead = []})
+ (defaultWriterState {stIds = ids})
in thediv ! [identifier "toc"] $ unordList contents
-- | Converts an Element to a list item for a table of contents,
@@ -177,12 +193,12 @@ isPunctuation c =
then True
else False
--- | Add Html to document header.
-addToHeader :: Html -> State WriterState ()
-addToHeader item = do
+-- | Add CSS for document header.
+addToCSS :: String -> State WriterState ()
+addToCSS item = do
st <- get
- let current = stHead st
- put $ st {stHead = (item:current)}
+ let current = stCSS st
+ put $ st {stCSS = (S.insert item current)}
-- | Convert Pandoc inline list to plain text identifier.
inlineListToIdentifier :: [Inline] -> String
@@ -241,8 +257,9 @@ blockToHtml opts block =
case blocks of
[BulletList lst] -> blockToHtml (opts {writerIncremental = inc})
(BulletList lst)
- [OrderedList lst] -> blockToHtml (opts {writerIncremental = inc})
- (OrderedList lst)
+ [OrderedList attribs lst] ->
+ blockToHtml (opts {writerIncremental = inc})
+ (OrderedList attribs lst)
otherwise -> blockListToHtml opts blocks >>=
(return . blockquote)
else blockListToHtml opts blocks >>= (return . blockquote)
@@ -272,10 +289,23 @@ blockToHtml opts block =
then [theclass "incremental"]
else []
return $ unordList ! attribs $ contents
- (OrderedList lst) -> do contents <- mapM (blockListToHtml opts) lst
- let attribs = if writerIncremental opts
+ (OrderedList (startnum, numstyle, _) lst) -> do
+ contents <- mapM (blockListToHtml opts) lst
+ let numstyle' = camelCaseToHyphenated $ show numstyle
+ let attribs = (if writerIncremental opts
then [theclass "incremental"]
- else []
+ else []) ++
+ (if startnum /= 1
+ then [start startnum]
+ else []) ++
+ (if numstyle /= DefaultStyle
+ then [theclass numstyle']
+ else [])
+ if numstyle /= DefaultStyle
+ then addToCSS $ "ol." ++ numstyle' ++
+ " { list-style-type: " ++
+ numstyle' ++ "; }"
+ else return ()
return $ ordList ! attribs $ contents
(DefinitionList lst) -> do contents <- mapM (\(term, def) ->
do term' <- inlineListToHtml opts term
@@ -342,8 +372,7 @@ inlineToHtml opts inline =
(Emph lst) -> inlineListToHtml opts lst >>= (return . emphasize)
(Strong lst) -> inlineListToHtml opts lst >>= (return . strong)
(Code str) -> return $ thecode << str
- (Strikeout lst) -> addToHeader (style ! [thetype "text/css"] $ (stringToHtml
- ".strikeout { text-decoration: line-through; }")) >>
+ (Strikeout lst) -> addToCSS ".strikeout { text-decoration: line-through; }" >>
inlineListToHtml opts lst >>=
(return . (thespan ! [theclass "strikeout"]))
(Superscript lst) -> inlineListToHtml opts lst >>= (return . sup)
@@ -357,12 +386,7 @@ inlineToHtml opts inline =
do contents <- inlineListToHtml opts lst
return $ leftQuote +++ contents +++ rightQuote
(TeX str) -> do if writerUseASCIIMathML opts
- then addToHeader $
- case writerASCIIMathMLURL opts of
- Just path -> script ! [src path,
- thetype "text/javascript"] $
- noHtml
- Nothing -> primHtml asciiMathMLScript
+ then modify (\st -> st {stMath = True})
else return ()
return $ stringToHtml str
(HtmlInline str) -> return $ primHtml str
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index d907e8b88..3d0c66e45 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -36,10 +36,12 @@ import Text.Printf ( printf )
import Data.List ( (\\), isInfixOf )
import qualified Data.Set as S
import Control.Monad.State
+import Data.Char ( toLower )
data WriterState =
WriterState { stIncludes :: S.Set String -- strings to include in header
- , stInNote :: Bool } -- @True@ if we're in a note
+ , stInNote :: Bool -- @True@ if we're in a note
+ , stOLLevel :: Int } -- level of ordered list nesting
-- | Add line to header.
addToHeader :: String -> State WriterState ()
@@ -52,7 +54,7 @@ addToHeader str = do
writeLaTeX :: WriterOptions -> Pandoc -> String
writeLaTeX options document =
evalState (pandocToLaTeX options document) $
- WriterState { stIncludes = S.empty, stInNote = False }
+ WriterState { stIncludes = S.empty, stInNote = False, stOLLevel = 1 }
pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String
pandocToLaTeX options (Pandoc meta blocks) = do
@@ -137,9 +139,23 @@ blockToLaTeX (RawHtml str) = return ""
blockToLaTeX (BulletList lst) = do
items <- mapM listItemToLaTeX lst
return $ "\\begin{itemize}\n" ++ concat items ++ "\\end{itemize}\n"
-blockToLaTeX (OrderedList lst) = do
+blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
+ st <- get
+ let oldlevel = stOLLevel st
+ put $ st {stOLLevel = oldlevel + 1}
items <- mapM listItemToLaTeX lst
- return $ "\\begin{enumerate}\n" ++ concat items ++ "\\end{enumerate}\n"
+ put $ st {stOLLevel = oldlevel}
+ exemplar <- if numstyle /= DefaultStyle || numdelim /= DefaultDelim
+ then do addToHeader "\\usepackage{enumerate}"
+ return $ "[" ++ head (orderedListMarkers (1, numstyle, numdelim)) ++ "]"
+ else return ""
+ let resetcounter = if start /= 1 && oldlevel <= 4
+ then "\\setcounter{enum" ++
+ map toLower (toRomanNumeral oldlevel) ++
+ "}{" ++ show (start - 1) ++ "}\n"
+ else ""
+ return $ "\\begin{enumerate}" ++ exemplar ++ "\n" ++
+ resetcounter ++ concat items ++ "\\end{enumerate}\n"
blockToLaTeX (DefinitionList lst) = do
items <- mapM defListItemToLaTeX lst
return $ "\\begin{description}\n" ++ concat items ++ "\\end{description}\n"
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 8c0f6e1b3..3232a454a 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -173,9 +173,11 @@ blockToMan opts (Table caption alignments widths headers rows) =
blockToMan opts (BulletList items) = do
contents <- mapM (bulletListItemToMan opts) items
return (vcat contents)
-blockToMan opts (OrderedList items) = do
- contents <- mapM (\(item, num) -> orderedListItemToMan opts item num) $
- zip [1..] items
+blockToMan opts (OrderedList attribs items) = do
+ let markers = take (length items) $ orderedListMarkers attribs
+ let indent = 1 + (maximum $ map length markers)
+ contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $
+ zip markers items
return (vcat contents)
blockToMan opts (DefinitionList items) = do
contents <- mapM (definitionListItemToMan opts) items
@@ -201,25 +203,22 @@ bulletListItemToMan opts (first:rest) = do
-- | Convert ordered list item (a list of blocks) to man.
orderedListItemToMan :: WriterOptions -- ^ options
- -> Int -- ^ ordinal number of list item
- -> [Block] -- ^ list item (list of blocks)
+ -> String -- ^ order marker for list item
+ -> Int -- ^ number of spaces to indent
+ -> [Block] -- ^ list item (list of blocks)
-> State WriterState Doc
-orderedListItemToMan _ _ [] = return empty
-orderedListItemToMan opts num ((Para first):rest) =
- orderedListItemToMan opts num ((Plain first):rest)
-orderedListItemToMan opts num ((Plain first):rest) = do
- first' <- blockToMan opts (Plain first)
+orderedListItemToMan _ _ _ [] = return empty
+orderedListItemToMan opts num indent ((Para first):rest) =
+ orderedListItemToMan opts num indent ((Plain first):rest)
+orderedListItemToMan opts num indent (first:rest) = do
+ first' <- blockToMan opts first
rest' <- blockListToMan opts rest
- let first'' = text (".IP " ++ show num ++ "." ++ " 4") $$ first'
+ let num' = printf ("%" ++ show (indent - 1) ++ "s") num
+ let first'' = text (".IP \"" ++ num' ++ "\" " ++ show indent) $$ first'
let rest'' = if null rest
then empty
else text ".RS 4" $$ rest' $$ text ".RE"
- return (first'' $$ rest'')
-orderedListItemToMan opts num (first:rest) = do
- first' <- blockToMan opts first
- rest' <- blockListToMan opts rest
- return $ text (".IP " ++ show num ++ "." ++ " 4") $$ first' $$
- rest' $$ text ".RE"
+ return $ first'' $$ rest''
-- | Convert definition list item (label, list of blocks) to man.
definitionListItemToMan :: WriterOptions
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index c6c3f3156..eb633166d 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -57,7 +57,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
after' = if null after then empty else text after
metaBlock <- metaToMarkdown opts meta
let head = if (writerStandalone opts)
- then metaBlock $$ text (writerHeader opts)
+ then metaBlock $+$ text (writerHeader opts)
else empty
let headerBlocks = filter isHeaderBlock blocks
let toc = if writerTableOfContents opts
@@ -68,8 +68,8 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
notes' <- notesToMarkdown opts (reverse notes)
(_, refs) <- get -- note that the notes may contain refs
refs' <- keyTableToMarkdown opts (reverse refs)
- return $ head $$ before' $$ toc $$ body $$ text "" $$
- notes' $$ text "" $$ refs' $$ after'
+ return $ head $+$ before' $+$ toc $+$ body $+$ text "" $+$
+ notes' $+$ text "" $+$ refs' $+$ after'
-- | Return markdown representation of reference key table.
keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc
@@ -116,7 +116,7 @@ metaToMarkdown opts (Meta title authors date) = do
title' <- titleToMarkdown opts title
authors' <- authorsToMarkdown authors
date' <- dateToMarkdown date
- return $ title' $$ authors' $$ date'
+ return $ title' $+$ authors' $+$ date'
titleToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
titleToMarkdown opts [] = return empty
@@ -173,7 +173,7 @@ blockToMarkdown opts (Table caption aligns widths headers rows) = do
caption' <- inlineListToMarkdown opts caption
let caption'' = if null caption
then empty
- else text "" $$ (text "Table: " <> caption')
+ else text "" $+$ (text "Table: " <> caption')
headers' <- mapM (blockListToMarkdown opts) headers
let widthsInChars = map (floor . (78 *)) widths
let alignHeader alignment = case alignment of
@@ -199,14 +199,19 @@ blockToMarkdown opts (Table caption aligns widths headers rows) = do
then text ""
else empty
let body = vcat $ intersperse spacer $ map blockToDoc rows'
- return $ (nest 2 $ border $$ (blockToDoc head) $$ underline $$ body $$
- border $$ caption'') $$ text ""
+ return $ (nest 2 $ border $+$ (blockToDoc head) $+$ underline $+$ body $+$
+ border $+$ caption'') <> text "\n"
blockToMarkdown opts (BulletList items) = do
contents <- mapM (bulletListItemToMarkdown opts) items
return $ (vcat contents) <> text "\n"
-blockToMarkdown opts (OrderedList items) = do
+blockToMarkdown opts (OrderedList attribs items) = do
+ let markers = orderedListMarkers attribs
+ let markers' = map (\m -> if length m < 3
+ then m ++ replicate (3 - length m) ' '
+ else m)
+ markers
contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
- zip [1..] items
+ zip markers' items
return $ (vcat contents) <> text "\n"
blockToMarkdown opts (DefinitionList items) = do
contents <- mapM (definitionListItemToMarkdown opts) items
@@ -220,14 +225,12 @@ bulletListItemToMarkdown opts items = do
-- | Convert ordered list item (a list of blocks) to markdown.
orderedListItemToMarkdown :: WriterOptions -- ^ options
- -> Int -- ^ ordinal number of list item
+ -> String -- ^ list item marker
-> [Block] -- ^ list item (list of blocks)
-> State WriterState Doc
-orderedListItemToMarkdown opts num items = do
+orderedListItemToMarkdown opts marker items = do
contents <- blockListToMarkdown opts items
- let spacer = if (num < 10) then " " else ""
- return $ hang (text ((show num) ++ "." ++ spacer)) (writerTabStop opts)
- contents
+ return $ hang (text marker) (writerTabStop opts) contents
-- | Convert definition list item (label, list of blocks) to markdown.
definitionListItemToMarkdown :: WriterOptions
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 5c486480c..c39f7bdab 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -57,7 +57,7 @@ pandocToRST opts (Pandoc meta blocks) = do
after' = if null after then empty else text after
metaBlock <- metaToRST opts meta
let head = if (writerStandalone opts)
- then metaBlock $$ text (writerHeader opts)
+ then metaBlock $+$ text (writerHeader opts)
else empty
body <- blockListToRST opts blocks
(notes, _, _) <- get
@@ -65,8 +65,8 @@ pandocToRST opts (Pandoc meta blocks) = do
(_, refs, pics) <- get -- note that the notes may contain refs
refs' <- keyTableToRST opts (reverse refs)
pics' <- pictTableToRST opts (reverse pics)
- return $ head <> (before' $$ body $$ notes' <> text "\n" $$ refs' $$
- pics' $$ after')
+ return $ head $+$ before' $+$ body $+$ notes' $+$ text "" $+$ refs' $+$
+ pics' $+$ after'
-- | Return RST representation of reference key table.
keyTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc
@@ -131,9 +131,9 @@ metaToRST opts (Meta title authors date) = do
authors' <- authorsToRST authors
date' <- dateToRST date
let toc = if writerTableOfContents opts
- then text "" $$ text ".. contents::"
+ then text "" $+$ text ".. contents::"
else empty
- return $ title' $$ authors' $$ date' $$ toc $$ text ""
+ return $ title' $+$ authors' $+$ date' $+$ toc
titleToRST :: WriterOptions -> [Inline] -> State WriterState Doc
titleToRST opts [] = return empty
@@ -141,13 +141,13 @@ titleToRST opts lst = do
contents <- inlineListToRST opts lst
let titleLength = length $ render contents
let border = text (replicate titleLength '=')
- return $ border <> char '\n' <> contents <> char '\n' <> border <> text "\n"
+ return $ border $+$ contents $+$ border <> text "\n"
authorsToRST :: [String] -> State WriterState Doc
authorsToRST [] = return empty
authorsToRST (first:rest) = do
rest' <- authorsToRST rest
- return $ (text ":Author: " <> text first) $$ rest'
+ return $ (text ":Author: " <> text first) $+$ rest'
dateToRST :: String -> State WriterState Doc
dateToRST [] = return empty
@@ -161,21 +161,23 @@ blockToRST opts Null = return empty
blockToRST opts (Plain inlines) = wrappedRST opts inlines
blockToRST opts (Para [TeX str]) =
let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
- return $ hang (text "\n.. raw:: latex\n") 3 (vcat $ map text (lines str'))
+ return $ hang (text "\n.. raw:: latex\n") 3
+ (vcat $ map text (lines str'))
blockToRST opts (Para inlines) = do
contents <- wrappedRST opts inlines
return $ contents <> text "\n"
blockToRST opts (RawHtml str) =
let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
- return $ hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str'))
+ return $ hang (text "\n.. raw:: html\n") 3
+ (vcat $ map text (lines str'))
blockToRST opts HorizontalRule = return $ text "--------------\n"
blockToRST opts (Header level inlines) = do
contents <- inlineListToRST opts inlines
let headerLength = length $ render contents
let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1)
let border = text $ replicate headerLength headerChar
- return $ contents <> char '\n' <> border <> char '\n'
-blockToRST opts (CodeBlock str) = return $ (text "::\n") $$ text "" $$
+ return $ contents $+$ border <> text "\n"
+blockToRST opts (CodeBlock str) = return $ (text "::\n") $+$
(nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n"
blockToRST opts (BlockQuote blocks) = do
contents <- blockListToRST opts blocks
@@ -184,7 +186,7 @@ blockToRST opts (Table caption aligns widths headers rows) = do
caption' <- inlineListToRST opts caption
let caption'' = if null caption
then empty
- else text "" $$ (text "Table: " <> caption')
+ else text "" $+$ (text "Table: " <> caption')
headers' <- mapM (blockListToRST opts) headers
let widthsInChars = map (floor . (78 *)) widths
let alignHeader alignment = case alignment of
@@ -210,15 +212,25 @@ blockToRST opts (Table caption aligns widths headers rows) = do
map (\l -> text $ replicate l ch) widthsInChars) <>
char ch <> char '+'
let body = vcat $ intersperse (border '-') $ map blockToDoc rows'
- return $ border '-' $$ blockToDoc head $$ border '=' $$ body $$
+ return $ border '-' $+$ blockToDoc head $+$ border '=' $+$ body $+$
border '-' $$ caption'' $$ text ""
blockToRST opts (BulletList items) = do
contents <- mapM (bulletListItemToRST opts) items
- return $ (vcat contents) <> text "\n"
-blockToRST opts (OrderedList items) = do
+ -- ensure that sublists have preceding blank line
+ return $ text "" $+$ vcat contents <> text "\n"
+blockToRST opts (OrderedList (start, style, delim) items) = do
+ let markers = if start == 1 && style == DefaultStyle && delim == DefaultDelim
+ then take (length items) $ repeat "#."
+ else take (length items) $ orderedListMarkers
+ (start, style, delim)
+ let maxMarkerLength = maximum $ map length markers
+ let markers' = map (\m -> let s = maxMarkerLength - length m
+ in m ++ replicate s ' ')
+ markers
contents <- mapM (\(item, num) -> orderedListItemToRST opts item num) $
- zip [1..] items
- return $ (vcat contents) <> text "\n"
+ zip markers' items
+ -- ensure that sublists have preceding blank line
+ return $ text "" $+$ vcat contents <> text "\n"
blockToRST opts (DefinitionList items) = do
contents <- mapM (definitionListItemToRST opts) items
return $ (vcat contents) <> text "\n"
@@ -231,14 +243,12 @@ bulletListItemToRST opts items = do
-- | Convert ordered list item (a list of blocks) to RST.
orderedListItemToRST :: WriterOptions -- ^ options
- -> Int -- ^ ordinal number of list item
- -> [Block] -- ^ list item (list of blocks)
+ -> String -- ^ marker for list item
+ -> [Block] -- ^ list item (list of blocks)
-> State WriterState Doc
-orderedListItemToRST opts num items = do
+orderedListItemToRST opts marker items = do
contents <- blockListToRST opts items
- let spacer = if (num < 10) then " " else ""
- return $ hang (text ((show num) ++ "." ++ spacer)) (writerTabStop opts)
- contents
+ return $ hang (text marker) (writerTabStop opts) contents
-- | Convert defintion list item (label, list of blocks) to RST.
definitionListItemToRST :: WriterOptions -> ([Inline], [Block]) -> State WriterState Doc
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index b1e401fed..9b3d6662c 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -132,11 +132,13 @@ bulletMarker indent = case (indent `mod` 720) of
otherwise -> "\\endash "
-- | Returns appropriate (list of) ordered list markers for indent level.
-orderedMarkers :: Int -> [String]
-orderedMarkers indent =
- case (indent `mod` 720) of
- 0 -> map (\x -> show x ++ ".") [1..]
- otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z']
+orderedMarkers :: Int -> ListAttributes -> [String]
+orderedMarkers indent (start, style, delim) =
+ if style == DefaultStyle && delim == DefaultDelim
+ then case (indent `mod` 720) of
+ 0 -> orderedListMarkers (start, Decimal, Period)
+ otherwise -> orderedListMarkers (start, LowerAlpha, Period)
+ else orderedListMarkers (start, style, delim)
-- | Returns RTF header.
rtfHeader :: String -- ^ header text
@@ -177,9 +179,9 @@ blockToRTF _ _ (RawHtml str) = ""
blockToRTF indent alignment (BulletList lst) =
spaceAtEnd $
concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst
-blockToRTF indent alignment (OrderedList lst) =
+blockToRTF indent alignment (OrderedList attribs lst) =
spaceAtEnd $ concat $
- zipWith (listItemToRTF alignment indent) (orderedMarkers indent) lst
+ zipWith (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst
blockToRTF indent alignment (DefinitionList lst) =
spaceAtEnd $
concatMap (definitionListItemToRTF alignment indent) lst
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 09:46:51 +0000