aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs47
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs55
-rw-r--r--src/Text/Pandoc/Writers/FB2.hs6
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs34
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs84
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs29
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs2
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs53
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs16
-rw-r--r--src/Text/Pandoc/Writers/Org.hs2
-rw-r--r--src/Text/Pandoc/Writers/RST.hs2
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs30
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs6
-rw-r--r--src/Text/Pandoc/Writers/Textile.hs2
14 files changed, 228 insertions, 140 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 5c7341b69..2a834c2da 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -29,7 +29,8 @@ 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, groupBy )
+import Data.Maybe (fromMaybe)
+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
@@ -42,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 )
@@ -130,7 +132,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")
@@ -260,6 +263,12 @@ 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
+ , ".xml.rels" `isSuffixOf` f
+ , f /= "word/_rels/document.xml.rels"
+ , f /= "word/_rels/footnotes.xml.rels" ]
+ miscRelEntries <- mapM entryFromArchive miscRels
-- Create archive
let archive = foldr addEntryToArchive emptyArchive $
@@ -267,7 +276,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]
@@ -322,7 +331,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
@@ -807,30 +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"
-
-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/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 59c90b16d..a48300939 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -38,7 +38,7 @@ import Text.Printf (printf)
import System.FilePath ( (</>), takeBaseName, takeExtension, takeFileName )
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B8
-import Text.Pandoc.UTF8 ( fromStringLazy, toString )
+import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.SelfContained ( makeSelfContained )
import Codec.Archive.Zip
import Control.Applicative ((<$>))
@@ -89,8 +89,13 @@ data EPUBMetadata = EPUBMetadata{
, epubCoverage :: Maybe String
, epubRights :: Maybe String
, epubCoverImage :: Maybe String
+ , epubStylesheet :: Maybe Stylesheet
} deriving Show
+data Stylesheet = StylesheetPath FilePath
+ | StylesheetContents String
+ deriving Show
+
data Creator = Creator{
creatorText :: String
, creatorRole :: Maybe String
@@ -119,7 +124,12 @@ opfName n = QName n Nothing (Just "opf")
plainify :: [Inline] -> String
plainify t =
- trimr $ writePlain def{ writerStandalone = False } $ Pandoc nullMeta [Plain t]
+ trimr $ writePlain def{ writerStandalone = False }
+ $ Pandoc nullMeta [Plain $ walk removeNote t]
+
+removeNote :: Inline -> Inline
+removeNote (Note _) = Str ""
+removeNote x = x
getEPUBMetadata :: WriterOptions -> Meta -> IO EPUBMetadata
getEPUBMetadata opts meta = do
@@ -171,8 +181,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
@@ -262,10 +272,11 @@ metadataFromMeta opts meta = EPUBMetadata{
, epubCoverage = coverage
, epubRights = rights
, epubCoverImage = coverImage
+ , epubStylesheet = stylesheet
}
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
@@ -282,13 +293,16 @@ metadataFromMeta opts meta = EPUBMetadata{
rights = metaValueToString <$> lookupMeta "rights" meta
coverImage = lookup "epub-cover-image" (writerVariables opts) `mplus`
(metaValueToString <$> lookupMeta "cover-image" meta)
+ stylesheet = (StylesheetContents <$> writerEpubStylesheet opts) `mplus`
+ ((StylesheetPath . metaValueToString) <$>
+ lookupMeta "stylesheet" meta)
-- | Produce an EPUB file from a Pandoc document.
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
@@ -392,10 +406,12 @@ 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
+ -- remove notes or we get doubled footnotes
+ Pandoc (setMeta "title" (walk removeNote $ fromList xs)
+ nullMeta) bs
_ ->
Pandoc nullMeta bs
@@ -427,7 +443,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"
@@ -437,7 +453,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
(x:_) -> identifierText x -- use first identifier as UUID
[] -> error "epubIdentifier is null" -- shouldn't happen
currentTime <- getCurrentTime
- let contentsData = fromStringLazy $ ppTopElement $
+ let contentsData = UTF8.fromStringLazy $ ppTopElement $
unode "package" ! [("version", case version of
EPUB2 -> "2.0"
EPUB3 -> "3.0")
@@ -525,7 +541,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
[ unode "navLabel" $ unode "text" (plainify $ docTitle meta)
, unode "content" ! [("src","title_page.xhtml")] $ () ]
- let tocData = fromStringLazy $ ppTopElement $
+ let tocData = UTF8.fromStringLazy $ ppTopElement $
unode "ncx" ! [("version","2005-1")
,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
[ unode "head" $
@@ -557,7 +573,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
(_:_) -> [unode "ol" ! [("class","toc")] $ subs]
let navtag = if epub3 then "nav" else "div"
- let navData = fromStringLazy $ ppTopElement $
+ let navData = UTF8.fromStringLazy $ ppTopElement $
unode "html" ! [("xmlns","http://www.w3.org/1999/xhtml")
,("xmlns:epub","http://www.idpf.org/2007/ops")] $
[ unode "head" $
@@ -571,10 +587,10 @@ writeEPUB opts doc@(Pandoc meta _) = do
let navEntry = mkEntry "nav.xhtml" navData
-- mimetype
- let mimetypeEntry = mkEntry "mimetype" $ fromStringLazy "application/epub+zip"
+ let mimetypeEntry = mkEntry "mimetype" $ UTF8.fromStringLazy "application/epub+zip"
-- container.xml
- let containerData = fromStringLazy $ ppTopElement $
+ let containerData = UTF8.fromStringLazy $ ppTopElement $
unode "container" ! [("version","1.0")
,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
unode "rootfiles" $
@@ -583,18 +599,19 @@ writeEPUB opts doc@(Pandoc meta _) = do
let containerEntry = mkEntry "META-INF/container.xml" containerData
-- com.apple.ibooks.display-options.xml
- let apple = fromStringLazy $ ppTopElement $
+ let apple = UTF8.fromStringLazy $ ppTopElement $
unode "display_options" $
unode "platform" ! [("name","*")] $
unode "option" ! [("name","specified-fonts")] $ "true"
let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple
-- stylesheet
- stylesheet <- case writerEpubStylesheet opts of
- Just s -> return s
- Nothing -> toString `fmap`
+ stylesheet <- case epubStylesheet metadata of
+ Just (StylesheetPath fp) -> UTF8.readFile fp
+ Just (StylesheetContents s) -> return s
+ Nothing -> UTF8.toString `fmap`
readDataFile (writerUserDataDir opts) "epub.css"
- let stylesheetEntry = mkEntry "stylesheet.css" $ fromStringLazy stylesheet
+ let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
-- construct archive
let archive = foldr addEntryToArchive emptyArchive
diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs
index adbe948be..803617f95 100644
--- a/src/Text/Pandoc/Writers/FB2.hs
+++ b/src/Text/Pandoc/Writers/FB2.hs
@@ -44,7 +44,7 @@ import qualified Text.XML.Light.Cursor as XC
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)
-import Text.Pandoc.Shared (orderedListMarkers)
+import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock)
import Text.Pandoc.Walk
-- | Data to be written at the end of the document:
@@ -157,9 +157,7 @@ renderSection level (ttl, body) = do
else cMapM blockToXml body
return $ el "section" (title ++ content)
where
- hasSubsections = any isHeader
- isHeader (Header _ _ _) = True
- isHeader _ = False
+ hasSubsections = any isHeaderBlock
-- | Only <p> and <empty-line> are allowed within <title> in FB2.
formatTitle :: [Inline] -> [Content]
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 641652276..3ac2a836f 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
@@ -475,28 +475,22 @@ blockToHtml opts (BlockQuote blocks) =
else do
contents <- blockListToHtml opts blocks
return $ H.blockquote $ nl opts >> contents >> nl opts
-blockToHtml opts (Header level (ident,_,_) lst) = do
+blockToHtml opts (Header level (_,classes,_) lst) = do
contents <- inlineListToHtml opts lst
secnum <- liftM stSecNum get
let contents' = if writerNumberSections opts && not (null secnum)
+ && "unnumbered" `notElem` classes
then (H.span ! A.class_ "header-section-number" $ toHtml
$ showSecNum secnum) >> strToHtml " " >> contents
else contents
- let revealSlash = ['/' | writerSlideVariant opts == RevealJsSlides]
- let contents'' = if writerTableOfContents opts && not (null ident)
- then H.a ! A.href (toValue $
- '#' : revealSlash ++
- writerIdentifierPrefix opts ++
- ident) $ contents'
- else contents'
return $ case level of
- 1 -> H.h1 contents''
- 2 -> H.h2 contents''
- 3 -> H.h3 contents''
- 4 -> H.h4 contents''
- 5 -> H.h5 contents''
- 6 -> H.h6 contents''
- _ -> H.p contents''
+ 1 -> H.h1 contents'
+ 2 -> H.h2 contents'
+ 3 -> H.h3 contents'
+ 4 -> H.h4 contents'
+ 5 -> H.h5 contents'
+ 6 -> H.h6 contents'
+ _ -> H.p contents'
blockToHtml opts (BulletList lst) = do
contents <- mapM (blockListToHtml opts) lst
return $ unordList opts contents
@@ -524,7 +518,7 @@ blockToHtml opts (DefinitionList lst) = do
contents <- mapM (\(term, defs) ->
do term' <- if null term
then return mempty
- else liftM (H.dt) $ inlineListToHtml opts term
+ else liftM H.dt $ inlineListToHtml opts term
defs' <- mapM ((liftM (\x -> H.dd $ (x >> nl opts))) .
blockListToHtml opts) defs
return $ mconcat $ nl opts : term' : nl opts :
@@ -756,7 +750,9 @@ inlineToHtml opts inline =
else [A.title $ toValue tit])
return $ foldl (!) H5.embed attributes
-- note: null title included, as in Markdown.pl
- (Note contents) -> do
+ (Note contents)
+ | writerIgnoreNotes opts -> return mempty
+ | otherwise -> do
st <- get
let notes = stNotes st
let number = (length notes) + 1
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index f3cbcf19f..b2eff4490 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
@@ -50,6 +51,8 @@ import Text.Pandoc.Highlighting (highlight, styleToLaTeX,
data WriterState =
WriterState { stInNote :: Bool -- true if we're in a note
+ , stInMinipage :: Bool -- true if in minipage
+ , stNotes :: [Doc] -- notes in a minipage
, stOLLevel :: Int -- level of ordered list nesting
, stOptions :: WriterOptions -- writer options, so they don't have to be parameter
, stVerbInNote :: Bool -- true if document has verbatim text in note
@@ -70,7 +73,7 @@ data WriterState =
writeLaTeX :: WriterOptions -> Pandoc -> String
writeLaTeX options document =
evalState (pandocToLaTeX options document) $
- WriterState { stInNote = False,
+ WriterState { stInNote = False, stInMinipage = False, stNotes = [],
stOLLevel = 1, stOptions = options,
stVerbInNote = False,
stTable = False, stStrikeout = False,
@@ -188,7 +191,7 @@ stringToLaTeX _ [] = return ""
stringToLaTeX ctx (x:xs) = do
opts <- gets stOptions
rest <- stringToLaTeX ctx xs
- let ligatures = writerTeXLigatures opts && not (ctx == CodeString)
+ let ligatures = writerTeXLigatures opts && (ctx /= CodeString)
let isUrl = ctx == URLString
when (x == '€') $
modify $ \st -> st{ stUsesEuro = True }
@@ -203,7 +206,7 @@ stringToLaTeX ctx (x:xs) = do
'_' | not isUrl -> "\\_" ++ rest
'#' -> "\\#" ++ rest
'-' -> case xs of -- prevent adjacent hyphens from forming ligatures
- ('-':_) -> "-{}" ++ rest
+ ('-':_) -> "-\\/" ++ rest
_ -> '-' : rest
'~' | not isUrl -> "\\textasciitilde{}" ++ rest
'^' -> "\\^{}" ++ rest
@@ -238,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')
@@ -441,7 +444,7 @@ blockToLaTeX (DefinitionList lst) = do
incremental <- gets stIncremental
let inc = if incremental then "[<+->]" else ""
items <- mapM defListItemToLaTeX lst
- let spacing = if and $ map isTightList (map snd lst)
+ let spacing = if all isTightList (map snd lst)
then text "\\itemsep1pt\\parskip0pt\\parsep0pt"
else empty
return $ text ("\\begin{description}" ++ inc) $$ spacing $$ vcat items $$
@@ -453,12 +456,12 @@ blockToLaTeX (Header level (id',classes,_) lst) =
blockToLaTeX (Table caption aligns widths heads rows) = do
headers <- if all null heads
then return empty
- else ($$ "\\hline\\noalign{\\medskip}") `fmap`
+ else ($$ "\\midrule\\endhead") `fmap`
(tableRowToLaTeX True aligns widths) heads
captionText <- inlineListToLaTeX caption
let capt = if isEmpty captionText
then empty
- else text "\\noalign{\\medskip}"
+ else text "\\addlinespace"
$$ text "\\caption" <> braces captionText
rows' <- mapM (tableRowToLaTeX False aligns widths) rows
let colDescriptors = text $ concat $ map toColDescriptor aligns
@@ -466,10 +469,10 @@ blockToLaTeX (Table caption aligns widths heads rows) = do
return $ "\\begin{longtable}[c]" <>
braces ("@{}" <> colDescriptors <> "@{}")
-- the @{} removes extra space at beginning and end
- $$ "\\hline\\noalign{\\medskip}"
+ $$ "\\toprule\\addlinespace"
$$ headers
$$ vcat rows'
- $$ "\\hline"
+ $$ "\\bottomrule"
$$ capt
$$ "\\end{longtable}"
@@ -490,23 +493,42 @@ tableRowToLaTeX :: Bool
-> [[Block]]
-> State WriterState Doc
tableRowToLaTeX header aligns widths cols = do
- renderedCells <- mapM blockListToLaTeX cols
- let valign = text $ if header then "[b]" else "[t]"
- let halign x = case x of
- AlignLeft -> "\\raggedright"
- AlignRight -> "\\raggedleft"
- AlignCenter -> "\\centering"
- AlignDefault -> "\\raggedright"
-- scale factor compensates for extra space between columns
-- so the whole table isn't larger than columnwidth
let scaleFactor = 0.97 ** fromIntegral (length aligns)
- let toCell 0 _ c = c
- toCell w a c = "\\begin{minipage}" <> valign <>
- braces (text (printf "%.2f\\columnwidth"
- (w * scaleFactor))) <>
- (halign a <> cr <> c <> cr) <> "\\end{minipage}"
- let cells = zipWith3 toCell widths aligns renderedCells
- return $ hsep (intersperse "&" cells) $$ "\\\\\\noalign{\\medskip}"
+ let widths' = map (scaleFactor *) widths
+ cells <- mapM (tableCellToLaTeX header) $ zip3 widths' aligns cols
+ return $ hsep (intersperse "&" cells) $$ "\\\\\\addlinespace"
+
+tableCellToLaTeX :: Bool -> (Double, Alignment, [Block])
+ -> State WriterState Doc
+tableCellToLaTeX _ (0, _, blocks) = blockListToLaTeX blocks
+tableCellToLaTeX header (width, align, blocks) = do
+ modify $ \st -> st{ stInMinipage = True, stNotes = [] }
+ cellContents <- blockListToLaTeX blocks
+ notes <- gets stNotes
+ modify $ \st -> st{ stInMinipage = False, stNotes = [] }
+ let valign = text $ if header then "[b]" else "[t]"
+ let halign = case align of
+ AlignLeft -> "\\raggedright"
+ AlignRight -> "\\raggedleft"
+ AlignCenter -> "\\centering"
+ AlignDefault -> "\\raggedright"
+ return $ ("\\begin{minipage}" <> valign <>
+ braces (text (printf "%.2f\\columnwidth" width)) <>
+ (halign <> cr <> cellContents <> cr) <> "\\end{minipage}")
+ $$ case notes of
+ [] -> empty
+ ns -> (case length ns of
+ n | n > 1 -> "\\addtocounter" <>
+ braces "footnote" <>
+ braces (text $ show $ 1 - n)
+ | otherwise -> empty)
+ $$
+ vcat (intersperse
+ ("\\addtocounter" <> braces "footnote" <> braces "1")
+ $ map (\x -> "\\footnotetext" <> braces x)
+ $ reverse ns)
listItemToLaTeX :: [Block] -> State WriterState Doc
listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item" $$) .
@@ -709,14 +731,20 @@ inlineToLaTeX (Image _ (source, _)) = do
source'' <- stringToLaTeX URLString source'
return $ "\\includegraphics" <> braces (text source'')
inlineToLaTeX (Note contents) = do
+ inMinipage <- gets stInMinipage
modify (\s -> s{stInNote = True})
contents' <- blockListToLaTeX contents
modify (\s -> s {stInNote = False})
let optnl = case reverse contents of
(CodeBlock _ _ : _) -> cr
_ -> empty
- return $ "\\footnote" <> braces (nest 2 contents' <> optnl)
- -- note: a \n before } needed when note ends with a Verbatim environment
+ let noteContents = nest 2 contents' <> optnl
+ modify $ \st -> st{ stNotes = noteContents : stNotes st }
+ return $
+ if inMinipage
+ then "\\footnotemark{}"
+ -- note: a \n before } needed when note ends with a Verbatim environment
+ else "\\footnote" <> braces noteContents
citationsToNatbib :: [Citation] -> State WriterState Doc
citationsToNatbib (one:[])
@@ -737,9 +765,9 @@ citationsToNatbib cits
| noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits
= citeCommand "citep" p s ks
where
- noPrefix = and . map (null . citationPrefix)
- noSuffix = and . map (null . citationSuffix)
- ismode m = and . map (((==) m) . citationMode)
+ noPrefix = all (null . citationPrefix)
+ noSuffix = all (null . citationSuffix)
+ ismode m = all (((==) m) . citationMode)
p = citationPrefix $ head $ cits
s = citationSuffix $ last $ cits
ks = intercalate ", " $ map citationId cits
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 60d474263..278e5cc9d 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -338,7 +338,7 @@ blockToMarkdown opts (RawBlock f str)
else return $ if isEnabled Ext_markdown_attribute opts
then text (addMarkdownAttribute str) <> text "\n"
else text str <> text "\n"
- | f == "latex" || f == "tex" || f == "markdown" = do
+ | f `elem` ["latex", "tex", "markdown"] = do
st <- get
if stPlain st
then return empty
@@ -381,13 +381,11 @@ blockToMarkdown opts (CodeBlock (_,classes,_) str)
isEnabled Ext_literate_haskell opts =
return $ prefixed "> " (text str) <> blankline
blockToMarkdown opts (CodeBlock attribs str) = return $
- case attribs of
- x | x /= nullAttr && isEnabled Ext_fenced_code_blocks opts ->
- tildes <> " " <> attrs <> cr <> text str <>
- cr <> tildes <> blankline
- (_,(cls:_),_) | isEnabled Ext_backtick_code_blocks opts ->
- backticks <> " " <> text cls <> cr <> text str <>
- cr <> backticks <> blankline
+ case attribs == nullAttr of
+ False | isEnabled Ext_backtick_code_blocks opts ->
+ backticks <> attrs <> cr <> text str <> cr <> backticks <> blankline
+ | isEnabled Ext_fenced_code_blocks opts ->
+ tildes <> attrs <> cr <> text str <> cr <> tildes <> blankline
_ -> nest (writerTabStop opts) (text str) <> blankline
where tildes = text $ case [ln | ln <- lines str, all (=='~') ln] of
[] -> "~~~~"
@@ -396,8 +394,10 @@ blockToMarkdown opts (CodeBlock attribs str) = return $
| otherwise -> replicate (n+1) '~'
backticks = text "```"
attrs = if isEnabled Ext_fenced_code_attributes opts
- then nowrap $ attrsToMarkdown attribs
- else empty
+ then nowrap $ " " <> attrsToMarkdown attribs
+ else case attribs of
+ (_,[cls],_) -> " " <> text cls
+ _ -> empty
blockToMarkdown opts (BlockQuote blocks) = do
st <- get
-- if we're writing literate haskell, put a space before the bird tracks
@@ -628,10 +628,11 @@ getReference label (src, tit) = do
Nothing -> do
let label' = case find ((== label) . fst) (stRefs st) of
Just _ -> -- label is used; generate numerical label
- case find (\n -> not (any (== [Str (show n)])
- (map fst (stRefs st)))) [1..(10000 :: Integer)] of
- Just x -> [Str (show x)]
- Nothing -> error "no unique label"
+ case find (\n -> notElem [Str (show n)]
+ (map fst (stRefs st)))
+ [1..(10000 :: Integer)] of
+ Just x -> [Str (show x)]
+ Nothing -> error "no unique label"
Nothing -> label
modify (\s -> s{ stRefs = (label', (src,tit)) : stRefs st })
return label'
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index 61741a61e..83fefaa29 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -51,7 +51,7 @@ data WriterState = WriterState {
writeMediaWiki :: WriterOptions -> Pandoc -> String
writeMediaWiki opts document =
evalState (pandocToMediaWiki opts document)
- (WriterState { stNotes = False, stListLevel = [], stUseTags = False })
+ WriterState { stNotes = False, stListLevel = [], stUseTags = False }
-- | Return MediaWiki representation of document.
pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index cc0a06243..c3652d65d 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -30,7 +30,10 @@ Conversion of 'Pandoc' documents to ODT.
-}
module Text.Pandoc.Writers.ODT ( writeODT ) where
import Data.IORef
-import Data.List ( isPrefixOf )
+import Data.List ( isPrefixOf, isSuffixOf )
+import Data.Maybe ( fromMaybe )
+import Text.XML.Light.Output
+import Text.TeXMath
import qualified Data.ByteString.Lazy as B
import Text.Pandoc.UTF8 ( fromStringLazy )
import Codec.Archive.Zip
@@ -40,13 +43,14 @@ import Text.Pandoc.ImageSize ( imageSize, sizeInPoints )
import Text.Pandoc.MIME ( getMimeType )
import Text.Pandoc.Definition
import Text.Pandoc.Walk
+import Text.Pandoc.Writers.Shared ( fixDisplayMath )
import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
import Control.Monad (liftM)
import Text.Pandoc.XML
import Text.Pandoc.Pretty
import qualified Control.Exception as E
import Data.Time.Clock.POSIX ( getPOSIXTime )
-import System.FilePath ( takeExtension )
+import System.FilePath ( takeExtension, takeDirectory )
-- | Produce an ODT file from a Pandoc document.
writeODT :: WriterOptions -- ^ Writer options
@@ -60,9 +64,9 @@ writeODT opts doc@(Pandoc meta _) = do
Just f -> B.readFile f
Nothing -> (B.fromChunks . (:[])) `fmap`
readDataFile datadir "reference.odt"
- -- handle pictures
+ -- handle formulas and pictures
picEntriesRef <- newIORef ([] :: [Entry])
- doc' <- walkM (transformPic opts picEntriesRef) doc
+ doc' <- walkM (transformPicMath opts picEntriesRef) $ walk fixDisplayMath doc
let newContents = writeOpenDocument opts{writerWrapText = False} doc'
epochtime <- floor `fmap` getPOSIXTime
let contentEntry = toEntry "content.xml" epochtime
@@ -72,7 +76,11 @@ writeODT opts doc@(Pandoc meta _) = do
$ contentEntry : picEntries
-- construct META-INF/manifest.xml based on archive
let toFileEntry fp = case getMimeType fp of
- Nothing -> empty
+ Nothing -> if "Formula-" `isPrefixOf` fp && "/" `isSuffixOf` fp
+ then selfClosingTag "manifest:file-entry"
+ [("manifest:media-type","application/vnd.oasis.opendocument.formula")
+ ,("manifest:full-path",fp)]
+ else empty
Just m -> selfClosingTag "manifest:file-entry"
[("manifest:media-type", m)
,("manifest:full-path", fp)
@@ -80,6 +88,8 @@ writeODT opts doc@(Pandoc meta _) = do
]
let files = [ ent | ent <- filesInArchive archive,
not ("META-INF" `isPrefixOf` ent) ]
+ let formulas = [ takeDirectory ent ++ "/" | ent <- filesInArchive archive,
+ "Formula-" `isPrefixOf` ent, takeExtension ent == ".xml" ]
let manifestEntry = toEntry "META-INF/manifest.xml" epochtime
$ fromStringLazy $ render Nothing
$ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
@@ -91,6 +101,7 @@ writeODT opts doc@(Pandoc meta _) = do
[("manifest:media-type","application/vnd.oasis.opendocument.text")
,("manifest:full-path","/")]
$$ vcat ( map toFileEntry $ files )
+ $$ vcat ( map toFileEntry $ formulas )
)
)
let archive' = addEntryToArchive manifestEntry archive
@@ -118,8 +129,8 @@ writeODT opts doc@(Pandoc meta _) = do
$ addEntryToArchive metaEntry archive'
return $ fromArchive archive''
-transformPic :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline
-transformPic opts entriesRef (Image lab (src,_)) = do
+transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline
+transformPicMath opts entriesRef (Image lab (src,_)) = do
res <- fetchItem (writerSourceURL opts) src
case res of
Left (_ :: E.SomeException) -> do
@@ -127,7 +138,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
@@ -136,5 +147,29 @@ transformPic opts entriesRef (Image lab (src,_)) = do
let entry = toEntry newsrc epochtime $ toLazy img
modifyIORef entriesRef (entry:)
return $ Image lab (newsrc, tit')
-transformPic _ _ x = return x
+transformPicMath _ entriesRef (Math t math) = do
+ entries <- readIORef entriesRef
+ let dt = if t == InlineMath then DisplayInline else DisplayBlock
+ case texMathToMathML dt math of
+ Left _ -> return $ Math t math
+ Right r -> do
+ let conf = useShortEmptyTags (const False) defaultConfigPP
+ let mathml = ppcTopElement conf r
+ epochtime <- floor `fmap` getPOSIXTime
+ let dirname = "Formula-" ++ show (length entries) ++ "/"
+ let fname = dirname ++ "content.xml"
+ let entry = toEntry fname epochtime (fromStringLazy mathml)
+ modifyIORef entriesRef (entry:)
+ return $ RawInline (Format "opendocument") $ render Nothing $
+ inTags False "draw:frame" [("text:anchor-type",
+ if t == DisplayMath
+ then "paragraph"
+ else "as-char")
+ ,("style:vertical-pos", "middle")
+ ,("style:vertical-rel", "text")] $
+ selfClosingTag "draw:object" [("xlink:href", dirname)
+ , ("xlink:type", "simple")
+ , ("xlink:show", "embed")
+ , ("xlink:actuate", "onLoad")]
+transformPicMath _ _ x = return x
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 4ddfd7166..0029c3296 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -285,8 +285,12 @@ blocksToOpenDocument o b = vcat <$> mapM (blockToOpenDocument o) b
-- | Convert a Pandoc block element to OpenDocument.
blockToOpenDocument :: WriterOptions -> Block -> State WriterState Doc
blockToOpenDocument o bs
- | Plain b <- bs = inParagraphTags =<< inlinesToOpenDocument o b
- | Para b <- bs = inParagraphTags =<< inlinesToOpenDocument o b
+ | Plain b <- bs = if null b
+ then return empty
+ else inParagraphTags =<< inlinesToOpenDocument o b
+ | Para b <- bs = if null b
+ then return empty
+ else inParagraphTags =<< inlinesToOpenDocument o b
| Div _ xs <- bs = blocksToOpenDocument o xs
| Header i _ b <- bs = setFirstPara >>
(inHeaderTags i =<< inlinesToOpenDocument o b)
@@ -298,8 +302,8 @@ blockToOpenDocument o bs
| Table c a w h r <- bs = setFirstPara >> table c a w h r
| HorizontalRule <- bs = setFirstPara >> return (selfClosingTag "text:p"
[ ("text:style-name", "Horizontal_20_Line") ])
- | RawBlock f s <- bs = if f == "opendocument"
- then preformatted s
+ | RawBlock f s <- bs = if f == Format "opendocument"
+ then return $ text s
else return empty
| Null <- bs = return empty
| otherwise = return empty
@@ -378,8 +382,8 @@ inlineToOpenDocument o ils
| Code _ s <- ils = withTextStyle Pre $ inTextStyle $ preformatted s
| Math t s <- ils = inlinesToOpenDocument o (readTeXMath' t s)
| Cite _ l <- ils = inlinesToOpenDocument o l
- | RawInline f s <- ils = if f == "opendocument"
- then return $ preformatted s
+ | RawInline f s <- ils = if f == Format "opendocument"
+ then return $ text s
else return empty
| Link l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l
| Image _ (s,t) <- ils = mkImg s t
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 51083f52b..d318c5f6a 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -129,7 +129,7 @@ blockToOrg (Para inlines) = do
blockToOrg (RawBlock "html" str) =
return $ blankline $$ "#+BEGIN_HTML" $$
nest 2 (text str) $$ "#+END_HTML" $$ blankline
-blockToOrg (RawBlock f str) | f == "org" || f == "latex" || f == "tex" =
+blockToOrg (RawBlock f str) | f `elem` ["org", "latex", "tex"] =
return $ text str
blockToOrg (RawBlock _ _) = return empty
blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 1a62f7250..37bb66632 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -287,7 +287,7 @@ definitionListItemToRST (label, defs) = do
label' <- inlineListToRST label
contents <- liftM vcat $ mapM blockListToRST defs
tabstop <- get >>= (return . writerTabStop . stOptions)
- return $ label' $$ nest tabstop (contents <> cr)
+ return $ label' $$ nest tabstop (nestle contents <> cr)
-- | Convert list of Pandoc block elements to RST.
blockListToRST :: [Block] -- ^ List of block elements
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 9cb08803c..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.
@@ -65,8 +67,7 @@ metaToJSON opts blockWriter inlineWriter (Meta metamap)
renderedMap <- Traversable.mapM
(metaValueToJSON blockWriter inlineWriter)
metamap
- return $ M.foldWithKey (\key val obj -> defField key val obj)
- baseContext renderedMap
+ return $ M.foldWithKey defField baseContext renderedMap
| otherwise = return (Object H.empty)
metaValueToJSON :: Monad m
@@ -137,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
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index d62e50880..bf3df8035 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -293,7 +293,7 @@ blockListToTexinfo (x:xs) = do
case x of
Header level _ _ -> do
-- We need need to insert a menu for this node.
- let (before, after) = break isHeader xs
+ let (before, after) = break isHeaderBlock xs
before' <- blockListToTexinfo before
let menu = if level < 4
then collectNodes (level + 1) after
@@ -315,10 +315,6 @@ blockListToTexinfo (x:xs) = do
xs' <- blockListToTexinfo xs
return $ x' $$ xs'
-isHeader :: Block -> Bool
-isHeader (Header _ _ _) = True
-isHeader _ = False
-
collectNodes :: Int -> [Block] -> [Block]
collectNodes _ [] = []
collectNodes level (x:xs) =
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index 7c102cc86..95aedf780 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -51,7 +51,7 @@ data WriterState = WriterState {
writeTextile :: WriterOptions -> Pandoc -> String
writeTextile opts document =
evalState (pandocToTextile opts document)
- (WriterState { stNotes = [], stListLevel = [], stUseTags = False })
+ WriterState { stNotes = [], stListLevel = [], stUseTags = False }
-- | Return Textile representation of document.
pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 05:25:57 +0000