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/AsciiDoc.hs6
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs178
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs20
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs18
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs108
5 files changed, 213 insertions, 117 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index e5b8c5167..1c33b004a 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -126,7 +126,7 @@ blockToAsciiDoc :: WriterOptions -- ^ Options
blockToAsciiDoc _ Null = return empty
blockToAsciiDoc opts (Plain inlines) = do
contents <- inlineListToAsciiDoc opts inlines
- return $ contents <> cr
+ return $ contents <> blankline
blockToAsciiDoc opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do
blockToAsciiDoc opts (Para [Image alt (src,tit)])
blockToAsciiDoc opts (Para inlines) = do
@@ -272,7 +272,7 @@ bulletListItemToAsciiDoc opts blocks = do
contents <- foldM addBlock empty blocks
modify $ \s -> s{ bulletListLevel = lev }
let marker = text (replicate lev '*')
- return $ marker <> space <> contents <> cr
+ return $ marker <> text " " <> contents <> cr
-- | Convert ordered list item (a list of blocks) to asciidoc.
orderedListItemToAsciiDoc :: WriterOptions -- ^ options
@@ -292,7 +292,7 @@ orderedListItemToAsciiDoc opts marker blocks = do
modify $ \s -> s{ orderedListLevel = lev + 1 }
contents <- foldM addBlock empty blocks
modify $ \s -> s{ orderedListLevel = lev }
- return $ text marker <> space <> contents <> cr
+ return $ text marker <> text " " <> contents <> cr
-- | Convert definition list item (label, list of blocks) to asciidoc.
definitionListItemToAsciiDoc :: WriterOptions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 441392918..81369e278 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -29,7 +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.List ( intercalate, isPrefixOf, isSuffixOf, stripPrefix )
+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
@@ -54,6 +54,8 @@ import Text.Pandoc.Walk
import Text.Highlighting.Kate.Types ()
import Text.XML.Light as XML
import Text.TeXMath
+import Text.Pandoc.Readers.Docx.StyleMap
+import Text.Pandoc.Readers.Docx.Util (elemName)
import Control.Monad.State
import Text.Highlighting.Kate
import Data.Unique (hashUnique, newUnique)
@@ -63,8 +65,7 @@ import qualified Control.Exception as E
import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
extensionFromMimeType)
import Control.Applicative ((<$>), (<|>), (<*>))
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Char (isDigit)
+import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
data ListMarker = NoMarker
| BulletMarker
@@ -106,7 +107,7 @@ data WriterState = WriterState{
, stChangesAuthor :: String
, stChangesDate :: String
, stPrintWidth :: Integer
- , stHeadingStyles :: [(Int,String)]
+ , stStyleMaps :: StyleMaps
, stFirstPara :: Bool
}
@@ -127,7 +128,7 @@ defaultWriterState = WriterState{
, stChangesAuthor = "unknown"
, stChangesDate = "1969-12-31T19:00:00Z"
, stPrintWidth = 1
- , stHeadingStyles = []
+ , stStyleMaps = defaultStyleMaps
, stFirstPara = False
}
@@ -215,32 +216,14 @@ writeDocx opts doc@(Pandoc meta _) = do
styledoc <- parseXml refArchive distArchive stylepath
-- parse styledoc for heading styles
- let styleNamespaces = map ((,) <$> qName . attrKey <*> attrVal) .
- filter ((==Just "xmlns") . qPrefix . attrKey) .
- elAttribs $ styledoc
- let headingStyles =
- let
- mywURI = lookup "w" styleNamespaces
- myName name = QName name mywURI (Just "w")
- getAttrStyleId = findAttr (myName "styleId")
- getNameVal = findChild (myName "name") >=> findAttr (myName "val")
- getNum s | not $ null s, all isDigit s = Just (read s :: Int)
- | otherwise = Nothing
- getEngHeader = getAttrStyleId >=> stripPrefix "Heading" >=> getNum
- getIntHeader = getNameVal >=> stripPrefix "heading " >=> getNum
- toTuple getF = liftM2 (,) <$> getF <*> getAttrStyleId
- toMap getF = mapMaybe (toTuple getF) $
- findChildren (myName "style") styledoc
- select a b | not $ null a = a
- | otherwise = b
- in
- select (toMap getEngHeader) (toMap getIntHeader)
+ let styleMaps = getStyleMaps styledoc
((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc')
defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username
, stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime
, stPrintWidth = (maybe 420 (\x -> quot x 20) pgContentWidth)
- , stHeadingStyles = headingStyles}
+ , stStyleMaps = styleMaps
+ }
let epochtime = floor $ utcTimeToPOSIXSeconds utctime
let imgs = M.elems $ stImages st
@@ -393,9 +376,18 @@ writeDocx opts doc@(Pandoc meta _) = do
linkrels
-- styles
- let newstyles = styleToOpenXml $ writerHighlightStyle opts
- let styledoc' = styledoc{ elContent = elContent styledoc ++
- [Elem x | x <- newstyles, writerHighlight opts] }
+ let newstyles = styleToOpenXml styleMaps $ writerHighlightStyle opts
+ let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) }
+ where
+ modifyContent
+ | writerHighlight opts = (++ map Elem newstyles)
+ | otherwise = filter notTokStyle
+ notTokStyle (Elem el) = notStyle el || notTokId el
+ notTokStyle _ = True
+ notStyle = (/= elemName' "style") . elName
+ notTokId = maybe True (`notElem` tokStys) . findAttr (elemName' "styleId")
+ tokStys = "SourceCode" : map show (enumFromTo KeywordTok NormalTok)
+ elemName' = elemName (sNameSpaces styleMaps) "w"
let styleEntry = toEntry stylepath epochtime $ renderXml styledoc'
-- construct word/numbering.xml
@@ -472,10 +464,13 @@ writeDocx opts doc@(Pandoc meta _) = do
miscRelEntries ++ otherMediaEntries
return $ fromArchive archive
-styleToOpenXml :: Style -> [Element]
-styleToOpenXml style = parStyle : map toStyle alltoktypes
+styleToOpenXml :: StyleMaps -> Style -> [Element]
+styleToOpenXml sm style =
+ maybeToList parStyle ++ mapMaybe toStyle alltoktypes
where alltoktypes = enumFromTo KeywordTok NormalTok
- toStyle toktype = mknode "w:style" [("w:type","character"),
+ toStyle toktype | hasStyleName (show toktype) (sCharStyleMap sm) = Nothing
+ | otherwise = Just $
+ mknode "w:style" [("w:type","character"),
("w:customStyle","1"),("w:styleId",show toktype)]
[ mknode "w:name" [("w:val",show toktype)] ()
, mknode "w:basedOn" [("w:val","VerbatimChar")] ()
@@ -496,7 +491,9 @@ styleToOpenXml style = parStyle : map toStyle alltoktypes
tokBg toktype = maybe "auto" (drop 1 . fromColor)
$ (tokenBackground =<< lookup toktype tokStyles)
`mplus` backgroundColor style
- parStyle = mknode "w:style" [("w:type","paragraph"),
+ parStyle | hasStyleName "Source Code" (sParaStyleMap sm) = Nothing
+ | otherwise = Just $
+ mknode "w:style" [("w:type","paragraph"),
("w:customStyle","1"),("w:styleId","SourceCode")]
[ mknode "w:name" [("w:val","Source Code")] ()
, mknode "w:basedOn" [("w:val","Normal")] ()
@@ -602,14 +599,14 @@ writeOpenXML opts (Pandoc meta blocks) = do
Just (MetaBlocks [Para xs]) -> xs
Just (MetaInlines xs) -> xs
_ -> []
- title <- withParaProp (pStyle "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]
- subtitle <- withParaProp (pStyle "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')]
- authors <- withParaProp (pStyle "Author") $ blocksToOpenXML opts $
+ title <- withParaPropM (pStyleM "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]
+ subtitle <- withParaPropM (pStyleM "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')]
+ authors <- withParaProp (pCustomStyle "Author") $ blocksToOpenXML opts $
map Para auths
- date <- withParaProp (pStyle "Date") $ blocksToOpenXML opts [Para dat | not (null dat)]
+ date <- withParaPropM (pStyleM "Date") $ blocksToOpenXML opts [Para dat | not (null dat)]
abstract <- if null abstract'
then return []
- else withParaProp (pStyle "Abstract") $ blocksToOpenXML opts abstract'
+ else withParaProp (pCustomStyle "Abstract") $ blocksToOpenXML opts abstract'
let convertSpace (Str x : Space : Str y : xs) = Str (x ++ " " ++ y) : xs
convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs
convertSpace xs = xs
@@ -623,11 +620,23 @@ writeOpenXML opts (Pandoc meta blocks) = do
blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element]
blocksToOpenXML opts bls = concat `fmap` mapM (blockToOpenXML opts) bls
-pStyle :: String -> Element
-pStyle sty = mknode "w:pStyle" [("w:val",sty)] ()
+pCustomStyle :: String -> Element
+pCustomStyle sty = mknode "w:pStyle" [("w:val",sty)] ()
-rStyle :: String -> Element
-rStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
+pStyleM :: String -> WS XML.Element
+pStyleM styleName = do
+ styleMaps <- gets stStyleMaps
+ let sty' = getStyleId styleName $ sParaStyleMap styleMaps
+ return $ mknode "w:pStyle" [("w:val",sty')] ()
+
+rCustomStyle :: String -> Element
+rCustomStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
+
+rStyleM :: String -> WS XML.Element
+rStyleM styleName = do
+ styleMaps <- gets stStyleMaps
+ let sty' = getStyleId styleName $ sCharStyleMap styleMaps
+ return $ mknode "w:rStyle" [("w:val",sty')] ()
getUniqueId :: MonadIO m => m String
-- the + 20 is to ensure that there are no clashes with the rIds
@@ -641,13 +650,12 @@ blockToOpenXML opts (Div (_,["references"],_) bs) = do
let (hs, bs') = span isHeaderBlock bs
header <- blocksToOpenXML opts hs
-- We put the Bibliography style on paragraphs after the header
- rest <- withParaProp (pStyle "Bibliography") $ blocksToOpenXML opts bs'
+ rest <- withParaPropM (pStyleM "Bibliography") $ blocksToOpenXML opts bs'
return (header ++ rest)
blockToOpenXML opts (Div _ bs) = blocksToOpenXML opts bs
blockToOpenXML opts (Header lev (ident,_,_) lst) = do
setFirstPara
- headingStyles <- gets stHeadingStyles
- paraProps <- maybe id (withParaProp . pStyle) (lookup lev headingStyles) $
+ paraProps <- withParaPropM (pStyleM ("Heading "++show lev)) $
getParaProps False
contents <- inlinesToOpenXML opts lst
usedIdents <- gets stSectionIds
@@ -660,26 +668,27 @@ blockToOpenXML opts (Header lev (ident,_,_) lst) = do
,("w:name",bookmarkName)] ()
let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()
return [mknode "w:p" [] (paraProps ++ [bookmarkStart, bookmarkEnd] ++ contents)]
-blockToOpenXML opts (Plain lst) = withParaProp (pStyle "Compact")
+blockToOpenXML opts (Plain lst) = withParaProp (pCustomStyle "Compact")
$ blockToOpenXML opts (Para lst)
-- title beginning with fig: indicates that the image is a figure
blockToOpenXML opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do
setFirstPara
paraProps <- getParaProps False
contents <- inlinesToOpenXML opts [Image alt (src,tit)]
- captionNode <- withParaProp (pStyle "ImageCaption")
+ captionNode <- withParaProp (pCustomStyle "ImageCaption")
$ blockToOpenXML opts (Para alt)
return $ mknode "w:p" [] (paraProps ++ contents) : captionNode
-- fixDisplayMath sometimes produces a Para [] as artifact
blockToOpenXML _ (Para []) = return []
blockToOpenXML opts (Para lst) = do
- isFirstPara <- gets stFirstPara
+ isFirstPara <- gets stFirstPara
paraProps <- getParaProps $ case lst of
[Math DisplayMath _] -> True
_ -> False
+ bodyTextStyle <- pStyleM "Body Text"
let paraProps' = case paraProps of
- [] | isFirstPara -> [mknode "w:pPr" [] [(pStyle "FirstParagraph")]]
- [] -> [mknode "w:pPr" [] [(pStyle "BodyText")]]
+ [] | isFirstPara -> [mknode "w:pPr" [] [pCustomStyle "FirstParagraph"]]
+ [] -> [mknode "w:pPr" [] [bodyTextStyle]]
ps -> ps
modify $ \s -> s { stFirstPara = False }
contents <- inlinesToOpenXML opts lst
@@ -688,11 +697,11 @@ blockToOpenXML _ (RawBlock format str)
| format == Format "openxml" = return [ x | Elem x <- parseXML str ]
| otherwise = return []
blockToOpenXML opts (BlockQuote blocks) = do
- p <- withParaProp (pStyle "BlockQuote") $ blocksToOpenXML opts blocks
+ p <- withParaPropM (pStyleM "Block Text") $ blocksToOpenXML opts blocks
setFirstPara
return p
blockToOpenXML opts (CodeBlock attrs str) = do
- p <- withParaProp (pStyle "SourceCode") $ (blockToOpenXML opts $ Para [Code attrs str])
+ p <- withParaProp (pCustomStyle "SourceCode") (blockToOpenXML opts $ Para [Code attrs str])
setFirstPara
return p
blockToOpenXML _ HorizontalRule = do
@@ -707,7 +716,7 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do
let captionStr = stringify caption
caption' <- if null caption
then return []
- else withParaProp (pStyle "TableCaption")
+ else withParaProp (pCustomStyle "TableCaption")
$ blockToOpenXML opts (Para caption)
let alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] ()
let cellToOpenXML (al, cell) = withParaProp (alignmentFor al)
@@ -718,32 +727,36 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do
[ mknode "w:tcBorders" []
$ mknode "w:bottom" [("w:val","single")] ()
, mknode "w:vAlign" [("w:val","bottom")] () ]
- let emptyCell = [mknode "w:p" [] [mknode "w:pPr" []
- [mknode "w:pStyle" [("w:val","Compact")] ()]]]
+ let emptyCell = [mknode "w:p" [] [pCustomStyle "Compact"]]
let mkcell border contents = mknode "w:tc" []
$ [ borderProps | border ] ++
if null contents
then emptyCell
else contents
- let mkrow border cells = mknode "w:tr" [] $ map (mkcell border) cells
+ let mkrow border cells = mknode "w:tr" [] $
+ [mknode "w:trPr" [] [
+ mknode "w:cnfStyle" [("w:firstRow","1")] ()] | border]
+ ++ map (mkcell border) cells
let textwidth = 7920 -- 5.5 in in twips, 1/20 pt
let fullrow = 5000 -- 100% specified in pct
let rowwidth = fullrow * sum widths
let mkgridcol w = mknode "w:gridCol"
[("w:w", show (floor (textwidth * w) :: Integer))] ()
+ let hasHeader = not (all null headers)
return $
caption' ++
[mknode "w:tbl" []
( mknode "w:tblPr" []
( mknode "w:tblStyle" [("w:val","TableNormal")] () :
mknode "w:tblW" [("w:type", "pct"), ("w:w", show rowwidth)] () :
+ mknode "w:tblLook" [("w:firstRow","1") | hasHeader ] () :
[ mknode "w:tblCaption" [("w:val", captionStr)] ()
| not (null caption) ] )
: mknode "w:tblGrid" []
(if all (==0) widths
then []
else map mkgridcol widths)
- : [ mkrow True headers' | not (all null headers) ] ++
+ : [ mkrow True headers' | hasHeader ] ++
map (mkrow False) rows'
)]
blockToOpenXML opts (BulletList lst) = do
@@ -767,9 +780,9 @@ blockToOpenXML opts (DefinitionList items) = do
definitionListItemToOpenXML :: WriterOptions -> ([Inline],[[Block]]) -> WS [Element]
definitionListItemToOpenXML opts (term,defs) = do
- term' <- withParaProp (pStyle "DefinitionTerm")
+ term' <- withParaProp (pCustomStyle "DefinitionTerm")
$ blockToOpenXML opts (Para term)
- defs' <- withParaProp (pStyle "Definition")
+ defs' <- withParaProp (pCustomStyle "Definition")
$ concat `fmap` mapM (blocksToOpenXML opts) defs
return $ term' ++ defs'
@@ -833,6 +846,9 @@ withTextProp d p = do
popTextProp
return res
+withTextPropM :: WS Element -> WS a -> WS a
+withTextPropM = (. flip withTextProp) . (>>=)
+
getParaProps :: Bool -> WS [Element]
getParaProps displayMathPara = do
props <- gets stParaProperties
@@ -861,6 +877,9 @@ withParaProp d p = do
popParaProp
return res
+withParaPropM :: WS Element -> WS a -> WS a
+withParaPropM = (. flip withParaProp) . (>>=)
+
formattedString :: String -> WS [Element]
formattedString str = do
props <- getTextProps
@@ -943,25 +962,26 @@ inlineToOpenXML opts (Math mathType str) = do
Right r -> return [r]
Left _ -> inlinesToOpenXML opts (texMathToInlines mathType str)
inlineToOpenXML opts (Cite _ lst) = inlinesToOpenXML opts lst
-inlineToOpenXML opts (Code attrs str) =
- withTextProp (rStyle "VerbatimChar")
- $ if writerHighlight opts
- then case highlight formatOpenXML attrs str of
- Nothing -> unhighlighted
- Just h -> return h
- else unhighlighted
- where unhighlighted = intercalate [br] `fmap`
- (mapM formattedString $ lines str)
- formatOpenXML _fmtOpts = intercalate [br] . map (map toHlTok)
- toHlTok (toktype,tok) = mknode "w:r" []
- [ mknode "w:rPr" []
- [ rStyle $ show toktype ]
- , mknode "w:t" [("xml:space","preserve")] tok ]
+inlineToOpenXML opts (Code attrs str) = do
+ let unhighlighted = intercalate [br] `fmap`
+ (mapM formattedString $ lines str)
+ formatOpenXML _fmtOpts = intercalate [br] . map (map toHlTok)
+ toHlTok (toktype,tok) = mknode "w:r" []
+ [ mknode "w:rPr" []
+ [ rCustomStyle (show toktype) ]
+ , mknode "w:t" [("xml:space","preserve")] tok ]
+ withTextProp (rCustomStyle "VerbatimChar")
+ $ if writerHighlight opts
+ then case highlight formatOpenXML attrs str of
+ Nothing -> unhighlighted
+ Just h -> return h
+ else unhighlighted
inlineToOpenXML opts (Note bs) = do
notes <- gets stFootnotes
notenum <- getUniqueId
+ footnoteStyle <- rStyleM "Footnote Reference"
let notemarker = mknode "w:r" []
- [ mknode "w:rPr" [] (rStyle "FootnoteRef")
+ [ mknode "w:rPr" [] footnoteStyle
, mknode "w:footnoteRef" [] () ]
let notemarkerXml = RawInline (Format "openxml") $ ppElement notemarker
let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : ils) : xs
@@ -971,22 +991,22 @@ inlineToOpenXML opts (Note bs) = do
oldParaProperties <- gets stParaProperties
oldTextProperties <- gets stTextProperties
modify $ \st -> st{ stListLevel = -1, stParaProperties = [], stTextProperties = [] }
- contents <- withParaProp (pStyle "FootnoteText") $ blocksToOpenXML opts
+ contents <- withParaPropM (pStyleM "Footnote Text") $ blocksToOpenXML opts
$ insertNoteRef bs
modify $ \st -> st{ stListLevel = oldListLevel, stParaProperties = oldParaProperties,
stTextProperties = oldTextProperties }
let newnote = mknode "w:footnote" [("w:id", notenum)] $ contents
modify $ \s -> s{ stFootnotes = newnote : notes }
return [ mknode "w:r" []
- [ mknode "w:rPr" [] (rStyle "FootnoteRef")
+ [ mknode "w:rPr" [] footnoteStyle
, mknode "w:footnoteReference" [("w:id", notenum)] () ] ]
-- internal link:
inlineToOpenXML opts (Link txt ('#':xs,_)) = do
- contents <- withTextProp (rStyle "Link") $ inlinesToOpenXML opts txt
+ contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt
return [ mknode "w:hyperlink" [("w:anchor",xs)] contents ]
-- external link:
inlineToOpenXML opts (Link txt (src,_)) = do
- contents <- withTextProp (rStyle "Link") $ inlinesToOpenXML opts txt
+ contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt
extlinks <- gets stExternalLinks
id' <- case M.lookup src extlinks of
Just i -> return i
@@ -1088,7 +1108,7 @@ defaultFootnotes = [ mknode "w:footnote"
[ mknode "w:p" [] $
[ mknode "w:r" [] $
[ mknode "w:continuationSeparator" [] ()]]]]
-
+
parseXml :: Archive -> Archive -> String -> IO Element
parseXml refArchive distArchive relpath =
case ((findEntryByPath relpath refArchive `mplus`
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index ef00ea036..53dc931cc 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -446,19 +446,25 @@ blockToHtml opts (Para lst) = do
contents <- inlineListToHtml opts lst
return $ H.p contents
blockToHtml opts (Div attr@(_,classes,_) bs) = do
- contents <- blockListToHtml opts bs
+ let speakerNotes = "notes" `elem` classes
+ -- we don't want incremental output inside speaker notes, see #1394
+ let opts' = if speakerNotes then opts{ writerIncremental = False } else opts
+ contents <- blockListToHtml opts' bs
let contents' = nl opts >> contents >> nl opts
return $
- if "notes" `elem` classes
- then let opts' = opts{ writerIncremental = False } in
- -- we don't want incremental output inside speaker notes
- case writerSlideVariant opts of
+ if speakerNotes
+ then case writerSlideVariant opts of
RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents'
NoSlides -> addAttrs opts' attr $ H.div $ contents'
_ -> mempty
else addAttrs opts attr $ H.div $ contents'
-blockToHtml _ (RawBlock f str)
+blockToHtml opts (RawBlock f str)
| f == Format "html" = return $ preEscapedString str
+ | f == Format "latex" =
+ case writerHTMLMathMethod opts of
+ MathJax _ -> do modify (\st -> st{ stMath = True })
+ return $ toHtml str
+ _ -> return mempty
| otherwise = return mempty
blockToHtml opts (HorizontalRule) = return $ if writerHtml5 opts then H5.hr else H.hr
blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
@@ -769,6 +775,8 @@ inlineToHtml opts inline =
case writerHTMLMathMethod opts of
LaTeXMathML _ -> do modify (\st -> st {stMath = True})
return $ toHtml str
+ MathJax _ -> do modify (\st -> st {stMath = True})
+ return $ toHtml str
_ -> return mempty
| f == Format "html" -> return $ preEscapedString str
| otherwise -> return mempty
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 64e36ca0b..58456e3ab 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -42,6 +42,7 @@ import Data.List ( (\\), isSuffixOf, isInfixOf, stripPrefix,
isPrefixOf, intercalate, intersperse )
import Data.Char ( toLower, isPunctuation, isAscii, isLetter, isDigit, ord )
import Data.Maybe ( fromMaybe )
+import Data.Aeson.Types ( (.:), parseMaybe, withObject )
import Control.Applicative ((<|>))
import Control.Monad.State
import Text.Pandoc.Pretty
@@ -102,8 +103,16 @@ pandocToLaTeX options (Pandoc meta blocks) = do
modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' }
let template = writerTemplate options
-- set stBook depending on documentclass
+ let colwidth = if writerWrapText options
+ then Just $ writerColumns options
+ else Nothing
+ metadata <- metaToJSON options
+ (fmap (render colwidth) . blockListToLaTeX)
+ (fmap (render colwidth) . inlineListToLaTeX)
+ meta
let bookClasses = ["memoir","book","report","scrreprt","scrbook"]
- case lookup "documentclass" (writerVariables options) of
+ case lookup "documentclass" (writerVariables options) `mplus`
+ parseMaybe (withObject "object" (.: "documentclass")) metadata of
Just x | x `elem` bookClasses -> modify $ \s -> s{stBook = True}
| otherwise -> return ()
Nothing | any (\x -> "\\documentclass" `isPrefixOf` x &&
@@ -114,13 +123,6 @@ pandocToLaTeX options (Pandoc meta blocks) = do
-- \enquote{...} for smart quotes:
when ("{csquotes}" `isInfixOf` template) $
modify $ \s -> s{stCsquotes = True}
- let colwidth = if writerWrapText options
- then Just $ writerColumns options
- else Nothing
- metadata <- metaToJSON options
- (fmap (render colwidth) . blockListToLaTeX)
- (fmap (render colwidth) . inlineListToLaTeX)
- meta
let (blocks'', lastHeader) = if writerCiteMethod options == Citeproc then
(blocks', [])
else case last blocks' of
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index d71f0daf8..dee4d56a4 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -57,12 +57,15 @@ import qualified Data.Text as T
type Notes = [[Block]]
type Refs = [([Inline], Target)]
-data WriterState = WriterState { stNotes :: Notes
- , stRefs :: Refs
- , stIds :: [String]
- , stPlain :: Bool }
+data WriterState = WriterState { stNotes :: Notes
+ , stRefs :: Refs
+ , stRefShortcutable :: Bool
+ , stInList :: Bool
+ , stIds :: [String]
+ , stPlain :: Bool }
instance Default WriterState
- where def = WriterState{ stNotes = [], stRefs = [], stIds = [], stPlain = False }
+ where def = WriterState{ stNotes = [], stRefs = [], stRefShortcutable = True,
+ stInList = False, stIds = [], stPlain = False }
-- | Convert Pandoc to Markdown.
writeMarkdown :: WriterOptions -> Pandoc -> String
@@ -453,7 +456,7 @@ blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
$ Pandoc nullMeta [t]
return $ nst $ tbl $$ blankline $$ caption'' $$ blankline
blockToMarkdown opts (BulletList items) = do
- contents <- mapM (bulletListItemToMarkdown opts) items
+ contents <- inList $ mapM (bulletListItemToMarkdown opts) items
return $ cat contents <> blankline
blockToMarkdown opts (OrderedList (start,sty,delim) items) = do
let start' = if isEnabled Ext_startnum opts then start else 1
@@ -464,13 +467,22 @@ blockToMarkdown opts (OrderedList (start,sty,delim) items) = do
let markers' = map (\m -> if length m < 3
then m ++ replicate (3 - length m) ' '
else m) markers
- contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
+ contents <- inList $
+ mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
zip markers' items
return $ cat contents <> blankline
blockToMarkdown opts (DefinitionList items) = do
- contents <- mapM (definitionListItemToMarkdown opts) items
+ contents <- inList $ mapM (definitionListItemToMarkdown opts) items
return $ cat contents <> blankline
+inList :: State WriterState a -> State WriterState a
+inList p = do
+ oldInList <- gets stInList
+ modify $ \st -> st{ stInList = True }
+ res <- p
+ modify $ \st -> st{ stInList = oldInList }
+ return res
+
addMarkdownAttribute :: String -> String
addMarkdownAttribute s =
case span isTagText $ reverse $ parseTags s of
@@ -497,7 +509,12 @@ pipeTable headless aligns rawHeaders rawRows = do
AlignCenter -> ':':replicate w '-' ++ ":"
AlignRight -> replicate (w + 1) '-' ++ ":"
AlignDefault -> replicate (w + 2) '-'
- let header = if headless then empty else torow rawHeaders
+ -- note: pipe tables can't completely lack a
+ -- header; for a headerless table, we need a header of empty cells.
+ -- see jgm/pandoc#1996.
+ let header = if headless
+ then torow (replicate (length aligns) empty)
+ else torow rawHeaders
let border = nowrap $ text "|" <> hcat (intersperse (text "|") $
map toborder $ zip aligns widths) <> text "|"
let body = vcat $ map torow rawRows
@@ -677,12 +694,53 @@ getReference label (src, tit) = do
-- | Convert list of Pandoc inline elements to markdown.
inlineListToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
-inlineListToMarkdown opts lst =
- mapM (inlineToMarkdown opts) (avoidBadWraps lst) >>= return . cat
- where avoidBadWraps [] = []
- avoidBadWraps (Space:Str (c:cs):xs)
- | c `elem` ("-*+>" :: String) = Str (' ':c:cs) : avoidBadWraps xs
- avoidBadWraps (x:xs) = x : avoidBadWraps xs
+inlineListToMarkdown opts lst = do
+ inlist <- gets stInList
+ go (if inlist then avoidBadWrapsInList lst else lst)
+ where go [] = return empty
+ go (i:is) = case i of
+ (Link _ _) -> case is of
+ -- If a link is followed by another link or '[' we don't shortcut
+ (Link _ _):_ -> unshortcutable
+ Space:(Link _ _):_ -> unshortcutable
+ Space:(Str('[':_)):_ -> unshortcutable
+ Space:(RawInline _ ('[':_)):_ -> unshortcutable
+ Space:(Cite _ _):_ -> unshortcutable
+ (Cite _ _):_ -> unshortcutable
+ Str ('[':_):_ -> unshortcutable
+ (RawInline _ ('[':_)):_ -> unshortcutable
+ (RawInline _ (' ':'[':_)):_ -> unshortcutable
+ _ -> shortcutable
+ _ -> shortcutable
+ where shortcutable = liftM2 (<>) (inlineToMarkdown opts i) (go is)
+ unshortcutable = do
+ iMark <- withState (\s -> s { stRefShortcutable = False })
+ (inlineToMarkdown opts i)
+ modify (\s -> s {stRefShortcutable = True })
+ fmap (iMark <>) (go is)
+
+avoidBadWrapsInList :: [Inline] -> [Inline]
+avoidBadWrapsInList [] = []
+avoidBadWrapsInList (Space:Str ('>':cs):xs) =
+ Str (' ':'>':cs) : avoidBadWrapsInList xs
+avoidBadWrapsInList (Space:Str [c]:[])
+ | c `elem` ['-','*','+'] = Str [' ', c] : []
+avoidBadWrapsInList (Space:Str [c]:Space:xs)
+ | c `elem` ['-','*','+'] = Str [' ', c] : Space : avoidBadWrapsInList xs
+avoidBadWrapsInList (Space:Str cs:Space:xs)
+ | isOrderedListMarker cs = Str (' ':cs) : Space : avoidBadWrapsInList xs
+avoidBadWrapsInList (Space:Str cs:[])
+ | isOrderedListMarker cs = Str (' ':cs) : []
+avoidBadWrapsInList (x:xs) = x : avoidBadWrapsInList xs
+
+isOrderedListMarker :: String -> Bool
+isOrderedListMarker xs = (last xs `elem` ['.',')']) &&
+ isRight (runParserT (anyOrderedListMarker >> eof)
+ defaultParserState "" xs)
+
+isRight :: Either a b -> Bool
+isRight (Right _) = True
+isRight (Left _) = False
escapeSpaces :: Inline -> Inline
escapeSpaces (Str s) = Str $ substitute " " "\\ " s
@@ -692,8 +750,10 @@ escapeSpaces x = x
-- | Convert Pandoc inline element to markdown.
inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc
inlineToMarkdown opts (Span attrs ils) = do
+ plain <- gets stPlain
contents <- inlineListToMarkdown opts ils
- return $ if isEnabled Ext_raw_html opts
+ return $ if not plain &&
+ (isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
then tagWithAttrs "span" attrs <> contents <> text "</span>"
else contents
inlineToMarkdown opts (Emph lst) = do
@@ -726,13 +786,14 @@ inlineToMarkdown opts (Subscript lst) = do
else "<sub>" <> contents <> "</sub>"
inlineToMarkdown opts (SmallCaps lst) = do
plain <- gets stPlain
- if plain
- then inlineListToMarkdown opts $ capitalize lst
- else do
+ if not plain &&
+ (isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
+ then do
contents <- inlineListToMarkdown opts lst
return $ tagWithAttrs "span"
- ("",[],[("style","font-variant:small-caps;")])
+ ("",[],[("style","font-variant:small-caps;")])
<> contents <> text "</span>"
+ else inlineListToMarkdown opts $ capitalize lst
inlineToMarkdown opts (Quoted SingleQuote lst) = do
contents <- inlineListToMarkdown opts lst
return $ "‘" <> contents <> "’"
@@ -838,6 +899,9 @@ inlineToMarkdown opts (Link txt (src, tit)) = do
[Str s] | escapeURI s == srcSuffix -> True
_ -> False
let useRefLinks = writerReferenceLinks opts && not useAuto
+ shortcutable <- gets stRefShortcutable
+ let useShortcutRefLinks = shortcutable &&
+ isEnabled Ext_shortcut_reference_links opts
ref <- if useRefLinks then getReference txt (src, tit) else return []
reftext <- inlineListToMarkdown opts ref
return $ if useAuto
@@ -847,7 +911,9 @@ inlineToMarkdown opts (Link txt (src, tit)) = do
else if useRefLinks
then let first = "[" <> linktext <> "]"
second = if txt == ref
- then "[]"
+ then if useShortcutRefLinks
+ then ""
+ else "[]"
else "[" <> reftext <> "]"
in first <> second
else if plain
generated by cgit v1.2.3 (git 2.46.0) at 2025-11-06 00:18:16 +0000