summaryrefslogtreecommitdiff
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/HTML.hs11
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs15
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs19
-rw-r--r--src/Text/Pandoc/Writers/Org.hs63
4 files changed, 59 insertions, 49 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 9ac37a0ba..1641b991c 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -47,7 +47,7 @@ import Control.Monad.State.Strict
import Data.Char (ord, toLower)
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
-import Data.List (intersperse, isPrefixOf)
+import Data.List (intersperse, isPrefixOf, partition, intercalate)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Monoid ((<>))
import qualified Data.Set as Set
@@ -569,8 +569,15 @@ imgAttrsToHtml opts attr = do
isNotDim _ = True
dimensionsToAttrList :: Attr -> [(String, String)]
-dimensionsToAttrList attr = (go Width) ++ (go Height)
+dimensionsToAttrList attr = consolidateStyles $ go Width ++ go Height
where
+ consolidateStyles :: [(String, String)] -> [(String, String)]
+ consolidateStyles xs =
+ case partition isStyle xs of
+ ([], _) -> xs
+ (ss, rest) -> ("style", intercalate ";" $ map snd ss) : rest
+ isStyle ("style", _) = True
+ isStyle _ = False
go dir = case (dimension dir attr) of
(Just (Pixel a)) -> [(show dir, show a)]
(Just x) -> [("style", show dir ++ ":" ++ show x)]
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 4a81cd245..2da087077 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -628,6 +628,7 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
put $ st {stOLLevel = oldlevel + 1}
items <- mapM listItemToLaTeX lst
modify (\s -> s {stOLLevel = oldlevel})
+ let beamer = stBeamer st
let tostyle x = case numstyle of
Decimal -> "\\arabic" <> braces x
UpperRoman -> "\\Roman" <> braces x
@@ -641,11 +642,21 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
TwoParens -> parens x
Period -> x <> "."
_ -> x <> "."
+ let exemplar = case numstyle of
+ Decimal -> "1"
+ UpperRoman -> "I"
+ LowerRoman -> "i"
+ UpperAlpha -> "A"
+ LowerAlpha -> "a"
+ Example -> "1"
+ DefaultStyle -> "1"
let enum = text $ "enum" ++ map toLower (toRomanNumeral oldlevel)
let stylecommand = if numstyle == DefaultStyle && numdelim == DefaultDelim
then empty
- else "\\def" <> "\\label" <> enum <>
- braces (todelim $ tostyle enum)
+ else if beamer
+ then brackets (todelim exemplar)
+ else "\\def" <> "\\label" <> enum <>
+ braces (todelim $ tostyle enum)
let resetcounter = if start == 1 || oldlevel > 4
then empty
else "\\setcounter" <> braces enum <>
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 95977ce17..0221ba6ef 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -288,6 +288,7 @@ escapeString opts (c:cs) =
| otherwise -> "&gt;" ++ escapeString opts cs
_ | c `elem` ['\\','`','*','_','[',']','#'] ->
'\\':c:escapeString opts cs
+ '|' | isEnabled Ext_pipe_tables opts -> '\\':'|':escapeString opts cs
'^' | isEnabled Ext_superscript opts -> '\\':'^':escapeString opts cs
'~' | isEnabled Ext_subscript opts -> '\\':'~':escapeString opts cs
'$' | isEnabled Ext_tex_math_dollars opts -> '\\':'$':escapeString opts cs
@@ -787,6 +788,7 @@ blockListToMarkdown :: PandocMonad m
-> MD m Doc
blockListToMarkdown opts blocks = do
inlist <- asks envInList
+ isPlain <- asks envPlain
-- a) insert comment between list and indented code block, or the
-- code block will be treated as a list continuation paragraph
-- b) change Plain to Para unless it's followed by a RawBlock
@@ -813,9 +815,11 @@ blockListToMarkdown opts blocks = do
isListBlock (OrderedList _ _) = True
isListBlock (DefinitionList _) = True
isListBlock _ = False
- commentSep = if isEnabled Ext_raw_html opts
- then RawBlock "html" "<!-- -->\n"
- else RawBlock "markdown" "&nbsp;\n"
+ commentSep = if isPlain
+ then Null
+ else if isEnabled Ext_raw_html opts
+ then RawBlock "html" "<!-- -->\n"
+ else RawBlock "markdown" "&nbsp;\n"
mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat
getKey :: Doc -> Key
@@ -931,7 +935,7 @@ avoidBadWrapsInList (s:Str cs:[])
avoidBadWrapsInList (x:xs) = x : avoidBadWrapsInList xs
isOrderedListMarker :: String -> Bool
-isOrderedListMarker xs = (last xs `elem` ['.',')']) &&
+isOrderedListMarker xs = not (null xs) && (last xs `elem` ['.',')']) &&
isRight (runParser (anyOrderedListMarker >> eof)
defaultParserState "" xs)
@@ -946,11 +950,10 @@ inlineToMarkdown opts (Span attrs ils) = do
contents <- inlineListToMarkdown opts ils
return $ case plain of
True -> contents
- False | isEnabled Ext_bracketed_spans opts ->
+ False | attrs == nullAttr -> contents
+ | isEnabled Ext_bracketed_spans opts ->
"[" <> contents <> "]" <>
- if attrs == nullAttr
- then "{}"
- else linkAttributes opts attrs
+ linkAttributes opts attrs
| isEnabled Ext_raw_html opts ||
isEnabled Ext_native_spans opts ->
tagWithAttrs "span" attrs <> contents <> text "</span>"
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 48f17c4fb..88f42acd4 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -129,36 +129,25 @@ blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do
blankline $$ contents $$
blankline $$ drawerEndTag $$
blankline
-blockToOrg (Div attrs bs) = do
+blockToOrg (Div (ident, classes, kv) bs) = do
contents <- blockListToOrg bs
+ -- if one class looks like the name of a greater block then output as such:
+ -- The ID, if present, is added via the #+NAME keyword; other classes and
+ -- key-value pairs are kept as #+ATTR_HTML attributes.
let isGreaterBlockClass = (`elem` ["center", "quote"]) . map toLower
- return $ case attrs of
- ("", [], []) ->
- -- nullAttr, treat contents as if it wasn't wrapped
- blankline $$ contents $$ blankline
- (ident, [], []) ->
- -- only an id: add id as an anchor, unwrap the rest
- blankline $$ "<<" <> text ident <> ">>" $$ contents $$ blankline
- (ident, classes, kv) ->
- -- if one class looks like the name of a greater block then output as
- -- such: The ID, if present, is added via the #+NAME keyword; other
- -- classes and key-value pairs are kept as #+ATTR_HTML attributes.
- let
- (blockTypeCand, classes') = partition isGreaterBlockClass classes
- in case blockTypeCand of
- (blockType:classes'') ->
- blankline $$ attrHtml (ident, classes'' <> classes', kv) $$
- "#+BEGIN_" <> text blockType $$ contents $$
- "#+END_" <> text blockType $$ blankline
- _ ->
- -- fallback: wrap in div tags
- let
- startTag = tagWithAttrs "div" attrs
- endTag = text "</div>"
- in blankline $$ "#+BEGIN_HTML" $$
- nest 2 startTag $$ "#+END_HTML" $$ blankline $$
- contents $$ blankline $$ "#+BEGIN_HTML" $$
- nest 2 endTag $$ "#+END_HTML" $$ blankline
+ (blockTypeCand, classes') = partition isGreaterBlockClass classes
+ return $ case blockTypeCand of
+ (blockType:classes'') ->
+ blankline $$ attrHtml (ident, classes'' <> classes', kv) $$
+ "#+BEGIN_" <> text blockType $$ contents $$
+ "#+END_" <> text blockType $$ blankline
+ _ ->
+ -- fallback with id: add id as an anchor if present, discard classes and
+ -- key-value pairs, unwrap the content.
+ let contents' = if not (null ident)
+ then "<<" <> text ident <> ">>" $$ contents
+ else contents
+ in blankline $$ contents' $$ blankline
blockToOrg (Plain inlines) = inlineListToOrg inlines
-- title beginning with fig: indicates that the image is a figure
blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
@@ -173,7 +162,7 @@ blockToOrg (Para inlines) = do
blockToOrg (LineBlock lns) = do
let splitStanza [] = []
splitStanza xs = case break (== mempty) xs of
- (l, []) -> l : []
+ (l, []) -> [l]
(l, _:r) -> l : splitStanza r
let joinWithLinefeeds = nowrap . mconcat . intersperse cr
let joinWithBlankLines = mconcat . intersperse blankline
@@ -213,7 +202,7 @@ blockToOrg (Table caption' _ _ headers rows) = do
caption'' <- inlineListToOrg caption'
let caption = if null caption'
then empty
- else ("#+CAPTION: " <> caption'')
+ else "#+CAPTION: " <> caption''
headers' <- mapM blockListToOrg headers
rawRows <- mapM (mapM blockListToOrg) rows
let numChars = maximum . map offset
@@ -289,8 +278,8 @@ propertiesDrawer (ident, classes, kv) =
let
drawerStart = text ":PROPERTIES:"
drawerEnd = text ":END:"
- kv' = if (classes == mempty) then kv else ("CLASS", unwords classes):kv
- kv'' = if (ident == mempty) then kv' else ("CUSTOM_ID", ident):kv'
+ kv' = if classes == mempty then kv else ("CLASS", unwords classes):kv
+ kv'' = if ident == mempty then kv' else ("CUSTOM_ID", ident):kv'
properties = vcat $ map kvToOrgProperty kv''
in
drawerStart <> cr <> properties <> cr <> drawerEnd
@@ -303,7 +292,7 @@ attrHtml :: Attr -> Doc
attrHtml ("" , [] , []) = mempty
attrHtml (ident, classes, kvs) =
let
- name = if (null ident) then mempty else "#+NAME: " <> text ident <> cr
+ name = if null ident then mempty else "#+NAME: " <> text ident <> cr
keyword = "#+ATTR_HTML"
classKv = ("class", unwords classes)
kvStrings = map (\(k,v) -> ":" <> k <> " " <> v) (classKv:kvs)
@@ -370,19 +359,19 @@ inlineToOrg SoftBreak = do
WrapPreserve -> return cr
WrapAuto -> return space
WrapNone -> return space
-inlineToOrg (Link _ txt (src, _)) = do
+inlineToOrg (Link _ txt (src, _)) =
case txt of
[Str x] | escapeURI x == src -> -- autolink
- do return $ "[[" <> text (orgPath x) <> "]]"
+ return $ "[[" <> text (orgPath x) <> "]]"
_ -> do contents <- inlineListToOrg txt
return $ "[[" <> text (orgPath src) <> "][" <> contents <> "]]"
-inlineToOrg (Image _ _ (source, _)) = do
+inlineToOrg (Image _ _ (source, _)) =
return $ "[[" <> text (orgPath source) <> "]]"
inlineToOrg (Note contents) = do
-- add to notes in state
notes <- gets stNotes
modify $ \st -> st { stNotes = contents:notes }
- let ref = show $ (length notes) + 1
+ let ref = show $ length notes + 1
return $ "[fn:" <> text ref <> "]"
orgPath :: String -> String