diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 6005187d5..79ebcf2ea 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -40,7 +40,7 @@ AsciiDoc: module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where import Prelude import Control.Monad.State.Strict -import Data.Char (isPunctuation, isSpace) +import Data.Char (isPunctuation, isSpace, toLower) import Data.List (intercalate, intersperse, stripPrefix) import Data.Maybe (fromMaybe, isJust, listToMaybe) import qualified Data.Set as Set @@ -258,17 +258,18 @@ blockToAsciiDoc opts (Table caption aligns widths headers rows) = do blockToAsciiDoc opts (BulletList items) = do contents <- mapM (bulletListItemToAsciiDoc opts) items return $ cat contents <> blankline -blockToAsciiDoc opts (OrderedList (_start, sty, _delim) items) = do - let sty' = case sty of - UpperRoman -> UpperAlpha - LowerRoman -> LowerAlpha - x -> x - let markers = orderedListMarkers (1, sty', Period) -- start num not used - let markers' = map (\m -> if length m < 3 - then m ++ replicate (3 - length m) ' ' - else m) markers - contents <- zipWithM (orderedListItemToAsciiDoc opts) markers' items - return $ cat contents <> blankline +blockToAsciiDoc opts (OrderedList (start, sty, _delim) items) = do + let listStyle = case sty of + DefaultStyle -> [] + Decimal -> ["arabic"] + Example -> [] + _ -> [map toLower (show sty)] + let listStart = if start == 1 then [] else ["start=" ++ show start] + let listoptions = case intercalate ", " (listStyle ++ listStart) of + [] -> empty + x -> brackets (text x) + contents <- mapM (orderedListItemToAsciiDoc opts) items + return $ listoptions $$ cat contents <> blankline blockToAsciiDoc opts (DefinitionList items) = do contents <- mapM (definitionListItemToAsciiDoc opts) items return $ cat contents <> blankline @@ -281,40 +282,34 @@ blockToAsciiDoc opts (Div (ident,_,_) bs) = do bulletListItemToAsciiDoc :: PandocMonad m => WriterOptions -> [Block] -> ADW m Doc bulletListItemToAsciiDoc opts blocks = do - let addBlock :: PandocMonad m => Doc -> Block -> ADW m Doc - addBlock d b | isEmpty d = chomp `fmap` blockToAsciiDoc opts b - addBlock d b@(BulletList _) = do x <- blockToAsciiDoc opts b - return $ d <> cr <> chomp x - addBlock d b@(OrderedList _ _) = do x <- blockToAsciiDoc opts b - return $ d <> cr <> chomp x - addBlock d b = do x <- blockToAsciiDoc opts b - return $ d <> cr <> text "+" <> cr <> chomp x lev <- gets bulletListLevel modify $ \s -> s{ bulletListLevel = lev + 1 } - contents <- foldM addBlock empty blocks + contents <- foldM (addBlock opts) empty blocks modify $ \s -> s{ bulletListLevel = lev } let marker = text (replicate lev '*') return $ marker <> text " " <> contents <> cr +addBlock :: PandocMonad m => WriterOptions -> Doc -> Block -> ADW m Doc +addBlock opts d b | isEmpty d = chomp `fmap` blockToAsciiDoc opts b +addBlock opts d b@(BulletList _) = do x <- blockToAsciiDoc opts b + return $ d <> cr <> chomp x +addBlock opts d b@(OrderedList _ _) = do x <- blockToAsciiDoc opts b + return $ d <> cr <> chomp x +addBlock opts d b = do x <- blockToAsciiDoc opts b + return $ d <> cr <> text "+" <> cr <> chomp x + -- | Convert ordered list item (a list of blocks) to asciidoc. orderedListItemToAsciiDoc :: PandocMonad m => WriterOptions -- ^ options - -> String -- ^ list item marker -> [Block] -- ^ list item (list of blocks) -> ADW m Doc -orderedListItemToAsciiDoc opts marker blocks = do - let addBlock d b | isEmpty d = chomp `fmap` blockToAsciiDoc opts b - addBlock d b@(BulletList _) = do x <- blockToAsciiDoc opts b - return $ d <> cr <> chomp x - addBlock d b@(OrderedList _ _) = do x <- blockToAsciiDoc opts b - return $ d <> cr <> chomp x - addBlock d b = do x <- blockToAsciiDoc opts b - return $ d <> cr <> text "+" <> cr <> chomp x +orderedListItemToAsciiDoc opts blocks = do lev <- gets orderedListLevel modify $ \s -> s{ orderedListLevel = lev + 1 } - contents <- foldM addBlock empty blocks + contents <- foldM (addBlock opts) empty blocks modify $ \s -> s{ orderedListLevel = lev } - return $ text marker <> text " " <> contents <> cr + let marker = text (replicate lev '.') + return $ marker <> text " " <> contents <> cr -- | Convert definition list item (label, list of blocks) to asciidoc. definitionListItemToAsciiDoc :: PandocMonad m diff --git a/test/writer.asciidoc b/test/writer.asciidoc index 8bae169f1..1348ca8f8 100644 --- a/test/writer.asciidoc +++ b/test/writer.asciidoc @@ -66,8 +66,9 @@ sub status { A list: -1. item one -2. item two +[arabic] +. item one +. item two Nested block quotes: @@ -156,35 +157,40 @@ Minuses loose: Tight: -1. First -2. Second -3. Third +[arabic] +. First +. Second +. Third and: -1. One -2. Two -3. Three +[arabic] +. One +. Two +. Three Loose using tabs: -1. First -2. Second -3. Third +[arabic] +. First +. Second +. Third and using spaces: -1. One -2. Two -3. Three +[arabic] +. One +. Two +. Three Multiple paragraphs: -1. Item 1, graf one. +[arabic] +. Item 1, graf one. + Item 1. graf two. The quick brown fox jumped over the lazy dog’s back. -2. Item 2. -3. Item 3. +. Item 2. +. Item 3. === Nested @@ -194,21 +200,23 @@ Item 1. graf two. The quick brown fox jumped over the lazy dog’s back. Here’s another: -1. First -2. Second: +[arabic] +. First +. Second: * Fee * Fie * Foe -3. Third +. Third Same thing but with paragraphs: -1. First -2. Second: +[arabic] +. First +. Second: * Fee * Fie * Foe -3. Third +. Third === Tabs and spaces @@ -219,27 +227,34 @@ Same thing but with paragraphs: === Fancy list markers -1. begins with 2 -2. and now 3 +[arabic, start=2] +. begins with 2 +. and now 3 + with a continuation -a. sublist with roman numerals, starting with 4 -b. more items -A. a subsublist -B. a subsublist +[lowerroman, start=4] +.. sublist with roman numerals, starting with 4 +.. more items +[upperalpha] +... a subsublist +... a subsublist Nesting: -A. Upper Alpha -A. Upper Roman. -1. Decimal start with 6 -a. Lower alpha with paren +[upperalpha] +. Upper Alpha +[upperroman] +.. Upper Roman. +[arabic, start=6] +... Decimal start with 6 +[loweralpha, start=3] +.... Lower alpha with paren Autonumbering: -1. Autonumber. -2. More. -1. Nested. +. Autonumber. +. More. +.. Nested. Should not be a list item: @@ -326,8 +341,9 @@ apple:: orange:: orange fruit + - 1. sublist - 2. sublist + [arabic] + . sublist + . sublist == HTML Blocks @@ -622,6 +638,7 @@ ___________________________________________ Notes can go in quotes.footnote:[In quote.] ___________________________________________ -1. And in list items.footnote:[In list.] +[arabic] +. And in list items.footnote:[In list.] This paragraph should not be part of the note, as it is not indented.