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 | 
