diff options
author | John MacFarlane <fiddlosopher@gmail.com> | 2012-01-20 13:00:28 -0800 |
---|---|---|
committer | John MacFarlane <fiddlosopher@gmail.com> | 2012-01-20 13:00:28 -0800 |
commit | 1a8594f90763978074801fb763f7f0b57ab874b4 (patch) | |
tree | ec6bac2f73ed55783c209df0414552a08dfb1e3f /src/Text | |
parent | dafd2e555f3e954dfb6e1395bce498221134ccd2 (diff) | |
download | pandoc-1a8594f90763978074801fb763f7f0b57ab874b4.tar.gz |
Docx writer: Fixed bug with numbered lists.
Numbered lists were being numbered continuously, instead
of having new lists start again with 1.
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 61 |
1 files changed, 37 insertions, 24 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 1ea881623..000f15f22 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to docx. -} module Text.Pandoc.Writers.Docx ( writeDocx ) where -import Data.List ( intercalate, elemIndex ) +import Data.List ( intercalate ) import System.FilePath ( (</>) ) import qualified Data.ByteString.Lazy as B import qualified Data.Map as M @@ -60,7 +60,8 @@ data WriterState = WriterState{ , stImages :: M.Map FilePath (String, B.ByteString) , stListLevel :: Int , stListMarker :: ListMarker - , stMarkersUsed :: [ListMarker] + , stNumStyles :: M.Map ListMarker Int + , stLists :: [ListMarker] } data ListMarker = NoMarker @@ -78,7 +79,8 @@ defaultWriterState = WriterState{ , stImages = M.empty , stListLevel = 0 -- not in a list , stListMarker = NoMarker - , stMarkersUsed = [NoMarker] + , stNumStyles = M.fromList [(NoMarker, 0)] + , stLists = [NoMarker] } type WS a = StateT WriterState IO a @@ -148,9 +150,9 @@ writeDocx mbRefDocx opts doc@(Pandoc (Meta tit auths _) _) = do let styledoc' = styledoc{ elContent = elContent styledoc ++ map Elem newstyles } let styleEntry = toEntry stylepath epochtime $ fromString $ showTopElement' styledoc' -- construct word/numbering.xml - let markersUsed = stMarkersUsed st let numpath = "word/numbering.xml" - let numEntry = toEntry numpath epochtime $ fromString $ showTopElement' $ mkNumbering markersUsed + let numEntry = toEntry numpath epochtime $ fromString $ showTopElement' + $ mkNumbering (stNumStyles st) (stLists st) let docPropsPath = "docProps/core.xml" let docProps = mknode "cp:coreProperties" [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties") @@ -202,20 +204,26 @@ styleToOpenXml style = parStyle : map toStyle alltoktypes $ backgroundColor style ) ] -mkNumbering :: [ListMarker] -> Element -mkNumbering markers = +mkNumbering :: M.Map ListMarker Int -> [ListMarker] -> Element +mkNumbering markers lists = mknode "w:numbering" [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")] - $ zipWith mkAbstractNum nums markers - ++ map mkNum nums - where nums = [1..(length markers)] + $ map mkAbstractNum (M.toList markers) + ++ zipWith (mkNum markers) lists [1..(length lists)] -mkNum :: Int -> Element -mkNum numid = +mkNum :: M.Map ListMarker Int -> ListMarker -> Int -> Element +mkNum markers marker numid = mknode "w:num" [("w:numId",show numid)] - $ mknode "w:abstractNumId" [("w:val",show numid)] () - -mkAbstractNum :: Int -> ListMarker -> Element -mkAbstractNum numid marker = + $ mknode "w:abstractNumId" [("w:val",show absnumid)] () + : case marker of + NoMarker -> [] + BulletMarker -> [] + NumberMarker _ _ start -> + map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))] + $ mknode "w:startOverride" [("w:val",show start)] ()) [0..6] + where absnumid = maybe 0 id $ M.lookup marker markers + +mkAbstractNum :: (ListMarker,Int) -> Element +mkAbstractNum (marker,numid) = mknode "w:abstractNum" [("w:abstractNumId",show numid)] $ mknode "w:multiLevelType" [("w:val","multilevel")] () : map (mkLvl marker) [0..6] @@ -380,9 +388,11 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do ] ++ caption' blockToOpenXML opts (BulletList lst) = do let marker = BulletMarker + addList marker asList $ concat `fmap` mapM (listItemToOpenXML opts marker) lst blockToOpenXML opts (OrderedList (start, numstyle, numdelim) lst) = do let marker = NumberMarker numstyle numdelim start + addList marker asList $ concat `fmap` mapM (listItemToOpenXML opts marker) lst blockToOpenXML opts (DefinitionList items) = concat `fmap` mapM (definitionListItemToOpenXML opts) items @@ -396,14 +406,17 @@ definitionListItemToOpenXML opts (term,defs) = do return $ term' ++ defs' getNumId :: WS Int -getNumId = do - marker <- gets stListMarker - markersUsed <- gets stMarkersUsed - case elemIndex marker markersUsed of - Just x -> return $ x + 1 - Nothing -> do - modify $ \st -> st{ stMarkersUsed = markersUsed ++ [marker] } - return $ length markersUsed + 1 +getNumId = length `fmap` gets stLists + +addList :: ListMarker -> WS () +addList marker = do + lists <- gets stLists + modify $ \st -> st{ stLists = lists ++ [marker] } + numStyles <- gets stNumStyles + case M.lookup marker numStyles of + Just _ -> return () + Nothing -> modify $ \st -> + st{ stNumStyles = M.insert marker (M.size numStyles + 1) numStyles } listItemToOpenXML :: WriterOptions -> ListMarker -> [Block] -> WS [Element] listItemToOpenXML _ _ [] = return [] |