diff options
author | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2007-08-08 02:43:15 +0000 |
---|---|---|
committer | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2007-08-08 02:43:15 +0000 |
commit | e814a3f6d23f640b1aed5b7cb949459d514a3e33 (patch) | |
tree | 4c9f89c85d5e050f27b4a732c7bad0542b5c9928 /src/Text | |
parent | 22a65385571737b6232debac884184d6504222fc (diff) | |
download | pandoc-e814a3f6d23f640b1aed5b7cb949459d514a3e33.tar.gz |
Major change in the way ordered lists are handled:
+ The changes are documented in README, under Lists.
+ The OrderedList block element now stores information
about list number style, list number delimiter, and
starting number.
+ The readers parse this information, when possible.
+ The writers use this information to style ordered
lists.
+ Test suites have been changed accordingly.
Motivation: It's often useful to start lists with
numbers other than 1, and to have control over the
style of the list.
Added to Text.Pandoc.Shared:
+ camelCaseToHyphenated
+ toRomanNumeral
+ anyOrderedListMarker
+ orderedListMarker
+ orderedListMarkers
Added to Text.Pandoc.ParserCombinators:
+ charsInBalanced'
+ withHorizDisplacement
+ romanNumeral
RST writer:
+ Force blank line before lists, so that sublists will be handled
correctly.
LaTeX reader:
+ Fixed bug in parsing of footnotes containing multiple paragraphs,
introduced by use of charsInBalanced. Fix: use charsInBalanced'
instead.
LaTeX header:
+ use mathletters option in ucs package, so that basic unicode Greek
letters will work properly.
git-svn-id: https://pandoc.googlecode.com/svn/trunk@834 788f1e2b-df1e-0410-8736-df70ead52e1b
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Definition.hs | 21 | ||||
-rw-r--r-- | src/Text/Pandoc/ParserCombinators.hs | 62 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/HTML.hs | 19 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/LaTeX.hs | 30 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 41 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 55 | ||||
-rw-r--r-- | src/Text/Pandoc/Shared.hs | 166 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 21 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Docbook.hs | 17 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 78 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 24 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Man.hs | 33 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 31 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 56 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 16 |
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 |