aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <fiddlosopher@gmail.com>2012-01-20 13:00:28 -0800
committerJohn MacFarlane <fiddlosopher@gmail.com>2012-01-20 13:00:28 -0800
commit1a8594f90763978074801fb763f7f0b57ab874b4 (patch)
treeec6bac2f73ed55783c209df0414552a08dfb1e3f
parentdafd2e555f3e954dfb6e1395bce498221134ccd2 (diff)
downloadpandoc-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.
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs61
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 []