From 5b99112f229db1fcbe82943678f9f55c1ead8f11 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 6 Nov 2013 19:18:24 -0800 Subject: Docx writer: Fix URL for core-properties in `_rels/.rels`. Partially addresses #1046. --- src/Text/Pandoc/Writers/Docx.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 0fdea0a7a..f1276c831 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -247,7 +247,7 @@ writeDocx opts doc@(Pandoc meta _) = do ,("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties") ,("Target","docProps/app.xml")] , [("Id","rId3") - ,("Type","http://schemas.openxmlformats.org/officedocument/2006/relationships/metadata/core-properties") + ,("Type","http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties") ,("Target","docProps/core.xml")] ] let relsEntry = toEntry relsPath epochtime $ renderXml rels -- cgit v1.2.3 From 2efd0951d3d560a159f92df4730e2cee26978698 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 7 Nov 2013 08:46:52 -0800 Subject: Docx writer: fixed core metadata. - Don't create empty date nodes if no date given. - Don't create multiple dc:creator nodes; instead separate by semicolons. Closes #1046. --- src/Text/Pandoc/Writers/Docx.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index f1276c831..5d1647844 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -231,10 +231,11 @@ writeDocx opts doc@(Pandoc meta _) = do ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/") ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")] $ mknode "dc:title" [] (stringify $ docTitle meta) - : mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] - (maybe "" id $ normalizeDate $ stringify $ docDate meta) - : mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] () -- put current time here - : map (mknode "dc:creator" [] . stringify) (docAuthors meta) + : mknode "dc:creator" [] (intercalate "; " (map stringify $ docAuthors meta)) + : maybe [] + (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] $ x + , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] $ x + ]) (normalizeDate $ stringify $ docDate meta) let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps let relsPath = "_rels/.rels" -- cgit v1.2.3 From 3d453f096cfa12e231c5a4d4c8e468378e20e5e8 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 19 Nov 2013 13:16:31 -0800 Subject: Docx writer: Use mime type info returned by fetchItem. --- src/Text/Pandoc/Writers/Docx.hs | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 5d1647844..b9c198a78 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -55,8 +55,8 @@ import Data.Unique (hashUnique, newUnique) import System.Random (randomRIO) import Text.Printf (printf) import qualified Control.Exception as E -import System.FilePath (takeExtension) -import Text.Pandoc.MIME (getMimeType) +import Text.Pandoc.MIME (getMimeType, extensionFromMimeType) +import Control.Applicative ((<|>)) data WriterState = WriterState{ stTextProperties :: [Element] @@ -737,7 +737,7 @@ inlineToOpenXML opts (Image alt (src, tit)) = do liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..." -- emit alt text inlinesToOpenXML opts alt - Right (img, _) -> do + Right (img, mt) -> do ident <- ("rId"++) `fmap` getUniqueId let size = imageSize img let (xpt,ypt) = maybe (120,120) sizeInPoints size @@ -776,19 +776,21 @@ inlineToOpenXML opts (Image alt (src, tit)) = do , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] () , mknode "wp:docPr" [("descr",tit),("id","1"),("name","Picture")] () , graphic ] - let imgext = case imageType img of - Just Png -> ".png" - Just Jpeg -> ".jpeg" - Just Gif -> ".gif" - Just Pdf -> ".pdf" - Just Eps -> ".eps" - Nothing -> takeExtension src + let imgext = case mt >>= extensionFromMimeType of + Just x -> '.':x + Nothing -> case imageType img of + Just Png -> ".png" + Just Jpeg -> ".jpeg" + Just Gif -> ".gif" + Just Pdf -> ".pdf" + Just Eps -> ".eps" + Nothing -> "" if null imgext then -- without an extension there is no rule for content type inlinesToOpenXML opts alt -- return alt to avoid corrupted docx else do let imgpath = "media/" ++ ident ++ imgext - let mbMimeType = getMimeType imgpath + let mbMimeType = mt <|> getMimeType imgpath -- insert mime type to use in constructing [Content_Types].xml modify $ \st -> st{ stImages = M.insert src (ident, imgpath, mbMimeType, imgElt, img) -- cgit v1.2.3 From e1a9a61774cce807c6db2fff7b8609b2d9dbc678 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 23 Nov 2013 14:52:14 -0800 Subject: Docx writer: Implemented csl flipflopping spans. --- src/Text/Pandoc/Writers/Docx.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index b9c198a78..5c7341b69 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -638,7 +638,12 @@ formattedString str = do inlineToOpenXML :: WriterOptions -> Inline -> WS [Element] inlineToOpenXML _ (Str str) = formattedString str inlineToOpenXML opts Space = inlineToOpenXML opts (Str " ") -inlineToOpenXML opts (Span _ ils) = inlinesToOpenXML opts ils +inlineToOpenXML opts (Span (_,classes,_) ils) = do + let off x = withTextProp (mknode x [("w:val","0")] ()) + ((if "csl-no-emph" `elem` classes then off "w:i" else id) . + (if "csl-no-strong" `elem` classes then off "w:b" else id) . + (if "csl-no-smallcaps" `elem` classes then off "w:smallCaps" else id)) + $ inlinesToOpenXML opts ils inlineToOpenXML opts (Strong lst) = withTextProp (mknode "w:b" [] ()) $ inlinesToOpenXML opts lst inlineToOpenXML opts (Emph lst) = -- cgit v1.2.3 From 3d70059a4896c66cab59832a3ed9eb8334b84a2f Mon Sep 17 00:00:00 2001 From: Henry de Valence Date: Thu, 19 Dec 2013 21:07:09 -0500 Subject: HLint: use fromMaybe Replace uses of `maybe x id` with `fromMaybe x`. --- src/Text/Pandoc/PDF.hs | 3 ++- src/Text/Pandoc/Readers/DocBook.hs | 7 ++++--- src/Text/Pandoc/Readers/HTML.hs | 4 ++-- src/Text/Pandoc/Readers/Markdown.hs | 4 ++-- src/Text/Pandoc/Readers/MediaWiki.hs | 7 ++++--- src/Text/Pandoc/Writers/Docx.hs | 6 ++++-- src/Text/Pandoc/Writers/EPUB.hs | 12 ++++++------ src/Text/Pandoc/Writers/HTML.hs | 4 ++-- src/Text/Pandoc/Writers/LaTeX.hs | 3 ++- src/Text/Pandoc/Writers/ODT.hs | 3 ++- 10 files changed, 30 insertions(+), 23 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index e8683b98f..360338f8f 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -41,6 +41,7 @@ import System.Directory import System.Environment import Control.Monad (unless) import Data.List (isInfixOf) +import Data.Maybe (fromMaybe) import qualified Data.ByteString.Base64 as B64 import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Definition @@ -87,7 +88,7 @@ handleImage' baseURL tmpdir (Image ils (src,tit)) = do res <- fetchItem baseURL src case res of Right (contents, Just mime) -> do - let ext = maybe (takeExtension src) id $ + let ext = fromMaybe (takeExtension src) $ extensionFromMimeType mime let basename = UTF8.toString $ B64.encode $ UTF8.fromString src let fname = tmpdir basename <.> ext diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 03c6140ac..56cb16b20 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -12,6 +12,7 @@ import Data.Char (isSpace) import Control.Monad.State import Control.Applicative ((<$>)) import Data.List (intersperse) +import Data.Maybe (fromMaybe) {- @@ -683,7 +684,7 @@ parseBlock (Elem e) = "lowerroman" -> LowerRoman "upperroman" -> UpperRoman _ -> Decimal - let start = maybe 1 id $ + let start = fromMaybe 1 $ (attrValue "override" <$> filterElement (named "listitem") e) >>= safeRead orderedListWith (start,listStyle,DefaultDelim) @@ -779,7 +780,7 @@ parseBlock (Elem e) = caption <- case filterChild isCaption e of Just t -> getInlines t Nothing -> return mempty - let e' = maybe e id $ filterChild (named "tgroup") e + let e' = fromMaybe e $ filterChild (named "tgroup") e let isColspec x = named "colspec" x || named "col" x let colspecs = case filterChild (named "colgroup") e' of Just c -> filterChildren isColspec c @@ -801,7 +802,7 @@ parseBlock (Elem e) = Just "center" -> AlignCenter _ -> AlignDefault let toWidth c = case findAttr (unqual "colwidth") c of - Just w -> maybe 0 id + Just w -> fromMaybe 0 $ safeRead $ '0': filter (\x -> (x >= '0' && x <= '9') || x == '.') w diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index e758f712f..4b44a3a21 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -207,7 +207,7 @@ pHeader = try $ do let bodyTitle = TagOpen tagtype attr ~== TagOpen "h1" [("class","title")] let level = read (drop 1 tagtype) contents <- liftM concat $ manyTill inline (pCloses tagtype <|> eof) - let ident = maybe "" id $ lookup "id" attr + let ident = fromMaybe "" $ lookup "id" attr let classes = maybe [] words $ lookup "class" attr let keyvals = [(k,v) | (k,v) <- attr, k /= "class", k /= "id"] return $ if bodyTitle @@ -257,7 +257,7 @@ pCol = try $ do skipMany pBlank return $ case lookup "width" attribs of Just x | not (null x) && last x == '%' -> - maybe 0.0 id $ safeRead ('0':'.':init x) + fromMaybe 0.0 $ safeRead ('0':'.':init x) _ -> 0.0 pColgroup :: TagParser [Double] diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 166c524ef..3a5d29b4e 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1722,7 +1722,7 @@ spanHtml = try $ do guardEnabled Ext_markdown_in_html_blocks (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "span" []) contents <- mconcat <$> manyTill inline (htmlTag (~== TagClose "span")) - let ident = maybe "" id $ lookup "id" attrs + let ident = fromMaybe "" $ lookup "id" attrs let classes = maybe [] words $ lookup "class" attrs let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"] return $ B.spanWith (ident, classes, keyvals) <$> contents @@ -1732,7 +1732,7 @@ divHtml = try $ do guardEnabled Ext_markdown_in_html_blocks (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "div" []) contents <- mconcat <$> manyTill block (htmlTag (~== TagClose "div")) - let ident = maybe "" id $ lookup "id" attrs + let ident = fromMaybe "" $ lookup "id" attrs let classes = maybe [] words $ lookup "class" attrs let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"] return $ B.divWith (ident, classes, keyvals) <$> contents diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index 1c074e3de..8d8ea0199 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -54,6 +54,7 @@ import Data.Sequence (viewl, ViewL(..), (<|)) import qualified Data.Foldable as F import qualified Data.Map as M import Data.Char (isDigit, isSpace) +import Data.Maybe (fromMaybe) -- | Read mediawiki from an input string and return a Pandoc document. readMediaWiki :: ReaderOptions -- ^ Reader options @@ -204,7 +205,7 @@ table = do tableStart styles <- option [] parseAttrs <* blankline let tableWidth = case lookup "width" styles of - Just w -> maybe 1.0 id $ parseWidth w + Just w -> fromMaybe 1.0 $ parseWidth w Nothing -> 1.0 caption <- option mempty tableCaption optional rowsep @@ -285,7 +286,7 @@ tableCell = try $ do Just "center" -> AlignCenter _ -> AlignDefault let width = case lookup "width" attrs of - Just xs -> maybe 0.0 id $ parseWidth xs + Just xs -> fromMaybe 0.0 $ parseWidth xs Nothing -> 0.0 return ((align, width), bs) @@ -387,7 +388,7 @@ orderedList = spaces items <- many (listItem '#' <|> li) optional (htmlTag (~== TagClose "ol")) - let start = maybe 1 id $ safeRead $ fromAttrib "start" tag + let start = fromMaybe 1 $ safeRead $ fromAttrib "start" tag return $ B.orderedListWith (start, DefaultStyle, DefaultDelim) items definitionList :: MWParser Blocks diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 5c7341b69..32ba7715a 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -29,6 +29,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.Maybe (fromMaybe) import Data.List ( intercalate, groupBy ) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -130,7 +131,8 @@ writeDocx opts doc@(Pandoc meta _) = do let mkOverrideNode (part', contentType') = mknode "Override" [("PartName",part'),("ContentType",contentType')] () let mkImageOverride (_, imgpath, mbMimeType, _, _) = - mkOverrideNode ("/word/" ++ imgpath, maybe "application/octet-stream" id mbMimeType) + mkOverrideNode ("/word/" ++ imgpath, + fromMaybe "application/octet-stream" mbMimeType) let overrides = map mkOverrideNode [("/word/webSettings.xml", "application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml") @@ -322,7 +324,7 @@ mkNum markers marker numid = 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 + where absnumid = fromMaybe 0 $ M.lookup marker markers mkAbstractNum :: (ListMarker,Int) -> IO Element mkAbstractNum (marker,numid) = do diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 36ead0b8f..4daa9609e 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -176,8 +176,8 @@ addMetadataFromXML e@(Element (QName name _ (Just "dc")) attrs _ _) md , titleFileAs = getAttr "file-as" , titleType = getAttr "type" } : epubTitle md } - | name == "date" = md{ epubDate = maybe "" id $ normalizeDate' - $ strContent e } + | name == "date" = md{ epubDate = fromMaybe "" $ normalizeDate' + $ strContent e } | name == "language" = md{ epubLanguage = strContent e } | name == "creator" = md{ epubCreator = Creator{ creatorText = strContent e @@ -271,7 +271,7 @@ metadataFromMeta opts meta = EPUBMetadata{ } where identifiers = getIdentifier meta titles = getTitle meta - date = maybe "" id $ + date = fromMaybe "" $ (metaValueToString <$> lookupMeta "date" meta) >>= normalizeDate' language = maybe "" metaValueToString $ lookupMeta "language" meta `mplus` lookupMeta "lang" meta @@ -297,7 +297,7 @@ writeEPUB :: WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert -> IO B.ByteString writeEPUB opts doc@(Pandoc meta _) = do - let version = maybe EPUB2 id (writerEpubVersion opts) + let version = fromMaybe EPUB2 (writerEpubVersion opts) let epub3 = version == EPUB3 epochtime <- floor `fmap` getPOSIXTime let mkEntry path content = toEntry path epochtime content @@ -401,7 +401,7 @@ writeEPUB opts doc@(Pandoc meta _) = do chapToEntry num (Chapter mbnum bs) = mkEntry (showChapter num) $ renderHtml $ writeHtml opts'{ writerNumberOffset = - maybe [] id mbnum } + fromMaybe [] mbnum } $ case bs of (Header _ _ xs : _) -> Pandoc (setMeta "title" (fromList xs) nullMeta) bs @@ -436,7 +436,7 @@ writeEPUB opts doc@(Pandoc meta _) = do let fontNode ent = unode "item" ! [("id", takeBaseName $ eRelativePath ent), ("href", eRelativePath ent), - ("media-type", maybe "" id $ getMimeType $ eRelativePath ent)] $ () + ("media-type", fromMaybe "" $ getMimeType $ eRelativePath ent)] $ () let plainTitle = case docTitle meta of [] -> case epubTitle metadata of [] -> "UNTITLED" diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 2c6435457..129776363 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -45,7 +45,7 @@ import Numeric ( showHex ) import Data.Char ( ord, toLower ) import Data.List ( isPrefixOf, intersperse ) import Data.String ( fromString ) -import Data.Maybe ( catMaybes ) +import Data.Maybe ( catMaybes, fromMaybe ) import Control.Monad.State import Text.Blaze.Html hiding(contents) import Text.Blaze.Internal(preEscapedString) @@ -118,7 +118,7 @@ pandocToHtml opts (Pandoc meta blocks) = do let stringifyHTML = escapeStringForXML . stringify let authsMeta = map stringifyHTML $ docAuthors meta let dateMeta = stringifyHTML $ docDate meta - let slideLevel = maybe (getSlideLevel blocks) id $ writerSlideLevel opts + let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts let sects = hierarchicalize $ if writerSlideVariant opts == NoSlides then blocks diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 1deacecb4..a76d6d82b 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -40,6 +40,7 @@ import Network.URI ( isURI, unEscapeString ) import Data.List ( (\\), isSuffixOf, isInfixOf, isPrefixOf, intercalate, intersperse ) import Data.Char ( toLower, isPunctuation, isAscii, isLetter, isDigit, ord ) +import Data.Maybe ( fromMaybe ) import Control.Applicative ((<|>)) import Control.Monad.State import Text.Pandoc.Pretty @@ -240,7 +241,7 @@ inCmd cmd contents = char '\\' <> text cmd <> braces contents toSlides :: [Block] -> State WriterState [Block] toSlides bs = do opts <- gets stOptions - let slideLevel = maybe (getSlideLevel bs) id $ writerSlideLevel opts + let slideLevel = fromMaybe (getSlideLevel bs) $ writerSlideLevel opts let bs' = prepSlides slideLevel bs concat `fmap` (mapM (elementToBeamer slideLevel) $ hierarchicalize bs') diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index cc0a06243..25cd5ae13 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -31,6 +31,7 @@ Conversion of 'Pandoc' documents to ODT. module Text.Pandoc.Writers.ODT ( writeODT ) where import Data.IORef import Data.List ( isPrefixOf ) +import Data.Maybe ( fromMaybe ) import qualified Data.ByteString.Lazy as B import Text.Pandoc.UTF8 ( fromStringLazy ) import Codec.Archive.Zip @@ -127,7 +128,7 @@ transformPic opts entriesRef (Image lab (src,_)) = do return $ Emph lab Right (img, _) -> do let size = imageSize img - let (w,h) = maybe (0,0) id $ sizeInPoints `fmap` size + let (w,h) = fromMaybe (0,0) $ sizeInPoints `fmap` size let tit' = show w ++ "x" ++ show h entries <- readIORef entriesRef let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src -- cgit v1.2.3 From d6ec6cf9cf5731977fa0f476cabef4786edd5665 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 1 Jan 2014 09:01:05 -0800 Subject: Docx writer: Fixed problem with some modified reference docx files. Include `word/_rels/settings.xml.rels` if it exists, as well as other `rels` files besides the ones pandoc generates explicitly. --- src/Text/Pandoc/Writers/Docx.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 32ba7715a..67d202010 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -30,7 +30,7 @@ Conversion of 'Pandoc' documents to docx. -} module Text.Pandoc.Writers.Docx ( writeDocx ) where import Data.Maybe (fromMaybe) -import Data.List ( intercalate, groupBy ) +import Data.List ( intercalate, groupBy, isPrefixOf ) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 @@ -262,6 +262,11 @@ writeDocx opts doc@(Pandoc meta _) = do fontTableEntry <- entryFromArchive "word/fontTable.xml" settingsEntry <- entryFromArchive "word/settings.xml" webSettingsEntry <- entryFromArchive "word/webSettings.xml" + let miscRels = [ f | f <- filesInArchive refArchive + , "word/_rels/" `isPrefixOf` f + , f /= "word/_rels/document.xml.rels" + , f /= "word/_rels/footnotes.xml.rels" ] + miscRelEntries <- mapM entryFromArchive miscRels -- Create archive let archive = foldr addEntryToArchive emptyArchive $ @@ -269,7 +274,7 @@ writeDocx opts doc@(Pandoc meta _) = do footnoteRelEntry : numEntry : styleEntry : footnotesEntry : docPropsEntry : docPropsAppEntry : themeEntry : fontTableEntry : settingsEntry : webSettingsEntry : - imageEntries + imageEntries ++ miscRelEntries return $ fromArchive archive styleToOpenXml :: Style -> [Element] -- cgit v1.2.3 From e3d48da6271a37129ae5bdb6cb57f006de8c5bfc Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 2 Jan 2014 15:22:50 -0800 Subject: Moved fixDisplayMath from Docx writer to Writer.Shared. --- src/Text/Pandoc/Writers/Docx.hs | 27 ++------------------------- src/Text/Pandoc/Writers/Shared.hs | 27 +++++++++++++++++++++++++++ 2 files changed, 29 insertions(+), 25 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 67d202010..25739f7c8 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -30,7 +30,7 @@ Conversion of 'Pandoc' documents to docx. -} module Text.Pandoc.Writers.Docx ( writeDocx ) where import Data.Maybe (fromMaybe) -import Data.List ( intercalate, groupBy, isPrefixOf ) +import Data.List ( intercalate, isPrefixOf ) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 @@ -43,6 +43,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Generic import Text.Pandoc.ImageSize import Text.Pandoc.Shared hiding (Element) +import Text.Pandoc.Writers.Shared (fixDisplayMath) import Text.Pandoc.Options import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Highlighting ( highlight ) @@ -817,27 +818,3 @@ parseXml refArchive relpath = case (findEntryByPath relpath refArchive >>= parseXMLDoc . UTF8.toStringLazy . fromEntry) of Just d -> return d Nothing -> fail $ relpath ++ " missing in reference docx" - -isDisplayMath :: Inline -> Bool -isDisplayMath (Math DisplayMath _) = True -isDisplayMath _ = False - -stripLeadingTrailingSpace :: [Inline] -> [Inline] -stripLeadingTrailingSpace = go . reverse . go . reverse - where go (Space:xs) = xs - go xs = xs - -fixDisplayMath :: Block -> Block -fixDisplayMath (Plain lst) - | any isDisplayMath lst && not (all isDisplayMath lst) = - -- chop into several paragraphs so each displaymath is its own - Div ("",["math"],[]) $ map (Plain . stripLeadingTrailingSpace) $ - groupBy (\x y -> (isDisplayMath x && isDisplayMath y) || - not (isDisplayMath x || isDisplayMath y)) lst -fixDisplayMath (Para lst) - | any isDisplayMath lst && not (all isDisplayMath lst) = - -- chop into several paragraphs so each displaymath is its own - Div ("",["math"],[]) $ map (Para . stripLeadingTrailingSpace) $ - groupBy (\x y -> (isDisplayMath x && isDisplayMath y) || - not (isDisplayMath x || isDisplayMath y)) lst -fixDisplayMath x = x diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 33091ea94..604aac1c9 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -34,6 +34,7 @@ module Text.Pandoc.Writers.Shared ( , setField , defField , tagWithAttrs + , fixDisplayMath ) where import Text.Pandoc.Definition @@ -46,6 +47,7 @@ import qualified Data.Map as M import qualified Data.Text as T import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(..)) import qualified Data.Traversable as Traversable +import Data.List ( groupBy ) -- | Create JSON value for template from a 'Meta' and an association list -- of variables, specified at the command line or in the writer. @@ -136,3 +138,28 @@ tagWithAttrs tag (ident,classes,kvs) = hsep ,hsep (map (\(k,v) -> text k <> "=" <> doubleQuotes (text (escapeStringForXML v))) kvs) ] <> ">" + +isDisplayMath :: Inline -> Bool +isDisplayMath (Math DisplayMath _) = True +isDisplayMath _ = False + +stripLeadingTrailingSpace :: [Inline] -> [Inline] +stripLeadingTrailingSpace = go . reverse . go . reverse + where go (Space:xs) = xs + go xs = xs + +-- Put display math in its own block (for ODT/DOCX). +fixDisplayMath :: Block -> Block +fixDisplayMath (Plain lst) + | any isDisplayMath lst && not (all isDisplayMath lst) = + -- chop into several paragraphs so each displaymath is its own + Div ("",["math"],[]) $ map (Plain . stripLeadingTrailingSpace) $ + groupBy (\x y -> (isDisplayMath x && isDisplayMath y) || + not (isDisplayMath x || isDisplayMath y)) lst +fixDisplayMath (Para lst) + | any isDisplayMath lst && not (all isDisplayMath lst) = + -- chop into several paragraphs so each displaymath is its own + Div ("",["math"],[]) $ map (Para . stripLeadingTrailingSpace) $ + groupBy (\x y -> (isDisplayMath x && isDisplayMath y) || + not (isDisplayMath x || isDisplayMath y)) lst +fixDisplayMath x = x -- cgit v1.2.3 From 002c8ce14ca15bfbc800e9628cf09babf3d96acd Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 7 Jan 2014 09:01:32 -0800 Subject: Fixed small regression in docx writer. --- src/Text/Pandoc/Writers/Docx.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 25739f7c8..2a834c2da 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -30,7 +30,7 @@ Conversion of 'Pandoc' documents to docx. -} module Text.Pandoc.Writers.Docx ( writeDocx ) where import Data.Maybe (fromMaybe) -import Data.List ( intercalate, isPrefixOf ) +import Data.List ( intercalate, isPrefixOf, isSuffixOf ) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 @@ -265,6 +265,7 @@ writeDocx opts doc@(Pandoc meta _) = do webSettingsEntry <- entryFromArchive "word/webSettings.xml" let miscRels = [ f | f <- filesInArchive refArchive , "word/_rels/" `isPrefixOf` f + , ".xml.rels" `isSuffixOf` f , f /= "word/_rels/document.xml.rels" , f /= "word/_rels/footnotes.xml.rels" ] miscRelEntries <- mapM entryFromArchive miscRels @@ -815,6 +816,8 @@ br = mknode "w:r" [] [mknode "w:br" [("w:type","textWrapping")] () ] parseXml :: Archive -> String -> IO Element parseXml refArchive relpath = - case (findEntryByPath relpath refArchive >>= parseXMLDoc . UTF8.toStringLazy . fromEntry) of - Just d -> return d + case findEntryByPath relpath refArchive of + Just e -> case parseXMLDoc $ UTF8.toStringLazy $ fromEntry e of + Just d -> return d + Nothing -> fail $ relpath ++ " corrupt in reference docx" Nothing -> fail $ relpath ++ " missing in reference docx" -- cgit v1.2.3